#!/usr/bin/perl #============================================================================== # $Id: slideviewer.cgi,v 1.9 2000/09/29 21:02:22 peters Exp $ # # Name: slideviewer.cgi # # Written: Peter Sundstrom (peters@ginini.com.au) # # Created: Feb 1997 # # Source: http://www.ginini.com.au/tools/slideviewer/ # # Description: Multi-purpose slide viewer. Specify a file with a list # of pictures and descriptions and it does the rest. # # Notes: Image sizing code is adapted and taken from parts of WWWis. # http://www.tardis.ed.ac.uk/~ark/wwwis/ # # Copyright: (c)1997-2000 Peter Sundstrom. # # See http://www.ginini.com.au/tools/slideviewer/ for licence # details. # #============================================================================== use CGI::Carp qw(carpout fatalsToBrowser); #------------------------------------------------- # Kill myself after 30 seconds of running time # Added by NetGate.KB 2/21/18 #------------------------------------------------- $SIG{'ALRM'} = sub { # This goes to the http_error_log syswrite(STDERR, "Caught SIGALARM in script slideviewer.cgi\n", 43); # This goes to the browser die "Maximum run time exceeded. "; exit (-1); }; alarm(30); #------------------------------------------------- # GLOBAL CONFIGURABLE OPTIONS #------------------------------------------------- # Full directory path where the configuration file/s are kept #$ConfigDir="/home/master/applications/qqbuwgbudn/public_html/slideviewer/config"; $ConfigDir="/public_html/slideviewer/config"; # Name of the default configuration filename if none is specified $DefaultCfg="$ConfigDir/default.cfg"; #----------------------------------------------------------------- # END OF GLOBAL CONFIGURABLE OPTIONS #================================================================= $Version='2.3.0'; use Socket; use Sys::Hostname; use vars qw($StartIconOn $DefRefresh $Name $IndexWidth $NextIconOn); use vars qw($PrevIconOn $IndexHeight $EndIconOn $DirReverse); # URL to this script $CGI=$ENV{'SCRIPT_NAME'}; undef %Data; $Method = $ENV{'REQUEST_METHOD'}; if ($Method eq 'GET') { $Query = $ENV{'QUERY_STRING'}; } else { read(STDIN,$Query,$ENV{'CONTENT_LENGTH'}); } foreach (split(/[&;]/, $Query)) { s/\+/ /g; ($key, $value) = split('=', $_); $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; $value =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; $Data{$key} = $value; } # # Unbuffer output # $|=1; # # # Check to see what configuration to use # $Config="$Data{config}"; if ($Config) { Error("Configuration file can not be a URL - $Config") if ($Config =~ /http:/i); Error("Invalid Configuration format. No pathnames allowed.") if ($Config !~ m#^([\w.-]+)$#); Error("Configuration file $ConfigDir/$Config does not exist") if ( ! -f "$ConfigDir/$Config"); require "$ConfigDir/$Config"; } else { Error("Configuration file can not be a URL - $DefaultCfg") if ($DefaultCfg =~ /http:/i); Error("Default configuration file $DefaultCfg does not exist") if (! -f "$DefaultCfg"); require "$DefaultCfg"; } # # Display the slide selection form if specified or no parameters supplied or just the # configuration specified. # DisplayForm() if ($Data{form} or ! "$Query" or ! ($Data{list} or $Data{dir})); # # Open the specified slide list # if ($Data{dir}) { $Dir=$Data{dir}; Error("Directory list name can not be a URL - $Dir") if ($Dir =~ /http:/i); Error("Invalid directory list name format. No pathnames allowed") if ($Dir !~ m#^([\w.-]+)$#); } else { Error("No slideshow list specified") unless "$Data{list}"; Error("Slideshow list name can not be a URL - $Data{list}") if ($Data{list} =~ /http:/i); Error("Invalid slideshow list name format. No pathnames allowed") if ($Data{list} !~ m#^([\w.-]+)$#); $ListName=$Data{list}; $List="$SlideDir/$Data{list}"; } # # Check to see if we have a valid design file # if ($Data{design}) { Error("Design name format can not be a URL - $Data{design}") if ($Data{design} =~ /http:/i); Error("Invalid design name format. No pathnames allowed") if ($Data{design} !~ m#^([\w.-]+)$#); $Design="$Data{design}"; } else { $Design="default"; } Error("Design file: $DesignDir/$Design does not exist") if (! -f "$DesignDir/$Design"); # # Check whether we need to build the slide index popup # CreateIndex() if ($Data{index} eq 'yes' and $IndexPopup); # # Set the recyle option # if ($Data{cycle} eq 'on') { $Cycle=$Data{cycle}; } else { $Cycle='off'; } # # Determine direction to go in # $Direction=$Data{direction} if ($Data{direction}); if ($Direction eq 'forward') { $OtherWay='backward'; } elsif ($Direction eq 'backward') { $OtherWay='forward'; } else { $Direction='forward'; $OtherWay='backward'; } # # Determine what slide number we are up to # if ($Data{slide} and $Data{slide} > 1) { $Slide=$Data{slide}; } else { $Slide=1; } $Count=0; if ($Data{dir}) { DirectoryList(); } else { SlideList(); } if ($Direction eq 'forward') { if ($Slide == 1) { $Prev=1; $Next=2; } else { $Prev=$Slide - 1; $Next=$Slide + 1; } } else { $Prev=$Slide + 1; $Next=$Slide - 1; } if ($Data{total}) { $Total=$Data{total}; } else { $Total=$Count; } Error("Slide number $Slide out of range. Max is $Total") if ($Slide > $Total); # # Generate a random number in the slide range # srand(time); $Random=int(rand $Total) +1; # # Determine if this image has a URL associated with it # if ($LURL =~ /(http:.*)(alt.*)/i) { $LURL=$1; $Alt=$2; } # # Set the refresh rate if specified # $Refresh=$Data{refresh} if ($Data{refresh} > 0); $Refresh=0 if ($Data{auto} eq 'off'); # # Set refresh times # $Slower=$Refresh + $Adjust; $Faster = $Refresh - $Adjust if ($Refresh > $Adjust); # # Determine HEIGHT and WIDTH tags from image if not specified # if ($Data{width}) { $Width=$Data{width}; $Height=$Data{height}; } elsif ($Data{scale}) { $ImagePath=ImageLocation("$Image"); ($Width,$Height)=imgsize("$ImagePath"); $Scale=$Data{scale}; if ($Scale < 0) { foreach ($i=0; $i>$Scale; $i--) { $Width = $Width / $ScaleFactor; $Height = $Height / $ScaleFactor; } } else { foreach ($i=0; $i < $Scale; $i++) { $Width = $Width * $ScaleFactor; $Height = $Height * $ScaleFactor; } } } else { $ImagePath=ImageLocation("$Image"); ($Width,$Height)=imgsize($ImagePath); } # # Calculate enlargement or reduction if selected. # if ($Data{scale}) { $Scale=$Data{scale}; } else { $Scale=0; } if ($Data{size} eq 'enlarge') { $Scale++; $Width = $Width * $ScaleFactor; $Height = $Height * $ScaleFactor; } elsif ($Data{size} eq 'reduce') { $Scale--; $Width = $Width / $ScaleFactor; $Height = $Height / $ScaleFactor; } # # If this is the last slide set the end page or go back to the # beginning if cycle mode is on. # if ($Next > $Total or ($Slide == 1 and $Direction eq 'backward')) { if ($Cycle eq 'on') { $URL="$CGI?list=${ListName}&dir=$Dir&config=$Config&refresh=$Refresh&direction=$Direction&cycle=on&scale=$Scale&design=$Design&total=$Total" if ($Direction eq 'forward'); $URL="$CGI?list=${ListName}&dir=$Dir&config=$Config&refresh=$Refresh&direction=$Direction&scale=$Scale&cycle=on&slide=$Total&design=$Design&total=$Total" if ($Direction eq 'backward'); } else { $URL="$End"; } } else { $URL="$CGI?list=${ListName}&dir=$Dir&config=$Config&refresh=$Refresh&direction=$Direction&scale=$Scale&cycle=$Cycle&slide=$Next&design=$Design&total=$Total"; } DisplayPage(); exit 0; #============================================================================= # END OF MAIN #============================================================================= sub DisplayForm { open(FORM,"$Form") or Error("Can not open slideshow form template $Form", $!); while (
\n"; } #----------------------------------------------------------------------------- sub DropdownList { my $Count=1; open(LIST,"$List") or Error("Can not open slide show list $List", $!); while (HTML exit; } #----------------------------------------------------------------------------- # Code adapted from wwwis # # looking at the filename really sucks I should be using the first 4 bytes # of the image. If I ever do it these are the numbers.... (from chris@w3.org) # PNG 89 50 4e 47 # GIF 47 49 46 38 # JPG ff d8 ff e0 # XBM 23 64 65 66 sub imgsize { local($file)= shift @_; local($x,$y)=(0,0); if ($file =~ /http:/) { ($x,$y) = &URLsize($file); } elsif ( defined($file) && open(STREAM, "<$file") ) { binmode( STREAM ); # for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED if ($file =~ /\.jpg$/i or $file =~ /\.jpeg$/i) { ($x,$y) = &jpegsize(STREAM); } elsif ($file =~ /\.gif$/i) { ($x,$y) = &gifsize(STREAM); } elsif($file =~ /\.xbm$/i) { ($x,$y) = &xbmsize(STREAM); } elsif($file =~ /\.png$/i) { ($x,$y) = &pngsize(STREAM); } else { Error("$file is not a recognised image type of gif, xbm, jpeg or png"); } close(STREAM); } return ($x,$y); } #----------------------------------------------------------------------------- sub gifsize { local($GIF) = @_; local($type,$a,$b,$c,$d,$s)=(0,0,0,0,0,0); if (defined($GIF) && read($GIF, $type, 6) && $type =~ /GIF8[7,9]a/ && read($GIF, $s, 4) == 4 ) { ($a,$b,$c,$d)=unpack("C"x4,$s); return ($b<<8|$a,$d<<8|$c); } return (0,0); } #----------------------------------------------------------------------------- sub xbmsize { local($XBM) = @_; local($input)=""; if (defined($XBM)) { $input .= <$XBM>; $input .= <$XBM>; $input .= <$XBM>; $_ = $input; if (/.define\s+\S+\s+(\d+)\s*\n.define\s+\S+\s+(\d+)\s*\n/i) { return ($1,$2); } } return (0,0); } #----------------------------------------------------------------------------- # pngsize : gets the width & height (in pixels) of a png file # cor this program is on the cutting edge of technology! (pity it's blunt!) # GRR 970619: fixed bytesex assumption sub pngsize { local($PNG) = @_; local($head) = ""; local($a, $b, $c, $d, $e, $f, $g, $h)=0; if (defined($PNG) && read( $PNG, $head, 8 ) == 8 && $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" && read($PNG, $head, 4) == 4 && read($PNG, $head, 4) == 4 && $head eq "IHDR" && read($PNG, $head, 8) == 8 ) { ($a,$b,$c,$d,$e,$f,$g,$h)=unpack("C"x8,$head); return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h); } return (0,0); } #----------------------------------------------------------------------------- # jpegsize : gets the width and height (in pixels) of a jpeg file # Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995 # modified slightly by alex@ed.ac.uk sub jpegsize { local($JPEG) = @_; local($done)=0; local($c1,$c2,$ch,$s,$length, $dummy)=(0,0,0,0,0,0); if (defined($JPEG) && read($JPEG, $c1, 1) && read($JPEG, $c2, 1) && ord($c1) == 0xFF && ord($c2) == 0xD8 ) { while (ord($ch) != 0xDA && !$done) { # Find next marker (JPEG markers begin with 0xFF) # This can hang the program!! while (ord($ch) != 0xFF) { read($JPEG, $ch, 1); } # JPEG markers can be padded with unlimited 0xFF's while (ord($ch) == 0xFF) { read($JPEG, $ch, 1); } # Now, $ch contains the value of the marker. if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) { read ($JPEG, $dummy, 3); read($JPEG, $s, 4); ($a,$b,$c,$d)=unpack("C"x4,$s); return ($c<<8|$d, $a<<8|$b ); } else { # NOT valid JPEG markers read ($JPEG, $s, 2); ($c1, $c2) = unpack("C"x2,$s); $length = $c1<<8|$c2; last if (!defined($length) || $length < 2); read($JPEG, $dummy, $length-2); } } } return (0,0); } #----------------------------------------------------------------------------- sub URLsize { local($five) = @_; local($dummy, $dummy, $server, $url); local( $x,$y) = (0,0); if ($Proxy =~ /\S+/) { ($dummy, $dummy, $server, $url) = split(/\//, $Proxy, 4); $url=$five; } else { ($dummy, $dummy, $server, $url) = split(/\//, $five, 4); $url= '/' . $url; } local($them,$port) = split(/:/, $server); $port = 80 unless $port; $them = 'localhost' unless $them; $_=$url; if (/gif/i || /jpeg/i || /jpg/i || /xbm/i) { $sockaddr = 'S n a4 x8'; $hostname=hostname(); ($name,$aliases,$proto) = getprotobyname('tcp'); ($name,$aliases,$port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/;; ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname); ($name,$aliases,$type,$len,$thataddr) = gethostbyname($them); &Error("Unknown server/proxy port") if (!defined($port)); &Error("Unable to retreive the image via the Web Server. This could be due to an incorrect perl installation or web server being down") if (!defined($thataddr)); $this = pack($sockaddr, &AF_INET, 0, $thisaddr); $that = pack($sockaddr, &AF_INET, $port, $thataddr); # Make the socket filehandle. if (!((socket(S, &AF_INET, &SOCK_STREAM, $proto)) && # Give the socket an address. (bind(S, $this)) && # Call up the server. (connect(S,$that)) )) { # there was a problem &Error(" $!"); } else { # Set socket to be command buffered. select(S); $| = 1; select(STDOUT); print S "GET $url\n\n"; if ($url =~ /\.jpg$/i || $url =~ /\.jpeg$/i) { ($x,$y) = &jpegsize(S); } elsif ($url =~ /\.gif$/i) { ($x,$y) = &gifsize(S); } elsif ($url =~ /\.xbm$/i) { ($x,$y) = &xbmsize(S); } elsif ($url =~ /\.png$/i) { ($x,$y) = &pngsize(S); } else { &Error("$url is not gif, jpeg, xbm or png"); } } } else { &Error("$url is not gif, xbm or jpeg"); } return ($x,$y); }$Text
Diagnostics
Error Message: $Errmsg
Full Directory path to this script: $Dir
Slideviewer Version: $Version
Perl Version: $]
Server Type: $ENV{'SERVER_SOFTWARE'}