#!/usr/bin/perl -Tw # $version = '20150304'; # Which version we claim to be # require &LocalSetup(1); # Figure out localization stuff require 'names.pm'; # Program name table require "sendsubs.pm"; # Routines to send messages require "HTMLenc.pm"; # HTML encoding of strings. require "URLopen.pm"; # Open Web file. require "outtune.pm"; # Tune extraction routines. require "formats.pm"; # Tune format descriptions. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # #NAME # filelist # #SYNOPSIS # # # # # # # #DESCRIPTION # This is a special-purpose CGI script that produces an HTML listing of a # directory that contains ABC files. It recognizes the ABC files by the # usual .abc suffix, and their output lines have hyperlinks to invoke a # conversion script. This means that you can get the file converted to any # of a list of formats, including PS, GIF and MIDI. # # The PATH in the URL is assumed to be the part after the .../~user in the # normal URL to fetch the file. What we do, actually, is append the /PATH # portion to the $webdir string (in cgilocal.pm), and that is the URL that # is given to $get. # #BUGS # At present, the GIF case seems to return only the first page, so # it isn't too useful for a multi-page file. # #AUTHOR # John Chambers # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # $| = 1; # Unbuffered STDOUT umask 0002; # Output files must be group writable $" = ','; # Used in verbose messages $S = '0.65'; # Scale factor $exitstat = 0; # Exit code, set to nonzero if serious problem $NF = 'rel="nofollow"'; # Link attribute to discourage bots from following link $cgi = new CGI_Lite; %data = $cgi->parse_form_data (); # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Note some stuff that we will probably need later. $RA = ($ENV{REMOTE_ADDR} =~ /^\s*(\d+\.\d+\.\d+\.\d+)\s*$/) # Client's IP address ? $1 : '0.0.0.0'; $SP = ($ENV{SERVER_PORT} =~ /(\d+)/) # Our server port ? $1 : 80; $SV = ($ENV{SERVER_NAME} =~ /([\w.-:]+)/) # Our machine's name ? $1 : 'localhost'; &openLog(); &lsend("$P: version=$version RA=\"$RA\" V=$V.\n") if $V>2 && $Lopen; &lsend("$P: SP='$SP' SV='$SV'\n") if $V>1; &getDir(); # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # We should now have enough info to generate the HTML header and title. $title = "ABC list for $pathinfo"; &wsend("\n"); &wsend("\t$title\n"); &wsend("\n"); if ($V>1) { &wsend("hostname: \"$hostname\"\n"); &wsend("host: \"$host\"\n"); &wsend("CWD: \"$cwd\"\n"); &wsend("cgiloc: \"$cgiloc\"\n"); &wsend("hstloc: \"$hstloc\"\n"); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # if ($fmt = $data{'F'}) { &wsend("Format: $fmt\n") if $V>1; } else { $fmt = 'list'; } if ($fmt eq 'form') { &wsend("\n"); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # #V++ if ($SP != 80); # Extra verbose if not std port &lsend("From: $RA $ymd $hms \"$0\" PID=$$ V=$V.\n"); if ($V > 2) { &wsend("\nEnvironment:\n\n"); &lsend("Environment:\n"); for $e (sort keys %ENV) { $v = $ENV{$e}; &lsend("\t$e\n\t\t$v\n"); &wsend("$e$v\n"); } &wsend("\n\n"); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # We sometimes send the requested file with default formatting (faster), and # sometimes we first send a page asking for formatting details (prettier). Is # there some user-friendly way to ask for the formatting stuff without the # extra step? $get = ($V<3) ? @CGI{'tuneget'} || 'tuneget' : 'testget'; # Send file with default formatting $frm = ($V<3) ? @CGI{'tuneform'} || 'tuneform' : 'testform'; # Send formating form to client &wsend("HTTP_REFERER=\"$xx\"\n") if ($V>1 && ($xx = $ENV{'HTTP_REFERER'})); &wsend("QUERY_STRING=\"$xx\"\n") if ($V>1 && ($xx = $ENV{'QUERY_STRING'})); &wsend("REQUEST_URI=\"$xx\"\n") if ($V>1 && ($xx = $ENV{'REQUEST_URI'})); &wsend("PATH_INFO=\"$xx\"\n") if ($V>1 && ($xx = $ENV{'PATH_INFO'})); &wsend("pathinfo=\"$pathinfo\"\n") if $V>1; &lsend("pathinfo=\"$pathinfo\"\n") if $V>1; &abclogreq($P,$$,$tmpdir,$RA,$ymd,$hms,-1,'HTML','',$pathinfo); if ($pathinfo =~ m"\.\.") { &lsend("Rejecting pathinfo=\"$pathinfo\" (.. rule)\n") if $V>0; &wsend("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; }
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; }