Rejecting pathinfo=\"$pathinfo\" (.. rule)
\n") if $V>0; &done(1); } if ($pathinfo =~ m"^\w+://") { &lsend("Rejecting URL pathinfo.\n") if $V>2; &wsend("
Can't handle URLs yet; sorry.
\n"); &done(1); } if (($dir,$rest) = ($pathinfo =~ '^/*([^/]+)/+(.*)$')) { &lsend("dir=\"$dir\"\n") if $V>2; &lsend("rest=\"$rest\"\n") if $V>2; &wsend("dir=\"$dir\"\n") if $V>2; &wsend("rest=\"$rest\"\n") if $V>2; if ($x = $ABCdir{$dir}) { $dir = $x; &lsend("dir=\"$dir\"\n") if $V>2; &wsend("dir=\"$dir\"\n") if $V>2; $pathinfo = "$dir/$rest"; } elsif ("/$dir" eq $usrurl) { &lsend("dir=\"$dir\" ignored.\n") if $V>2; &wsend("dir=\"$dir\" ignored.\n") if $V>2; $dir = ''; $pathinfo = "$rest"; } &lsend("pathinfo=\"$pathinfo\"\n") if $V>2; &wsend("pathinfo=\"$pathinfo\"\n") if $V>2; } elsif ($pathinfo = $ABCdir{$pathinfo}) { &lsend("pathinfo=\"$pathinfo\"\n") if $V>2; &wsend("pathinfo=\"$pathinfo\"\n") if $V>2; } if (!$pathinfo) { &esend("Can't determine path.\n") if $V>1; &done(1); } &lsend("webdir=\"$webdir\" (final)\n") if $V>2; &lsend("pathinfo=\"$pathinfo\" (final)\n") if $V>2; ($locpath = "$webdir/$pathinfo/") =~ s"//+"/"g; &lsend("locpath=\"$locpath\"\n") if $V>2; ($webpath = "$usrurl/$pathinfo") =~ s"//+"/"g; &lsend("webpath=\"$webpath\"\n") if $V>2; unless (-d $locpath) { &wsend("
The directory \"$locpath\" doesn't seem to exist ...\n"); &done(1); } $script = $ENV{'SCRIPT_NAME'}; $trypath = $locpath . '/index.html'; &wsend("trypath=\"$trypath\"\n") if $V>2; if (-f $trypath) { system "cat $trypath"; &done(0); } &wsend("trypath=\"$trypath\" does not exist.\n") if $V>2; $trypath = $locpath . '/HEADER.html'; &wsend("trypath='$trypath'\n") if $V>2; if (-f $trypath) { system "cat $trypath"; } &wsend("trypath=\"$trypath\" does not exist.\n") if $V>2; &fmtsDescr(); &fmtsTable(); unless (-d $locpath) { &wsend("
The directory \"$locpath\" doesn't seem to exist ...\n"); &done(1); } chdir $locpath; if (opendir(DIR,".")) { @file = readdir(DIR); close DIR; } else { } #@file = glob("*"); # Why is this insecure? #unshift(@file, '..'); &wsend("\n"); for $f (sort @file) { next if ($f =~ /^\./); next if ($f =~ /^HEADER\b/); next if ($f =~ /^index\b/); $webpath =~ s"/+$""; # $I = " "; $GET = "Get"; $TXT = "--- "; $GIF = "--- "; $PNG = "--- "; $PS = "-- "; $EPS = "--- "; $PDF = "--- "; $MIDI = "---- "; $desc = "$f"; $list = 0; $XXX = ''; if (-d $f) { $f =~ s"/*$"/"; $f =~ s"^/+""; $desc = "$f"; # $desc = "$f"; } elsif (($Base,$Suff) = ($f =~ /^(.+)\.([^.]+)$/)) { $suff = lc($Suff); if ($suff eq 'abc') { $GET = "ABC "; $PS = "PS "; # $EPS = "EPS "; $PDF = "PDF "; $TXT = "TXT "; $GIF = "GIF "; $PNG = "PNG "; # $MIDI = "MIDI "; $list = 1; } elsif ($suff eq 'png') { $PNG = "PNG"; } elsif ($suff eq 'gif') { $GIF = "GIF"; } elsif ($suff eq 'ps') { $PS = "PS"; } elsif ($suff eq 'pdf') { $PDF = "PDF"; } elsif ($suff eq 'eps') { $EPS = "EPS"; } elsif ($suff =~ /(html*|te*xt)/) { } elsif ($suff =~ /^(cgi|pl|.*sh)$/) { } } else { } # &wsend("$icon\n"); # print $I; &wsend("$GET \n"); &wsend("$TXT \n"); &wsend("$PS \n"); &wsend("$EPS \n"); &wsend("$PDF \n"); &wsend("$GIF \n"); &wsend("$PNG \n"); &wsend("$MIDI \n"); &wsend("$desc\n"); if ($list) { $opened = 0; if (($f =~ m"^http://"i) && (&URLopen(*F,$f))) { $opened = 1; } elsif (open(F,$f)) { $opened = 1; } if ($opened) { $X = $tunes = 0; $GET = "--- "; for $l () { if ($l =~ m"^X:\s*([\d/.]+)") { $X = $1; $TTL = $Ttl = $ttl = ''; # Forget any previous title } elsif ($l =~ /^([PT]):\s*(.+)\s*$/) { next if $1 eq 'P' && $TTL; $ttl = $2; $Ttl = &AdjTitle($ttl); # Canonical title, initial caps $Ttl =~ s/[^A-Za-z0-9]//g; # Strip any non-alpha chars $TTL = uc($Ttl); # Canonical title, UPPERCASE $ttl = &abc2html($ttl); # Convert escape sequences ($F = $f) =~ s/\+/%2B/g; $GET = " ABC "; $PS = "PS "; $EPS = "EPS "; $PDF = "PDF "; $TXT = "TXT "; $GIF = "GIF "; $PNG = "PNG "; # $XXX = "$X"; $XXX = $X; # Tune's index number $MIDI = "MIDI "; $tunes++; &wsend("$GET \n"); &wsend("$TXT \n"); &wsend("$PS \n"); &wsend("$EPS \n"); &wsend("$PDF \n"); &wsend("$GIF \n"); &wsend("$PNG \n"); &wsend("$MIDI \n"); &wsend("$XXX: \n"); &wsend("$ttl\n"); } } } else { &wsend(" [[Can't read \"$f\"]]\n"); } } } &wsend("\n"); &done($exitstat); # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub done { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # local($stat) = @_; &lsend("$P: Exit with status $stat.\n") if $V && $stat; exit $stat; } sub getDir { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Figure out what directory (relative to $webdir) that we're to list. If the # PATH_INFO string exists, we'll use it, so the user can name the directory # in the URL. Otherwise, we look for the HTTP_REFERER string, which browsers # should send us. This way, an HTML file can just link to this program, and # the "current" directory will be listed. # ($PI = $ENV{PATH_INFO} || '') =~ s"^/+""; &lsend("PI=\"$PI\"\n") if $V>1; if ($PI) { &lsend("Using PATH_INFO \"$PI\"\n") if $V>1; &lsend("PI=\"$PI\"\n") if $V>1; } elsif (($PI = $ENV{'HTTP_REFERER'}) && ($PI =~ m"/$")) { &lsend("Using HTTP_REFERER \"$PI\"\n") if $V>1; $PI =~ s"^http://[\w.:]+/""; &lsend("PI=\"$PI\"\n") if $V>1; $PI =~ s"^~\w+""; # Strip out user id &lsend("PI=\"$PI\"\n") if $V>1; } elsif ($PI = $data{D} || $data{DIR} || $data{DIR1} || $data{DIR2}) { &lsend("Using DIR \"$PI\"\n") if $V>1; $PI =~ s"^http://[\w.:]+/""; &lsend("PI=\"$PI\"\n") if $V>1; $PI =~ s"^~\w+""; # Strip out user id &lsend("PI=\"$PI\"\n") if $V>1; } else { $PI = ''; } if ($PI =~ m"^/*(.*)/*$") { $pathinfo = "$1"; # Untaint the path info } &lsend("pathinfo=\"$pathinfo\"\n") if $V>1; } sub LocalSetup { $Vtest = shift; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Figure out where we're running, and try to require a *cgilocal.pm file for # # local settings. The end result of this is to initialize a long list of # # global variables. The return value is the name of the cgilocal file, which # # we usually feed to the 'require' command. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # $ENV{PATH} = '/bin:/sbin:/usr/bin:/usr/sbin'; push @INC, '.'; $testing = '0'; # Set to 1 while testing umask 0002; # Output files must be group writable $| = 1; # Unbuffered STDOUT $" = ','; # Used in verbose messages ($P = $0 || 'filelist') =~ s".*/""; (($ENV{"V_$P"} || $ENV{"D_$P"} || $testing) . ' 1') =~ /(\d+)/; # Verbose level $V = $1; ($ENV{REMOTE_ADDR} || '0.0.0.0') =~ m/^\s*([\d.]+)\s*$/; $RA = $1; if (defined($x = $data{V}) && ($x =~ /^\s*(\d+)\s*$/)) { $V = $1; &lsend("V=$V (from data).\n") if $V>3; } elsif ($RA eq '207.172.223.184') { # My home machine $V = $Vtest if $V<$Vtest; } elsif ($RA =~ /^192\.168\./) { # My home network $V = $Vtest if $V<$Vtest; } local($ss,$mm,$hh,$DD,$MM,$YY) = gmtime(time); # Current date/time $ymd = sprintf("%d-%02d-%02d",1900+$YY,1+$MM,$DD); # CCYY-MM-DD $hms = sprintf("%02d:%02d:%02d",$hh,$mm,$ss); # HH:MM:SS $hostname = `/bin/hostname`; # What does this machine call itself? $hostname =~ s/^\s*([-.\w]*)([\r\s]*)$/$1/; # Strip off domain info ($host = $1) =~ s/\..*//; # Extract first field of name $cwd = `/bin/pwd`; $hstloc = $host . "-cgilocal.pm"; $cgiloc = (-f $hstloc) ? $hstloc : 'cgilocal.pm'; return $cgiloc; } sub openLog { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # $logfile = "$tmpdir/List$$.log"; $altfile = "$tmpdir/lastList.log"; if (!open(L,">>$logfile")) { &wsend("Can't write \"$logfile\" ($!)\n"); print STDERR "Can't write \"$logfile\" ($!)\n"; return 0; } select L; $| = 1; select STDOUT; $Lopen = 1; # Logfile is open unlink($altfile) if -f $altfile; link($logfile,$altfile); return $Lopen; }