$0

#!/usr/bin/perl -Tw # #NAME # sess - Musical Session tool # #SYNOPSIS # http://host.dom.ain:port/CGI/sess/... # #DESCRIPTION # This program does something ... # #OPTIONS # #FILES # #BUGS # #SEE ALSO # #AUTHOR John Chambers $| = 1; #use strict; my $exitstat = 0; my($e, $n, @names, $query, $v, @vals); my($botname, $hms, $msg, $UA, $ymd); my($botpat) = # Pattern to recognize bots in UA '[-\w]*Google\w*|msnbot|BecomeBot|bingbot|Yahoo[-.\s\w]*|scirus-crawler'; #push @INC, '.'; use CGI; use CGI::Carp 'fatalsToBrowser'; use diagnostics; print "Content-type: text/html\n\n"; print "$0\n"; print "$0\n" if $V>2; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # require &LocalSetup(2); # Figure out localization stuff print "Called from $RA at $cymd $hms V=$V.
\n"; print "now: $now
\n" if $V>2; print "0: $0
\n" if $V>2; print "P4: $P4
\n" if $V>4; print "Host: $fqdn
\n" if $V>2; &dumpform() if $V>2; &dumpenv() if $V>2; &chkclient() if $V>2; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # print "$P: require \"$host-cgilocal.pm\" ...
\n" if $V>2; require "$host-cgilocal.pm"; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # unless ($ref = $ENV{'HTTP_REFERER'}) { print "### No HTTP_REFERER value ###
\n" if $V>0; &quit(1,"No HTTP_REFERER"); } #($dir = $ref) =~ s"^.*/music/""; if ($ref =~ m"^(.*)/music/(.*)$") { $dir = $2; print "dir: \"$dir\"
\n" if $V>1; } else { print "$P: No /music/ in HTTP_REFERER string \"$ref\"
\n" if $V>0; quit(3,"No /music/ in HTTP_REFERER string"); } print "musdir: \"$musdir\"
\n" if $V>1; ($path = "$musdir/$dir/") =~ s"/+$""; print "path: \"$path\"
\n" if $V>1; unless (-d $path) { print "$P: \"$path\" is not a directory.\n" if $V>0; &quit(2,"Directory $path/ does not exist here"); } &tunelist($path); print "$P: tunelist done.
\n" if $V>1; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # print "Exit with statux $exitstat.
\n" if $V>1; print "

\n"; exit $exitstat; # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # sub chkclient { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Check for known bots, and reject their request if they've asked for a tune # # match. But we don't discriminate against them here; we just announce that # # we think they're a bot. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # if ($UA = $query->param('HTTP_USER_AGENT')) { if ($UA =~ /$botpat/i) { $botname = $1; my($ss,$mm,$hh,$DD,$MM,$CY) = gmtime(time); $CY += 1900; $ymd = sprintf("%04d%02d%02d",$CY,1+$MM,$DD); # CCYY-MM-DD $hms = sprintf("%02d%02d%02d",$hh,$mm,$ss); # HH:MM:SS $msg = "[$ymd $hms] $$ $0: Request from \"$botname\" bot."; print STDERR "$msg\n"; # Tell the errlog about it print "$msg\n"; # Tell the client about it } } } sub dumpenv { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # print "

Here are our environment variables:\n"; print "

$e: $v\n"; } print "

\n"; print "

\n"; } sub dumpform { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # print "

Here are our form elements:\n"; $query = new CGI; @names = $query->param(); print "

$n: \"$v\"\n"} } elsif ($v = $query->param($n)) { print "
$n: \"$v\"\n"; } else { print "
$n: (NO VALUE)\n"; } } print "

\n"; print "

\n"; } sub linkABC {my $F='linkABC'; $url = shift; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Given the URL of a file, we return the hyperlink that returns it as an # # object of type ABC. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # return "ABC"; } sub linkPNG {my $F='linkPNG'; $url = shift; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Given the URL of a file, we return the hyperlink that returns it as an # # object of type PNG. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # return "PNG"; } sub linkPDF {my $F='linkPDF'; $url = shift; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Given the URL of a file, we return the hyperlink that returns it as an # # object of type PDF. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # return "PDF"; } sub LocalSetup {my $F='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'; # Fixed path for safety $fqdn = $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'}; # Client's name for us $V = $Vtest unless defined $V; # print "$F: V='$V'
\n"; if ($0 =~ m"^(.*)/([^/]*)$") { # Look in our process name for directory $Pdir = $1; print "$F 1: Pdir='$Pdir'
\n" if $V>2; $P = $2; print "$F 1: P='$P'
\n" if $V>2; } elsif (-d $homedir) { $Pdir = $homedir; # If no full pathname, use the homedir ($P = $0) =~ s".*/""; $Pdir = $1; print "$F 2: Pdir='$Pdir'
\n" if $V>1; $P = $2; print "$F 2: P='$P'
\n" if $V>1; } else { print STDERR "$0: Can't figure out our home directory, using '.'.\n" if $V>0; $Pdir = '.'; $homedir = '.'; # Maybe this will work ;-) # exit 1; } push @INC, $Pdir; push @INC, '.'; umask 0002; # Output files must be group writable if (defined $Pdir && -d $Pdir) {chdir $Pdir} $| = 1; # Unbuffered STDOUT $" = ','; # Used in verbose messages &Vopt($ENV{"V_$P"},'1'); print V "$P: called with V=$V Pdir=$Pdir
\n" if $V>2; $P4 = ($P =~ /^(....)/) ? $1 : 'tune'; $Venv = (defined($ENV{"V_$P"}) ? $ENV{"V_$P"} : '1') . ' 1'; $Vsrc = "Venv='$Venv'"; if ($Venv =~ /(\d+)/) { # Verbose level $V = $1; } $Vtest = 1 unless defined $Vtest; ($ENV{REMOTE_ADDR} || '0.0.0.0') =~ m/^\s*([\d.]+)\s*$/; $RA = ($1 || '[unknown]'); $Vaddr = '0.0.0.0' unless defined $Vaddr; if ($RA eq $Vaddr) { # My home machine? if ($V<$Vtest) {$V = $Vtest; $Vsrc = "Vtest=$Vtest"} } elsif ($RA =~ /^192\.168\./) { # My home network? $V = $Vtest if $V<$Vtest; if ($V<$Vtest) {$V = $Vtest; $Vsrc = "Vtest=$Vtest"} } local($ss,$mm,$hh,$DD,$MM,$YY) = gmtime($now = time); # Current date/time $cymd = 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 white stuff ($host = $1) =~ s/\..*//; # Strip off domain stuff if present $hstloc = $host . "-cgilocal.pm"; $cgiloc = (-f $hstloc) ? $hstloc : 'cgilocal.pm'; print V "$P: host='$host' cgiloc='$cgiloc'\n" if $V>2; return $cgiloc; } sub quit {my $P='quit'; local($stat,$reason) = @_; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # print "$P: Exit with status $stat [$reason]\n" if $V>0 && $stat>0; exit $stat; } sub tunelist {my $F='tunelist'; local($pth) = @_; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # local ($file,$files,$key,%list,$name,$type,$url,$where); print "$F: List tunes in \"$pth\" ...
\n" if $V>2; unless (open LIST, "find $pth -name '*.abc' |") { print STDERR "$P: Can't run find command\n" if $V>0; return 0; } $files = 0; file: while ($file = ) { $file =~ s/[\r\s]+$//; print "$F: file=\"$file\"
\n" if $V>2; ++$files; if ($file =~ m"^$pth/*(.*)$") { $where = $1; print "$F: where='$where'
\n" if $V>2; } else { print "$F: ### Wrong path in '$file'
\n" if $V>0; next file; } if (($type,$name) = ($where =~ m"^(.*)/(.+)$")) { print "$F: Tune type '$type' name '$name'
\n" if $V>2; $list{"$name/$type"} = $where; # To sort by name } else { print "$F: ### Can't parse location \"$where\"
\n" if $V>0; } } close LIST; print "Found $files files in \"$pth\".\n" if $V>1; print "\n"; print "\n"; print "\n"; for $key (sort keys %list) { print "\n"; if (($name,$type) = ($key =~ m"^(.*)/(.*)$")) { # print "\n"; $url = "$musurl/$dir/$type/$name"; print "\n"; print "\n"; print "\n"; print "\n"; if (($n,$k,$m,$s) = ($name =~ m"^(.*)-([A-G][^-]*)-(\d*)-(\d*)\.abc")) { $n =~ s/_/ /g; print "\n"; print "\n"; print "\n"; print "\n"; } else { print "\n"; print "\n"; print "\n"; } } else { print "\n"; } print "\n"; } print "
ABC PNG PDF Type Key B S Title
$key " . &linkABC($url) . " " . &linkPNG($url) . " " . &linkPDF($url) . " $type $k $m $s $n --- ? $name $key
\n"; print "\n"; return $files; } sub Vopt { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Set the verbosity from various environment variables. The value may # # be a verbose level (1 digit), plus an optional output file name. # # The file V is opened to the file, if any, or STDERR by default. The # # default value for the verbosity level is 1, which generally means # # to produce only serious error messages. # # # # Here's how this routine is typically called: # # ($P = $0) =~ s'.*/'' unless defined($P); # # &Vopt($ENV{"V_$P"} || $ENV{"D_$P"} || $ENV{"T_$P"} || '1'); # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # $Vopt = shift || '1'; # print "
Vopt: Vopt=\"$Vopt\"
\n" if $V>1; if ($Vopt =~ /^(\d+)(.+)$/) { $V = $1; $Vfil = $2; if (!open(V,">>$Vfil")) { print V "$P: Can't write \"$Vfil\" ($!)\n" if $V>0; open(V,">>&STDERR"); } } else { $V = $Vopt; open(V,">>&STDERR"); } select V; $| = 1; select STDOUT; $| = 1; $esep = '=' x 70; print V "\n$P $esep\n" if $V>1; $hsep = '-' x 70; print V "\n$P $hsep\n" if $V>1; print V "$P started with V=$V ", `date` if $V>1; }