1#!/usr/bin/perl
2
3$WGET = "wget";
4$SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0;
5$CGI = "file://$SCRIPT_NAME";
6$_ = $QUERY_STRING = $ENV{"QUERY_STRING"};
7$UserAgent = "Monazilla/1.00 (w3m/2ch.cgi)";
8
9if (/subback.html$/) {
10	&subback();
11	exit;
12}
13
14s@/(\d+)(/([^/]*))?$@/$1@ || exit;
15my $datnum = $1;
16$label = $3;
17$cgi = "$CGI?$_";
18
19s@^http://([^/]+)/test/read.cgi/([^/]+)/@$1/$2/dat/@ || exit;
20$subback = "$CGI?http://$1/$2/subback.html";
21$bbs = $2;
22if ($ENV{REQUEST_METHOD} eq "POST") {
23	&post();
24	exit;
25}
26
27$_ .= ".dat";
28$dat = "http://$_";
29$tmp = $ENV{"HOME"} . "/.w3m2ch/$_";
30$dat =~ s/([^\w\/.\:\-])/\\$1/g;
31$tmp =~ s/([^\w\/.\:\-])/\\$1/g;
32($dir = $tmp) =~ s@/[^/]+$@@;
33$cmd = "mkdir -p $dir; $WGET -c -U \"$UserAgent\" -O $tmp $dat >/dev/null 2>&1";
34system $cmd;
35$lines = (split(" ", `wc $tmp`))[0];
36$lines || exit;
37
38@ARGV = ($tmp);
39if ($label =~ /^l(\d+)/) {
40	$start = $lines - $1 + 1;
41	if ($start < 1) {
42		$start = 1;
43	}
44	$end = $lines;
45} elsif ($label =~ /^(\d+)-(\d+)/) {
46	$start = $1;
47	$end = $2;
48} elsif ($label =~ /^(\d+)-/) {
49	$start = $1;
50	$end = $start + 100 - 1;
51} elsif ($label =~ /^(\d+)/) {
52	$start = $1;
53	$end = $1;
54} else {
55	$start = 1;
56	$end = $lines;
57}
58$head = "<a href=\"$subback\">���f���‚ɖ߂遡</a>\n";
59$head .= "<a href=\"$cgi/\">�S��</a>\n";
60for (0 .. ($lines - 1) / 100) {
61	$n = $_ * 100 + 1;
62	$head .= "<a href=\"$cgi/$n-\">$n-</a>\n";
63}
64$head .= "<a href=\"$cgi/l50\">�ŐV50</a>\n";
65print <<EOF;
66Content-Type: text/html; charset=Shift_JIS
67
68EOF
69$i = 1;
70while (<>) {
71	s/\r?\n$//;
72	($name, $mail, $date, $_, $title) = split(/\<\>/);
73	if ($i == 1) {
74		if (!$title) {
75			print <<EOF;
76���̃X���b�h�͉ߋ����O�q�ɂɊi�[����Ă��܂��B
77<p>
78<a href="$QUERY_STRING">$QUERY_STRING</a>
79EOF
80			unlink($tmp);
81			exit
82		}
83		print <<EOF;
84<title>$title</title>
85$head
86<p>$title</p>
87<dl>
88EOF
89	}
90	if ($mail) {
91		$name = "<a href=\"mailto:$mail\">$name</a>";
92	}
93	s@http://ime.nu/@http://@g;
94	s@(h?ttp:)([#-~]+)@"<a href=\"" . &link("http:$2") .  "\">$1$2</a>"@ge;
95	s@(ftp:[#-~]+)@<a href="$1">$1</a>@g;
96	s@<a href="../test/read.cgi/\w+/\d+/@<a href="$cgi/@g;
97	if ($i == 1 || ($i >= $start && $i <= $end)) {
98		print <<EOF;
99<dt><a name="$i">$i</a> �F$name�F$date
100<dd>
101$_
102<p>
103EOF
104	}
105	$i++;
106}
107print <<EOF;
108</dl>
109<hr>
110<form method=POST action="$cgi"><input type=submit value="��������" name=submit> ���O�F <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>
111EOF
112
113sub link {
114	local($_) = @_;
115	if (m@/test/read.cgi/@) {
116		return "$CGI?$_";
117	}
118	return $_;
119}
120
121sub subback {
122	$dat = $_;
123	s@http://@@ || exit;
124	$tmp = $ENV{"HOME"} . "/.w3m2ch/$_";
125	$dat =~ s/([^\w\/.\:\-])/\\$1/g;
126	$tmp =~ s/([^\w\/.\:\-])/\\$1/g;
127	($dir = $tmp) =~ s@/[^/]+$@@;
128	$cmd = "mkdir -p $dir; $WGET -O $tmp $dat >/dev/null 2>&1";
129	system $cmd;
130print <<EOF;
131Content-Type: text/html; charset=Shift_JIS
132
133EOF
134	@ARGV = ($tmp);
135	while (<>) {
136		if (/<base href="([^"]+)"/) {
137			$base = $1;
138		} elsif ($base) {
139			s@^<a href="@<a href="$CGI?$base@;
140		}
141		print;
142	}
143	unlink($tmp);
144}
145
146sub post {
147	my $debug = 0;
148
149	$| = 1;
150	use IO::Socket;
151	my @POST = <>;
152	$QUERY_STRING =~ m@^http://([^/]+)@;
153	my $host = $1;
154	my $sock = IO::Socket::INET->new("$host:80") or die;
155	# retrieve posting cookie; this may not work
156	print "Content-Type: text/html; charset=Shift_JIS\n\n";
157	print $sock
158	    "HEAD /test/bbs.cgi HTTP/1.1\n",
159	    "Host: $host\n",
160	    "Connection: keep-alive\n",
161	    "\n";
162	my $posting_cookie = undef;
163	while (<$sock>) {
164		print if ($debug);
165		s/[\n\r]+$//;
166		last if (/^$/);
167		if (/^set-cookie:.*(PON=[^;]+)/i) {
168			$posting_cookie = $1;
169		}
170	}
171	#$sock = IO::Socket::INET->new("$host:80") or die;
172	my $submit =
173	    "POST /test/bbs.cgi HTTP/1.1\n" .
174	    "Host: $host\n" .
175	    "Accept-Language: ja\n" .
176	    "User-Agent: $UserAgent\n" .
177	    "Referer: $QUERY_STRING\n" .
178	    "Cookie: $posting_cookie; NAME=nobody; MAIL=sage\n" .
179	    "Content-Length: " . length(join("", @POST)) . "\n" .
180	    "\n@POST";
181	print $sock $submit or die;
182	print "\n-- POSTed contents --\n${submit}\n-- POSTed contents --\n"
183	    if ($debug);
184	my $chunked = 0;
185	while (<$sock>) {
186		s/[\n\r]*$//;
187		last if (/^$/);
188		$chunked = 1 if (/^transfer-encoding:\s*chunked/i);
189	}
190	my $post_response = "";
191	while (<$sock>) {
192		if ($chunked) {
193			s/[ \r\n]*$//;
194			my $len = hex($_);
195			$len > 0 or last;
196			read($sock, $_, $len);
197			<$sock>;	#skip empty line at the end of chunk.
198		}
199		$post_response .= $_;
200	}
201	$post_response =~ s/<META content=(\d+);URL=(\S+) http-equiv=refresh>/<META content=$1;URL=$cgi http-equiv=refresh>/im;
202	print $post_response;
203	exit;
204}
205