diff options
| -rwxr-xr-x | Bonus/2ch.cgi | 71 | ||||
| -rw-r--r-- | ChangeLog | 7 |
2 files changed, 76 insertions, 2 deletions
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 <<EOF; </dl> <hr> +<form method=POST action="$cgi"><input type=submit value="書き込む" name=submit> 名前： <input name=FROM size=19> E-mail<font size=1> (省略可) </font>: <input name=mail size=19><br><textarea rows=5 cols=70 wrap=off name=MESSAGE></textarea><input type=hidden name=bbs value=$bbs><input type=hidden name=key value=$datnum><input type=hidden name=time value=@{[time]}></form></body></html> 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/<META content=(\d+);URL=(\S+) http-equiv=refresh>/<META content=$1;URL=$cgi http-equiv=refresh>/im; + print $post_response; + exit; +} @@ -1,3 +1,8 @@ +2003-04-27 qhwt@myrealbox.com + + * [w3m-dev 03886] Re: POSTing patch (Re: User-Agent for Bonus/2ch.cgi) + * Bonus/2ch.cgi: posting + 2003-04-20 qhwt@myrealbox.com * [w3m-dev 03883] User-Agent for Bonus/2ch.cgi @@ -7770,4 +7775,4 @@ a * [w3m-dev 03276] compile error on EWS4800 * release-0-2-1 * import w3m-0.2.1 -$Id: ChangeLog,v 1.828 2003/04/20 13:30:27 ukai Exp $ +$Id: ChangeLog,v 1.829 2003/04/26 17:01:01 ukai Exp $ |