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