BinaryMapFile.xmr

   1 <META CONTENT="text/ssperl, CGI='$SERVER_ROOT $CGI_BINARY_FILE $REMOTE_ADDR'"><SCRIPT TYPE=text/ssperl>
   2 # NOTE: no empty lines outside the script tags
   3 #
   4 # 030300        Added directory access blocking for removing CVS directories from downloads
   5 #
   6 # This program contains two tricks:
   7 # 1 .gz compressed and tar.gz compressed archive files are constructed on-line
   8 #   when they don't exist.
   9 # 2 URL: "http:/localhost:8080/<file1>*<file2>*...<fileN>.multipart" requests are treated
  10 #   as a single multi file 'multipart/mixed' MIME type request. That is, a single multipart
  11 #   document with all requested files is constructed on-line (when it doesn't exist).
  12 #   If only the first file contains a URL path, the others will be prefixed with it, e.g.,
  13 #   '/Audio/Daudio/AMDaudio/BLAMD001.WAV*BLAMD001.WAV.MULTIPART' is identical to
  14 #   '/Audio/Daudio/AMDaudio/BLAMD001.WAV*/Audio/Daudio/AMDaudio/BLAMD001.WAV.MULTIPART'
  15 #   NOTE: the view of multipart/mixed documents depends on the BROWSER used.
  16 #
  17 #
  18 ###############################################################################
  19 #
  20 # Author and Copyright (c):
  21 # Rob van Son, © 1999,2000
  22 # Institute of Phonetic Sciences & IFOTT/ACLS
  23 # University of Amsterdam
  24 # Herengracht 338
  25 # NL-1016CG Amsterdam, The Netherlands
  26 # Email: Rob.van.Son@hum.uva.nl
  27 #        ifa@hum.uva.nl
  28 # WWW  : http://www.fon.hum.uva.nl/rob/
  29 # mail:  Institute of Phonetic Sciences
  30 #        University of Amsterdam
  31 #        Herengracht 338
  32 #        NL-1016CG Amsterdam
  33 #        The Netherlands
  34 #        tel +31 205252183
  35 #        fax +31 205252197
  36 #
  37 # License for use and disclaimers
  38 #
  39 # CGIscriptor merges plain ASCII HTML files transparantly
  40 # with CGI variables, in-line PERL code, shell commands,
  41 # and executable scripts in other scripting languages.
  42 #
  43 # This program is free software; you can redistribute it and/or
  44 # modify it under the terms of the GNU General Public License
  45 # as published by the Free Software Foundation; either version 2
  46 # of the License, or (at your option) any later version.
  47 #
  48 # This program is distributed in the hope that it will be useful,
  49 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  50 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  51 # GNU General Public License for more details.
  52 #
  53 # You should have received a copy of the GNU General Public License
  54 # along with this program; if not, write to the Free Software
  55 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  56 #
  57 #
  58 #######################################################>>>>>>>>>>Start Remove
  59 #
  60 # DIRECTORY ACCESS CONTROL: "foo|bar|thing" used as: =~ m@/($BlockAccess)/@
  61 my $BlockAccess = "CVS";    # Block access to the CVS information
  62
  63 # Define mime types extension => mimetype (can be found in .mime.types file)
  64 my %mimeType = (
  65 'HTML' => "text/html",    # These are PROCESSED by CGIscriptor, not just written to STDOUT
  66 'TXT'  => "text/plain",
  67 'PL'  => "text/plain",    # This is incorrect, of course
  68 #'CGI'  => "text/osshell", # Executing shell scripts should not be done
  69 'JPG'  => "image/jpeg",
  70 'JPEG' => "image/jpeg",
  71 'GIF'  => "image/gif",
  72 'TIFF' => "image/tiff",
  73 'TIF'  => "image/tiff",
  74 'AU'   => "audio/basic",
  75 'AIF'  => "audio/aiff",
  76 'AIFC' => "audio/aiff",
  77 'AIFF' => "audio/aiff",
  78 'WAV'  => "audio/wav",
  79 'MPGA' => "audio/mpeg",
  80 'MP2'  => "audio/mpeg",
  81 'MPEG' => "video/mpeg",
  82 'MPG'  => "video/mpeg",
  83 'MPE'  => "video/mpeg",
  84 'MULTIPART' => "multipart/mixed;boundary=NxtCntntTpZdFjgHk".time,  # use a '*' separated list
  85 'QT'   => "video/quicktime",
  86 'MOV'  => "video/quicktime",
  87 'GZ'   => "application/gzip"   # Constructs .gz and .tar.gz files on-line/run-time
  88 );
  89
  90 $CGI_BINARY_FILE =~ /\.([\w]+)$/;       # Get extension
  91 my $extension = uc($1);
  92 unless(exists($mimeType{$extension})) # actually illegal mime
  93 {
  94     exit 0;
  95 };
  96 my $mime = $mimeType{$extension};
  97
  98 my $String;
  99 my $number_of_bytes;
 100
 101 # Print the content type
 102 $String = "Content-type: $mime\n\n";
 103 $number_of_bytes = length($String);
 104 # Actually print the document header
 105 # (but NOT for OSSHELL scripts, which supply their own headers)
 106 syswrite(STDOUT, $String, $number_of_bytes) unless $mime eq "text/osshell";
 107
 108 # THIS LINE PREVENTS ACCESS TO SPECIFIC PARTS OF THE DIRECTORY TREE
 109 exit if $CGI_BINARY_FILE =~ m@/($BlockAccess)/@; # Prevent access to specific subtrees
 110
 111 # First, construct tar.gz and .gz files on-line
 112 if($mime eq "application/gzip" &&  ! -e "$SERVER_ROOT$CGI_BINARY_FILE")
 113 {
 114     # This is a gimmick to construct gnu-zipped tar-files from every requested directory at
 115     # run-time This could be a security weakness and a CPU hog, so be carefull
 116     if($CGI_BINARY_FILE =~ m@\.tar\.gz$@is)
 117     {
 118         $SERVER_ROOT =~ m@/[^/]+$@;     # Get last directory name
 119         my $HomeDirectory = $&;         # The name of the current SERVER_ROOT dir
 120         my $PrePath = $`;                       # The path tho the parent of the server root
 121         # THIS LINE PREVENTs SECURITY BREAKS: INSIST ON FULL PATHS STARTING AT SERVER-ROOT
 122         exit unless $CGI_BINARY_FILE =~ m@^$HomeDirectory@; # Prevent tricks
 123
 124         $CGI_BINARY_FILE =~ m@\.tar\.gz$@is;    # Remove extensions (e.g., .tar.gz)
 125         my $TarPath = $PrePath.$`;              # The path to the directory to be TARRED
 126         die "Illegal tar request from $REMOTE_ADDR: $TarPath\n" unless -d $TarPath; # Only directories allowed
 127
 128         # Use a pipe to prevent memory overloads (I hope).
 129         # Note: the tar start at the PARENT directory of the directory to be
 130         # tarred. The tar excludes symbolic links and .log files.
 131         open(BINARY,
 132         "cd $PrePath;find $TarPath ! -type l ! -type d -print"
 133         ."|grep -v '.log'|egrep -v '/$BlockAccess/'"
 134         ."|sed 's\@$PrePath\@.\@g'|tar -cf - -T -|gzip|")  # Linux tar
 135         || open(BINARY,
 136         "cd $PrePath;find $TarPath ! -type l ! -type d -print"
 137     ."|grep -v '.log'|egrep -v '/$BlockAccess/'"
 138         ."|sed 's\@$PrePath\@.\@g'|tar -cf - -|gzip|")     # SGI Irix tar
 139         || die "$!\n";
 140         # If you want to tar WHOLE directories unconditionally, uncomment the
 141         # following (and remove the above)
 142         # open(BINARY, "cd $PrePath;tar -cf - .$HomeDirectory|gzip|");
 143
 144         # read and write block of 1024 bytes
 145         while($number_of_bytes = sysread(BINARY, $String, 1024))
 146         {
 147             syswrite(STDOUT, $String, $number_of_bytes); # Actually print the file content
 148         };
 149         close(BINARY);
 150     }
 151     # This will construct a gnu-zipped file from every file requested: GET foo.bar.gz will
 152     # result in foo.bar being zipped before delivery.
 153     else
 154     {
 155         $CGI_BINARY_FILE =~ m@\.gz$@is; # Remove extensions (e.g., .tar.gz)
 156         my $GzipPath = $SERVER_ROOT.$`;        # The path to the file to be zipped
 157
 158         # Limit gzip activity to supported file-types
 159         $GzipPath =~ /\.([\w]+)$/;      # Get extension
 160         my $GzipExtension = uc($1);
 161         my $GzipMime = $mimeType{$GzipExtension}; # mime of file to be zipped
 162         die "Illegal tar request from $REMOTE_ADDR: $GzipPath\n" unless $GzipMime && ($GzipMime ne $mime);
 163
 164         # Use a pipe to prevent memory overloads (I hope)
 165         open(BINARY, "gzip -c $GzipPath|");
 166         # read and write block of 1024 bytes
 167         while($number_of_bytes = sysread(BINARY, $String, 1024))
 168         {
 169             syswrite(STDOUT, $String, $number_of_bytes); # Actually print the file content
 170         };
 171         close(BINARY);
 172     };
 173 }
 174 # Second, trick to handle 'multipart/mixed', ie, combined pages, on-line.
 175 # This allows the playback of a sound file coupled to the display of an
 176 # HTML file
 177 elsif($mime =~ m@^multipart/mixed@isg &&  ! -e "$SERVER_ROOT$CGI_BINARY_FILE")
 178 {
 179     $CGI_BINARY_FILE =~ m@[^/]+$@;
 180     my $URLpath = $`;
 181     my $BinaryFileList = $&;
 182     if($URLpath =~ /\*/)   # If each file has separate path, do not use common URLpath
 183     {
 184         $BinaryFileList = $CGI_BINARY_FILE;
 185         $URLpath = '';
 186     };
 187
 188     $BinaryFileList =~ s/\.$extension$//isg;  # Remove Multipart extension
 189     my @FileList = split('\*', $BinaryFileList);
 190     my $InputFile;
 191     $mime =~ /\;boundary\=/;
 192     my $MultipartSeparator = $';
 193     foreach $InputFile (@FileList)
 194     {
 195
 196        # Write separation string
 197        my $String = "\n--$MultipartSeparator\n";
 198        my $number_of_bytes = length($String);
 199        syswrite(STDOUT, $String, $number_of_bytes); # Actually print the separation string
 200
 201        # Recursively process file parts
 202        $CGI_BINARY_FILE = $URLpath.$InputFile;
 203        $ENV{'CGI_BINARY_FILE'} = $URLpath.$InputFile;
 204        main::ProcessFile("~/BinaryMapFile.xmr");
 205     };
 206     # Write closing separation string
 207     my $String = "\n--$MultipartSeparator\n";
 208     my $number_of_bytes = length($String);
 209     syswrite(STDOUT, $String, $number_of_bytes); # Actually print the separation string
 210
 211 }
 212 # Third, process HTML files as CGIscriptor HTML files (when they are part of MULTIPART/MIXED files)
 213 elsif($mime eq 'text/html')
 214 {
 215     main::ProcessFile("~/$CGI_BINARY_FILE");
 216 }
 217 # If you realy cannot live without shell scripts (note the ./)
 218 # Note that the script must supply the content type!
 219 elsif($mime eq 'text/osshell')
 220 {
 221     # Check filename for safety
 222     die "./".$CGI_BINARY_FILE." from $REMOTE_ADDR\n"
 223         unless CGIscriptor::CGIsafeFileName($CGI_BINARY_FILE);
 224     # This doesn't "feel" safe, but it works
 225     print STDOUT `./$CGI_BINARY_FILE`;
 226 }
 227 else  # All other files are just printed
 228 {
 229     open(BINARY, "<$SERVER_ROOT$CGI_BINARY_FILE") || die "$SERVER_ROOT$CGI_BINARY_FILE: $!";
 230
 231     # read and write block of 1024 bytes
 232     while($number_of_bytes = sysread(BINARY, $String, 1024))
 233     {
 234             syswrite(STDOUT, $String, $number_of_bytes); # Actually print the file content
 235     };
 236     close(BINARY);
 237 };
 238
 239 "";
 240 </SCRIPT>