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