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
4 # 030300 Added directory access blocking for removing CVS directories from downloads
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.
18 ###############################################################################
20 # Author and Copyright (c):
21 # Rob van Son, © 1999,2000
22 # Institute of Phonetic Sciences & IFOTT/ACLC
23 # University of Amsterdam
24 # Email: R.J.J.H.vanSon@uva.nl
25 # WWW : http://www.fon.hum.uva.nl/rob/
27 # License for use and disclaimers
29 # CGIscriptor merges plain ASCII HTML files transparantly
30 # with CGI variables, in-line PERL code, shell commands,
31 # and executable scripts in other scripting languages.
33 # This program is free software; you can redistribute it and/or
34 # modify it under the terms of the GNU General Public License
35 # as published by the Free Software Foundation; either version 2
36 # of the License, or (at your option) any later version.
38 # This program is distributed in the hope that it will be useful,
39 # but WITHOUT ANY WARRANTY; without even the implied warranty of
40 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
41 # GNU General Public License for more details.
43 # You should have received a copy of the GNU General Public License
44 # along with this program; if not, write to the Free Software
45 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
48 #######################################################>>>>>>>>>>Start Remove
50 # DIRECTORY ACCESS CONTROL: "foo|bar|thing" used as: =~ m@/($BlockAccess)/@
51 my $BlockAccess = "CVS"; # Block access to the CVS information
53 # Define mime types extension => mimetype (can be found in .mime.types file)
55 'HTML' => "text/html", # These are PROCESSED by CGIscriptor, not just written to STDOUT
56 'TXT' => "text/plain",
57 'PL' => "text/plain", # This is incorrect, of course
58 'DIR' => "text/html", # This is incorrect, of course
59 #'CGI' => "text/osshell", # Executing shell scripts should not be done
60 'JPG' => "image/jpeg",
61 'JPEG' => "image/jpeg",
63 'TIFF' => "image/tiff",
64 'TIF' => "image/tiff",
65 'AU' => "audio/basic",
66 'AIF' => "audio/aiff",
67 'AIFC' => "audio/aiff",
68 'AIFF' => "audio/aiff",
70 'MPGA' => "audio/mpeg",
71 'MP2' => "audio/mpeg",
72 'MPEG' => "video/mpeg",
73 'MPG' => "video/mpeg",
74 'MPE' => "video/mpeg",
75 'MULTIPART' => "multipart/mixed;boundary=NxtCntntTpZdFjgHk".time, # use a '*' separated list
76 'QT' => "video/quicktime",
77 'MOV' => "video/quicktime",
78 'GZ' => "application/gzip" # Constructs .gz and .tar.gz files on-line/run-time
81 $CGI_BINARY_FILE =~ /\.([\w]+)$/; # Get extension
82 my $extension = uc($1);
83 $extension = 'DIR' if !$extension && -d "$SERVER_ROOT$CGI_BINARY_FILE";
84 unless(exists($mimeType{$extension})) # actually illegal mime
88 my $mime = $mimeType{$extension};
93 # Print the content type
94 $String = "Content-type: $mime\n\n";
95 $number_of_bytes = length($String);
96 # Actually print the document header
97 # (but NOT for OSSHELL scripts, which supply their own headers)
98 syswrite(STDOUT, $String, $number_of_bytes) unless $mime eq "text/osshell";
100 # THIS LINE PREVENTS ACCESS TO SPECIFIC PARTS OF THE DIRECTORY TREE
101 exit if $CGI_BINARY_FILE =~ m@/($BlockAccess)/@; # Prevent access to specific subtrees
103 # First, construct tar.gz and .gz files on-line
104 if($mime eq "application/gzip" && ! -e "$SERVER_ROOT$CGI_BINARY_FILE")
106 # This is a gimmick to construct gnu-zipped tar-files from every requested directory at
107 # run-time This could be a security weakness and a CPU hog, so be carefull
108 if($CGI_BINARY_FILE =~ m@\.tar\.gz$@is)
110 $SERVER_ROOT =~ m@/[^/]+$@; # Get last directory name
111 my $HomeDirectory = $&; # The name of the current SERVER_ROOT dir
112 my $PrePath = $`; # The path tho the parent of the server root
113 # THIS LINE PREVENTs SECURITY BREAKS: INSIST ON FULL PATHS STARTING AT SERVER-ROOT
114 exit unless $CGI_BINARY_FILE =~ m@^$HomeDirectory@; # Prevent tricks
116 $CGI_BINARY_FILE =~ m@\.tar\.gz$@is; # Remove extensions (e.g., .tar.gz)
117 my $TarPath = $PrePath.$`; # The path to the directory to be TARRED
118 die "Illegal tar request from $REMOTE_ADDR: $TarPath\n" unless -d $TarPath; # Only directories allowed
120 # Use a pipe to prevent memory overloads (I hope).
121 # Note: the tar start at the PARENT directory of the directory to be
122 # tarred. The tar excludes symbolic links and .log files.
124 "cd $PrePath;find $TarPath ! -type l ! -type d -print"
125 ."|grep -v '.log'|egrep -v '/$BlockAccess/'"
126 ."|sed 's\@$PrePath\@.\@g'|tar -cf - -T -|gzip|") # Linux tar
128 "cd $PrePath;find $TarPath ! -type l ! -type d -print"
129 ."|grep -v '.log'|egrep -v '/$BlockAccess/'"
130 ."|sed 's\@$PrePath\@.\@g'|tar -cf - -|gzip|") # SGI Irix tar
132 # If you want to tar WHOLE directories unconditionally, uncomment the
133 # following (and remove the above)
134 # open(BINARY, "cd $PrePath;tar -cf - .$HomeDirectory|gzip|");
136 # read and write block of 1024 bytes
137 while($number_of_bytes = sysread(BINARY, $String, 1024))
139 syswrite(STDOUT, $String, $number_of_bytes); # Actually print the file content
143 # This will construct a gnu-zipped file from every file requested: GET foo.bar.gz will
144 # result in foo.bar being zipped before delivery.
147 $CGI_BINARY_FILE =~ m@\.gz$@is; # Remove extensions (e.g., .tar.gz)
148 my $GzipPath = $SERVER_ROOT.$`; # The path to the file to be zipped
150 # Limit gzip activity to supported file-types
151 $GzipPath =~ /\.([\w]+)$/; # Get extension
152 my $GzipExtension = uc($1);
153 my $GzipMime = $mimeType{$GzipExtension}; # mime of file to be zipped
154 die "Illegal tar request from $REMOTE_ADDR: $GzipPath\n" unless $GzipMime && ($GzipMime ne $mime);
156 # Use a pipe to prevent memory overloads (I hope)
157 open(BINARY, "gzip -c $GzipPath|");
158 # read and write block of 1024 bytes
159 while($number_of_bytes = sysread(BINARY, $String, 1024))
161 syswrite(STDOUT, $String, $number_of_bytes); # Actually print the file content
166 # Second, trick to handle 'multipart/mixed', ie, combined pages, on-line.
167 # This allows the playback of a sound file coupled to the display of an
169 elsif($mime =~ m@^multipart/mixed@isg && ! -e "$SERVER_ROOT$CGI_BINARY_FILE")
171 $CGI_BINARY_FILE =~ m@[^/]+$@;
173 my $BinaryFileList = $&;
174 if($URLpath =~ /\*/) # If each file has separate path, do not use common URLpath
176 $BinaryFileList = $CGI_BINARY_FILE;
180 $BinaryFileList =~ s/\.$extension$//isg; # Remove Multipart extension
181 my @FileList = split('\*', $BinaryFileList);
183 $mime =~ /\;boundary\=/;
184 my $MultipartSeparator = $';
185 foreach $InputFile (@FileList)
188 # Write separation string
189 my $String = "\n--$MultipartSeparator\n";
190 my $number_of_bytes = length($String);
191 syswrite(STDOUT, $String, $number_of_bytes); # Actually print the separation string
193 # Recursively process file parts
194 $CGI_BINARY_FILE = $URLpath.$InputFile;
195 $ENV{'CGI_BINARY_FILE'} = $URLpath.$InputFile;
196 main::ProcessFile("~/BinaryMapFile.xmr");
198 # Write closing separation string
199 my $String = "\n--$MultipartSeparator\n";
200 my $number_of_bytes = length($String);
201 syswrite(STDOUT, $String, $number_of_bytes); # Actually print the separation string
204 # Third, process HTML files as CGIscriptor HTML files (when they are part of MULTIPART/MIXED files)
205 elsif($mime eq 'text/html')
207 main::ProcessFile("~/$CGI_BINARY_FILE") unless -d "$SERVER_ROOT$CGI_BINARY_FILE";
208 CGIscriptor::BrowseAllDirs($CGI_BINARY_FILE, 'index.html') if -d "$SERVER_ROOT$CGI_BINARY_FILE";
210 # If you realy cannot live without shell scripts (note the ./)
211 # Note that the script must supply the content type!
212 elsif($mime eq 'text/osshell')
214 # Check filename for safety
215 die "./".$CGI_BINARY_FILE." from $REMOTE_ADDR\n"
216 unless CGIscriptor::CGIsafeFileName($CGI_BINARY_FILE);
217 # This doesn't "feel" safe, but it works
218 print STDOUT `./$CGI_BINARY_FILE`;
220 else # All other files are just printed
222 open(BINARY, "<$SERVER_ROOT$CGI_BINARY_FILE") || die "$SERVER_ROOT$CGI_BINARY_FILE: $!";
224 # read and write block of 1024 bytes
225 while($number_of_bytes = sysread(BINARY, $String, 1024))
227 syswrite(STDOUT, $String, $number_of_bytes); # Actually print the file content