w3m

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/w3m.git/
Log | Files | Refs | README

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/\&/\&amp;/g;
    132 	s/\</\&lt;/g;
    133 	s/\>/\&gt;/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/\&/\&amp;/g;
    188 		s/\</\&lt;/g;
    189 		s/\>/\&gt;/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 				"&amp;boundary=",
    207 				&html_quote(&form_encode($boundary)),
    208 				"&amp;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/\&/\&amp;/g;
    220 		s/\</\&lt;/g;
    221 		s/\>/\&gt;/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     '<', '&lt;',
    267     '>', '&gt;',
    268     '&', '&amp;',
    269     '"', '&quot;',
    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 }