multipart.cgi.in (5575B)
1 #!@PERL@ 2 3 eval "use NKF;"; 4 if (! $@) { 5 $use_NKF = 1; 6 $CONV = "-e"; 7 $MIME_DECODE = "-m -e"; 8 } else { 9 $use_NKF = 0; 10 # $CONV = "w3m -dump -e"; 11 $CONV = "@NKF@ -e"; 12 $MIME_DECODE = "@NKF@ -m -e"; 13 } 14 $MIME_TYPE = "$ENV{'HOME'}/.mime.types"; 15 16 $SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0; 17 $CGI = "file://$SCRIPT_NAME"; 18 19 if ($ENV{'REQUEST_METHOD'} eq 'POST') { 20 sysread(STDIN, $query, $ENV{'CONTENT_LENGTH'}); 21 } elsif (defined($ENV{'QUERY_STRING'})) { 22 $query = $ENV{'QUERY_STRING'}; 23 } 24 if (defined($query)) { 25 for (split('&', $query)) { 26 s/^([^=]*)=//; 27 $v{$1} = $_; 28 } 29 $file = &form_decode($v{'file'}); 30 $boundary = &form_decode($v{'boundary'}); 31 } else { 32 $file = $ARGV[0]; 33 if (@ARGV >= 2) { 34 $boundary = $ARGV[1]; 35 } 36 } 37 (-f $file) || exit(1); 38 open(F, "< $file") || exit(1); 39 $end = 0; 40 $mbody = ''; 41 if (defined($boundary)) { 42 while(<F>) { 43 s/\r?\n$//; 44 ($_ eq "--$boundary") && last; 45 ($_ eq "--$boundary--") && ($end = 1, last); 46 $mbody .= "$_\n"; 47 } 48 } else { 49 while(<F>) { 50 s/\r?\n$//; 51 if (s/^\-\-//) { 52 $boundary = $_; 53 last; 54 } 55 $mbody .= "$_\n"; 56 } 57 } 58 59 if (defined($v{'count'})) { 60 $count = 0; 61 while($count < $v{'count'}) { 62 while(<F>) { 63 s/\r?\n$//; 64 ($_ eq "--$boundary") && last; 65 } 66 eof(F) && exit; 67 $count++; 68 } 69 70 %header = (); 71 $hbody = ''; 72 while(<F>) { 73 /^\s*$/ && last; 74 $x = $_; 75 s/\r?\n$//; 76 if (/=\?/) { 77 $_ = &decode($_, $MIME_DECODE); 78 } 79 if (s/^(\S+)\s*:\s*//) { 80 $h = $&; 81 if ($h =~ /^w3m-control/i) { 82 $h = "WARNING: $h"; 83 } 84 $hbody .= "$h$_\n"; 85 $p = $1; 86 $p =~ tr/A-Z/a-z/; 87 $header{$p} = $_; 88 } elsif (s/^\s+//) { 89 chop $hbody; 90 $hbody .= "$_\n"; 91 $header{$p} .= $_; 92 } 93 } 94 $type = $header{"content-type"}; 95 $dispos = $header{"content-disposition"}; 96 if ($type =~ /application\/octet-stream/) { 97 if ($type =~ /type\=gzip/) { 98 print "Content-Encoding: x-gzip\n"; 99 } 100 if ($type =~ /name=\"?([^\"]+)\"?/ || 101 $dispos =~ /filename=\"?([^\"]+)\"?/) { 102 $type = &guess_type($1); 103 if ($type) { 104 print "Content-Type: $type; name=\"$1\"\n"; 105 } else { 106 print "Content-Type: text/plain; name=\"$1\"\n"; 107 } 108 } 109 } 110 print $hbody; 111 print "\n"; 112 while(<F>) { 113 $x = $_; 114 s/\r?\n$//; 115 ($_ eq "--$boundary") && last; 116 if ($_ eq "--$boundary--") { 117 last; 118 } 119 print $x; 120 } 121 close(F); 122 exit; 123 } 124 125 $qcgi = &html_quote($CGI); 126 $qfile = &html_quote($file); 127 $qboundary = &html_quote($boundary); 128 129 if ($mbody =~ /\S/) { 130 $_ = $mbody; 131 s/\&/\&/g; 132 s/\</\</g; 133 s/\>/\>/g; 134 print "<pre>\n"; 135 print $_; 136 print "</pre>\n"; 137 } 138 139 $count = 0; 140 while(! $end) { 141 %header = (); 142 $hbody = ''; 143 while(<F>) { 144 /^\s*$/ && last; 145 s/\r?\n$//; 146 if (/=\?/) { 147 $_ = &decode($_, $MIME_DECODE); 148 } 149 if (s/^(\S+)\s*:\s*//) { 150 $hbody .= "$&$_\n"; 151 $p = $1; 152 $p =~ tr/A-Z/a-z/; 153 $header{$p} = $_; 154 } elsif (s/^\s+//) { 155 chop $hbody; 156 $hbody .= "$_\n"; 157 $header{$p} .= $_; 158 } 159 } 160 $type = $header{"content-type"}; 161 $dispos = $header{"content-disposition"}; 162 $plain = 0; 163 $image = 0; 164 if (! $dispos || $dispos =~ /^inline/i) { 165 if (! $type || $type =~ /^text\/plain/i) { 166 $plain = 1; 167 } elsif ($type =~ /^image\//i) { 168 $image = 1; 169 } 170 } 171 $body = ''; 172 while(<F>) { 173 s/\r?\n$//; 174 ($_ eq "--$boundary") && last; 175 if ($_ eq "--$boundary--") { 176 $end = 1; 177 last; 178 } 179 if ($plain) { 180 $body .= "$_\n"; 181 } 182 } 183 $| = 1; 184 print "<hr>\n"; 185 { 186 $_ = $hbody; 187 s/\&/\&/g; 188 s/\</\</g; 189 s/\>/\>/g; 190 print "<pre>\n"; 191 print $_; 192 print "</pre>\n"; 193 if ($type =~ /name=\"?([^\"]+)\"?/ || 194 $dispos =~ /filename=\"?([^\"]+)\"?/) { 195 $name = $1; 196 } else { 197 $name = "Content"; 198 } 199 print "<form action=\"$qcgi\">\n"; 200 print "<input type=hidden name=file value=\"$qfile\">\n"; 201 print "<input type=hidden name=boundary value=\"$qboundary\">\n"; 202 print "<input type=hidden name=count value=\"$count\">\n"; 203 if ($image) { 204 print "<input type=image name=submit src=\"$qcgi?file=", 205 &html_quote(&form_encode($file)), 206 "&boundary=", 207 &html_quote(&form_encode($boundary)), 208 "&count=$count\" alt=\"", 209 &html_quote($name), "\">\n"; 210 } else { 211 print "<input type=submit name=submit value=\"", 212 &html_quote($name), "\">\n"; 213 } 214 print "</form>\n" 215 } 216 if ($plain) { 217 $body = &decode($body, $CONV); 218 $_ = $body; 219 s/\&/\&/g; 220 s/\</\</g; 221 s/\>/\>/g; 222 print "<pre>\n\n"; 223 print $_; 224 print "</pre>\n"; 225 } 226 eof(F) && last; 227 $count++; 228 } 229 close(F); 230 231 sub decode { 232 if ($use_NKF) { 233 local($body, $opt) = @_; 234 return nkf($opt, $body); 235 } 236 local($body, @cmd) = @_; 237 local($_); 238 239 $| = 1; 240 pipe(R, W2); 241 pipe(R2, W); 242 if (! fork()) { 243 close(F); 244 close(R); 245 close(W); 246 open(STDIN, "<&R2"); 247 open(STDOUT, ">&W2"); 248 exec @cmd; 249 die; 250 } 251 close(R2); 252 close(W2); 253 print W $body; 254 close(W); 255 $body = ''; 256 while(<R>) { 257 $body .= $_; 258 } 259 close(R); 260 return $body; 261 } 262 263 sub html_quote { 264 local($_) = @_; 265 local(%QUOTE) = ( 266 '<', '<', 267 '>', '>', 268 '&', '&', 269 '"', '"', 270 ); 271 s/[<>&"]/$QUOTE{$&}/g; 272 return $_; 273 } 274 275 sub form_decode { 276 local($_) = @_; 277 s/\+/ /g; 278 s/%([\da-f][\da-f])/pack('c', hex($1))/egi; 279 return $_; 280 } 281 282 sub form_encode { 283 local($_) = @_; 284 s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg; 285 return $_; 286 } 287 288 sub guess_type { 289 local($_) = @_; 290 291 /\.(\w+)$/ || return ""; 292 $_ = $1; 293 tr/A-Z/a-z/; 294 %mime_type = &load_mime_type($MIME_TYPE); 295 $mime_type{$_}; 296 } 297 298 sub load_mime_type { 299 local($file) = @_; 300 local(%m, $a, @b, $_); 301 302 open(M, "< $file") || return (); 303 while(<M>) { 304 /^#/ && next; 305 chop; 306 (($a, @b) = split(" ")) >= 2 || next; 307 for(@b) { 308 $m{$_} = $a; 309 } 310 } 311 close(M); 312 return %m; 313 }