From 08170b8be6db18c664075b8b6833a2cd02d94c7c Mon Sep 17 00:00:00 2001 From: Fumitoshi UKAI Date: Sat, 26 Apr 2003 17:01:01 +0000 Subject: [w3m-dev 03886] Re: POSTing patch (Re: User-Agent for Bonus/2ch.cgi) * Bonus/2ch.cgi: posting From: qhwt@myrealbox.com --- Bonus/2ch.cgi | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 70 insertions(+), 1 deletion(-) (limited to 'Bonus/2ch.cgi') diff --git a/Bonus/2ch.cgi b/Bonus/2ch.cgi index edb36b7..998c202 100755 --- a/Bonus/2ch.cgi +++ b/Bonus/2ch.cgi @@ -11,11 +11,19 @@ if (/subback.html$/) { exit; } -s@(/\d+)(/([^/]*))?$@$1@ || exit; +s@/(\d+)(/([^/]*))?$@/$1@ || exit; +my $datnum = $1; $label = $3; $cgi = "$CGI?$_"; + s@^http://([^/]+)/test/read.cgi/([^/]+)/@$1/$2/dat/@ || exit; $subback = "$CGI?http://$1/$2/subback.html"; +$bbs = $2; +if ($ENV{REQUEST_METHOD} eq "POST") { + &post(); + exit; +} + $_ .= ".dat"; $dat = "http://$_"; $tmp = $ENV{"HOME"} . "/.w3m2ch/$_"; @@ -99,6 +107,7 @@ EOF print <
+
名前: E-mail (省略可) :
EOF sub link { @@ -133,3 +142,63 @@ EOF } unlink($tmp); } + +sub post { + my $debug = 0; + + $| = 1; + use IO::Socket; + my @POST = <>; + $QUERY_STRING =~ m@^http://([^/]+)@; + my $host = $1; + my $sock = IO::Socket::INET->new("$host:80") or die; + # retrieve posting cookie; this may not work + print "Content-Type: text/html\n\n"; + print $sock + "HEAD /test/bbs.cgi HTTP/1.1\n", + "Host: $host\n", + "Connection: keep-alive\n", + "\n"; + my $posting_cookie = undef; + while (<$sock>) { + print if ($debug); + s/[\n\r]+$//; + last if (/^$/); + if (/^set-cookie:.*(PON=[^;]+)/i) { + $posting_cookie = $1; + } + } + #$sock = IO::Socket::INET->new("$host:80") or die; + my $submit = + "POST /test/bbs.cgi HTTP/1.1\n" . + "Host: $host\n" . + "Accept-Language: ja\n" . + "User-Agent: $UserAgent\n" . + "Referer: $QUERY_STRING\n" . + "Cookie: $posting_cookie; NAME=nobody; MAIL=sage\n" . + "Content-Length: " . length(join("", @POST)) . "\n" . + "\n@POST"; + print $sock $submit or die; + print "\n-- POSTed contents --\n${submit}\n-- POSTed contents --\n" + if ($debug); + my $chunked = 0; + while (<$sock>) { + s/[\n\r]*$//; + last if (/^$/); + $chunked = 1 if (/^transfer-encoding:\s*chunked/i); + } + my $post_response = ""; + while (<$sock>) { + if ($chunked) { + s/[ \r\n]*$//; + my $len = hex($_); + $len > 0 or last; + read($sock, $_, $len); + <$sock>; #skip empty line at the end of chunk. + } + $post_response .= $_; + } + $post_response =~ s///im; + print $post_response; + exit; +} -- cgit v1.2.3