aboutsummaryrefslogtreecommitdiffstats
path: root/scripts/multipart/multipart.cgi.in
diff options
context:
space:
mode:
authorTatsuya Kinoshita <tats@vega.ocn.ne.jp>2011-05-04 07:18:09 +0000
committerTatsuya Kinoshita <tats@vega.ocn.ne.jp>2011-05-04 07:18:09 +0000
commit5f8e0f8ef9a422691dd72e8a953a42a41478fcb4 (patch)
tree4b2df4796a534793648b3c4fc532fc36bd0cd525 /scripts/multipart/multipart.cgi.in
parentReleasing debian version 0.3-2.4 (diff)
downloadw3m-7867af0e1dc0477b9fdc08cf6e3aee68f03ae9f1.tar.gz
w3m-7867af0e1dc0477b9fdc08cf6e3aee68f03ae9f1.zip
Releasing debian version 0.5.1-1debian/0.5.1-1
Diffstat (limited to 'scripts/multipart/multipart.cgi.in')
-rw-r--r--scripts/multipart/multipart.cgi.in313
1 files changed, 313 insertions, 0 deletions
diff --git a/scripts/multipart/multipart.cgi.in b/scripts/multipart/multipart.cgi.in
new file mode 100644
index 0000000..db8001c
--- /dev/null
+++ b/scripts/multipart/multipart.cgi.in
@@ -0,0 +1,313 @@
+#!@PERL@
+
+eval "use NKF;";
+if (! $@) {
+ $use_NKF = 1;
+ $CONV = "-e";
+ $MIME_DECODE = "-m -e";
+} else {
+ $use_NKF = 0;
+# $CONV = "w3m -dump -e";
+ $CONV = "@NKF@ -e";
+ $MIME_DECODE = "@NKF@ -m -e";
+}
+$MIME_TYPE = "$ENV{'HOME'}/.mime.types";
+
+$SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0;
+$CGI = "file://$SCRIPT_NAME";
+
+if ($ENV{'REQUEST_METHOD'} eq 'POST') {
+ sysread(STDIN, $query, $ENV{'CONTENT_LENGTH'});
+} elsif (defined($ENV{'QUERY_STRING'})) {
+ $query = $ENV{'QUERY_STRING'};
+}
+if (defined($query)) {
+ for (split('&', $query)) {
+ s/^([^=]*)=//;
+ $v{$1} = $_;
+ }
+ $file = &form_decode($v{'file'});
+ $boundary = &form_decode($v{'boundary'});
+} else {
+ $file = $ARGV[0];
+ if (@ARGV >= 2) {
+ $boundary = $ARGV[1];
+ }
+}
+(-f $file) || exit(1);
+open(F, "< $file") || exit(1);
+$end = 0;
+$mbody = '';
+if (defined($boundary)) {
+ while(<F>) {
+ s/\r?\n$//;
+ ($_ eq "--$boundary") && last;
+ ($_ eq "--$boundary--") && ($end = 1, last);
+ $mbody .= "$_\n";
+ }
+} else {
+ while(<F>) {
+ s/\r?\n$//;
+ if (s/^\-\-//) {
+ $boundary = $_;
+ last;
+ }
+ $mbody .= "$_\n";
+ }
+}
+
+if (defined($v{'count'})) {
+ $count = 0;
+ while($count < $v{'count'}) {
+ while(<F>) {
+ s/\r?\n$//;
+ ($_ eq "--$boundary") && last;
+ }
+ eof(F) && exit;
+ $count++;
+ }
+
+ %header = ();
+ $hbody = '';
+ while(<F>) {
+ /^\s*$/ && last;
+ $x = $_;
+ s/\r?\n$//;
+ if (/=\?/) {
+ $_ = &decode($_, $MIME_DECODE);
+ }
+ if (s/^(\S+)\s*:\s*//) {
+ $h = $&;
+ if ($h =~ /^w3m-control/i) {
+ $h = "WARNING: $h";
+ }
+ $hbody .= "$h$_\n";
+ $p = $1;
+ $p =~ tr/A-Z/a-z/;
+ $header{$p} = $_;
+ } elsif (s/^\s+//) {
+ chop $hbody;
+ $hbody .= "$_\n";
+ $header{$p} .= $_;
+ }
+ }
+ $type = $header{"content-type"};
+ $dispos = $header{"content-disposition"};
+ if ($type =~ /application\/octet-stream/) {
+ if ($type =~ /type\=gzip/) {
+ print "Content-Encoding: x-gzip\n";
+ }
+ if ($type =~ /name=\"?([^\"]+)\"?/ ||
+ $dispos =~ /filename=\"?([^\"]+)\"?/) {
+ $type = &guess_type($1);
+ if ($type) {
+ print "Content-Type: $type; name=\"$1\"\n";
+ } else {
+ print "Content-Type: text/plain; name=\"$1\"\n";
+ }
+ }
+ }
+ print $hbody;
+ print "\n";
+ while(<F>) {
+ $x = $_;
+ s/\r?\n$//;
+ ($_ eq "--$boundary") && last;
+ if ($_ eq "--$boundary--") {
+ last;
+ }
+ print $x;
+ }
+ close(F);
+ exit;
+}
+
+$qcgi = &html_quote($CGI);
+$qfile = &html_quote($file);
+$qboundary = &html_quote($boundary);
+
+if ($mbody =~ /\S/) {
+ $_ = $mbody;
+ s/\&/\&amp;/g;
+ s/\</\&lt;/g;
+ s/\>/\&gt;/g;
+ print "<pre>\n";
+ print $_;
+ print "</pre>\n";
+}
+
+$count = 0;
+while(! $end) {
+ %header = ();
+ $hbody = '';
+ while(<F>) {
+ /^\s*$/ && last;
+ s/\r?\n$//;
+ if (/=\?/) {
+ $_ = &decode($_, $MIME_DECODE);
+ }
+ if (s/^(\S+)\s*:\s*//) {
+ $hbody .= "$&$_\n";
+ $p = $1;
+ $p =~ tr/A-Z/a-z/;
+ $header{$p} = $_;
+ } elsif (s/^\s+//) {
+ chop $hbody;
+ $hbody .= "$_\n";
+ $header{$p} .= $_;
+ }
+ }
+ $type = $header{"content-type"};
+ $dispos = $header{"content-disposition"};
+ $plain = 0;
+ $image = 0;
+ if (! $dispos || $dispos =~ /^inline/i) {
+ if (! $type || $type =~ /^text\/plain/i) {
+ $plain = 1;
+ } elsif ($type =~ /^image\//i) {
+ $image = 1;
+ }
+ }
+ $body = '';
+ while(<F>) {
+ s/\r?\n$//;
+ ($_ eq "--$boundary") && last;
+ if ($_ eq "--$boundary--") {
+ $end = 1;
+ last;
+ }
+ if ($plain) {
+ $body .= "$_\n";
+ }
+ }
+ $| = 1;
+ print "<hr>\n";
+ {
+ $_ = $hbody;
+ s/\&/\&amp;/g;
+ s/\</\&lt;/g;
+ s/\>/\&gt;/g;
+ print "<pre>\n";
+ print $_;
+ print "</pre>\n";
+ if ($type =~ /name=\"?([^\"]+)\"?/ ||
+ $dispos =~ /filename=\"?([^\"]+)\"?/) {
+ $name = $1;
+ } else {
+ $name = "Content";
+ }
+ print "<form action=\"$qcgi\">\n";
+ print "<input type=hidden name=file value=\"$qfile\">\n";
+ print "<input type=hidden name=boundary value=\"$qboundary\">\n";
+ print "<input type=hidden name=count value=\"$count\">\n";
+ if ($image) {
+ print "<input type=image name=submit src=\"$qcgi?file=",
+ &html_quote(&form_encode($file)),
+ "&amp;boundary=",
+ &html_quote(&form_encode($boundary)),
+ "&amp;count=$count\" alt=\"",
+ &html_quote($name), "\">\n";
+ } else {
+ print "<input type=submit name=submit value=\"",
+ &html_quote($name), "\">\n";
+ }
+ print "</form>\n"
+ }
+ if ($plain) {
+ $body = &decode($body, $CONV);
+ $_ = $body;
+ s/\&/\&amp;/g;
+ s/\</\&lt;/g;
+ s/\>/\&gt;/g;
+ print "<pre>\n\n";
+ print $_;
+ print "</pre>\n";
+ }
+ eof(F) && last;
+ $count++;
+}
+close(F);
+
+sub decode {
+if ($use_NKF) {
+ local($body, $opt) = @_;
+ return nkf($opt, $body);
+}
+ local($body, @cmd) = @_;
+ local($_);
+
+ $| = 1;
+ pipe(R, W2);
+ pipe(R2, W);
+ if (! fork()) {
+ close(F);
+ close(R);
+ close(W);
+ open(STDIN, "<&R2");
+ open(STDOUT, ">&W2");
+ exec @cmd;
+ die;
+ }
+ close(R2);
+ close(W2);
+ print W $body;
+ close(W);
+ $body = '';
+ while(<R>) {
+ $body .= $_;
+ }
+ close(R);
+ return $body;
+}
+
+sub html_quote {
+ local($_) = @_;
+ local(%QUOTE) = (
+ '<', '&lt;',
+ '>', '&gt;',
+ '&', '&amp;',
+ '"', '&quot;',
+ );
+ s/[<>&"]/$QUOTE{$&}/g;
+ return $_;
+}
+
+sub form_decode {
+ local($_) = @_;
+ s/\+/ /g;
+ s/%([\da-f][\da-f])/pack('c', hex($1))/egi;
+ return $_;
+}
+
+sub form_encode {
+ local($_) = @_;
+ s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg;
+ return $_;
+}
+
+sub guess_type {
+ local($_) = @_;
+
+ /\.(\w+)$/ || return "";
+ $_ = $1;
+ tr/A-Z/a-z/;
+ %mime_type = &load_mime_type($MIME_TYPE);
+ $mime_type{$_};
+}
+
+sub load_mime_type {
+ local($file) = @_;
+ local(%m, $a, @b, $_);
+
+ open(M, "< $file") || return ();
+ while(<M>) {
+ /^#/ && next;
+ chop;
+ (($a, @b) = split(" ")) >= 2 || next;
+ for(@b) {
+ $m{$_} = $a;
+ }
+ }
+ close(M);
+ return %m;
+}