#!/usr/local/bin/perl -w
# j.cgi -- j-mode gateway
# Copyright (C) 2004 candy
# $Id: j.cgi,v 1.6 2005/11/22 10:39:00 candy Exp candy $
#
use strict;
use Socket;
use CGI;

use vars qw(%in);

my $version = "0.8087";

sub nz($;$) {
	my($x, $y) = @_;
	return defined($x) ? $x : (defined($y) ? $y : "");
}

sub autoflush($$) {
	my($so, $flag) = @_;
	select((select($so), $| = $flag)[0]);
}

sub write_remote($$) {
	my ($fd, $s) = @_;
	#printf(STDERR ">>> %s", $s);
	printf($fd "%s", $s);
}

sub read_remote($$$$) {
	my ($fd, $n, $ret, $timeout) = @_;
	my $err = 0;
	$$ret = "";
	my $got = 0;
	while ($err == 0 && $got < $n) {
		my $rin = "";
		my $rout;
		vec($rin, fileno($fd), 1) = 1;
		my ($nfound, $timeleft) = select($rout = $rin, undef, undef, $timeout);
		if ($nfound == 0) {
			#printf(STDERR "select: timeout\n");
			$err = -1;
			$got = -1;
		}
		else {
			my $buf;
			my $x = sysread($fd, $buf, $n - $got);
			if (defined($x)) {
				#if ($n != 1) {printf(STDERR "sysread: %d\n", $x);}
				if ($x == 0) {
					$err = -1;
				}
				else {
					$$ret .= $buf;
					$got += $x;
				}
			}
			else {
				#printf(STDERR "sysread: $!\n");
				$err = -1;
				$got = -1;
			}
		}
	}
	#if($n != 1){printf(STDERR "read_remote(%d): return %d\n", $n, $got);}
	return $got;
}

sub read_remote_line($$) {
	my ($fd, $timeout) = @_;
	my ($n, $buf);
	my $ret = "";
	while (($n = read_remote($fd, 1, \$buf, $timeout)) == 1 && $buf ne "\n") {
		$ret .= $buf;
	}
	$ret = $buf eq "\n" ? $ret . "\n" : "";
	#printf(STDERR "<<< %s", $ret);
	return $ret;
}

sub read_remote_status($$) {
	my ($fd, $timeout) = @_;
	my $lbuf = read_remote_line($fd, $timeout);
	my $status = 0;
	if ($lbuf =~ /^HTTP\/[0-9\.]+ +([0-9]+)/) {
		$status = $1;
	}
	return $status;
}

sub read_remote_headers($$) {
	my ($fd, $timeout) = @_;
	my @v;
	my %a;
	my $lbuf;
	while (($lbuf = read_remote_line($fd, $timeout)) ne "" && $lbuf ne "\r\n") {
		if ($lbuf =~ /^[ \t]+(.*)$/) {
			my $y = $1;
			my $x = pop(@v);
			$x =~ s/\r?\n//;
			$x .= $y;
			push(@v, $x);
		}
		else {
			push(@v, $lbuf);
		}
	}
	if ($lbuf ne "\r\n") {
		undef @v;
	}
	else {
		my $i;
		for ($i = 0; $i <= $#v; $i++) {
			if ($v[$i] =~ /^([^:]+):[ \t]+([^\r\n]+)/) {
				my ($k, $v) = ($1, $2);
				$k =~ tr/[A-Z]/[a-z]/;
				$a{$k} = $v;
			}
		}
	}
	return %a;
}

sub read_remote_body($$$) {
	my ($fd, $n, $timeout) = @_;
	my $buf = "";
	my $got;
	if ($n != 0) {
		$got = read_remote($fd, $n, \$buf, $timeout)
	}
	else {
		my $tbuf;
		while (($got = read_remote($fd, 65536, \$tbuf, $timeout)) == 65536) {
			$buf .= $tbuf;
		}
		if ($got > 0) {
			$buf .= $tbuf;
		}
	}
	return $buf;
}

#
sub get_http($$$$$) {
	my($host, $port, $path, $method, $timeout) = @_;
	my ($status, $body, %header) = (0, "", ());
	my $proto = getprotobyname("tcp");
	my $iaddr = gethostbyname($host);
	if (!$iaddr) {
		#printf(STDERR "gethostbyname: %s\n", $host);
	} else {
		my $sin = sockaddr_in($port, $iaddr);
		if (defined($sin)) {
			if (socket(FS, AF_INET, SOCK_STREAM, $proto) == 0) {
				#printf(STDERR "socket: $!\n");
			} else {
				my $agent = nz($ENV{"HTTP_USER_AGENT"}, "j/$version");
				my $referer = nz($ENV{"HTTP_REFERER"}, "");
				if (connect(FS, $sin) == 0) {
					#printf(STDERR "connect: $!\n");
				} else {
					autoflush(\*FS, 1);
					my $hhh = ($port == 80) ? $host : "$host:$port";
					write_remote(\*FS, "$method $path HTTP/1.0\r\n");
					write_remote(\*FS, "Host: $hhh\r\n");
					if ($agent) {
						write_remote(\*FS, "User-Agent: $agent\r\n");
					}
					if ($referer) {
						write_remote(\*FS, "Referer: " . $referer . "\r\n");
					}
					write_remote(\*FS, "\r\n");
					$status = read_remote_status(\*FS, $timeout);
					if ($status != 0) {
						%header = read_remote_headers(\*FS, $timeout);
						if (%header) {
							my $len = nz($header{"content-length"}, 0);
							$body = read_remote_body(\*FS, $len, $timeout);
						}
					}
					close(FS);
				}
			}
		}
	}
	return ($status, $body, %header);
}

sub parse_url($) {
	my ($url) = @_;
	my ($host, $port, $path, $base) = ("", 0, "", "");
	if ($url =~ /^http:\/\/([^ \t\n\/"]+)(\/[^ \t\n]*)?$/) {
		my ($h, $p) = ($1, $2);
		if ($h =~ /(.*):([0-9]+)/) {
			($host, $port) = ($1, $2);
		}
		else {
			$host = $h;
			$port = 80;
		}
		$path = nz($p, "/");
		$base = "http://" . $h . $path;
		$base =~ s/[^\/]*$//;
	}
	return ($host, $port, $path, $base);
}

sub escape($) {
	my ($s) = @_;
	$s =~ s/%/%25/g;
	$s =~ s/ /%20/g;
	$s =~ s/&/%26/g;
	$s =~ s/\+/%2b/g;
	$s =~ s/\//%2f/g;
	$s =~ s/\?/%3f/g;
	return $s;
}

sub wurl($$$) {
	my ($req, $base, $url) = @_;
	my $u = $url;
	if ($url !~ /^#/) {
		if ($url !~ /http:\/\//) {
			$url = $base . $url;
		}
		$u = escape($url);
		$u = $req . "?u=" . $u;
	}
	#printf(STDERR "%s==>%s\n", $url, $u);
	return $u;
}

sub rewrite_link($$$) {
	my ($body, $base, $req) = @_;
	$body =~ s/href *= *"(http:[^"]+)"/"\001\"" . wurl($req,$base,$1) . "\""/ieg;
	$body =~ s/href *= *"([^"]+)"/"\001\"" . wurl($req,$base,$1) . "\""/ieg;
	$body =~ s/frame *src *= *"([^"]+)"/"\002\"" . wurl($req,$base,$1) . "\""/ieg;
	$body =~ s/\x01/href=/g;
	$body =~ s/\x02/frame src=/g;
	#printf(STDERR "rewrite_link: %s %s\n", $base, $req);
	return $body;
}

sub simplify($$) {
	my ($s, $maxlen) = @_;
	$s =~ s/<!DOCTYPE[^>]+>//i;
	$s =~ s/<!--([^-]*|(-[^-])*)*-->//ig;
	$s =~ s/<\/?(font|pre|img|link|div|p|rdf)[^>]*>//ig;
	$s =~ s/[ \t]+/ /ig;
	$s =~ s/([ \r]*\n)+/\n/ig;
	$s =~ s/(<a *[^>]+>)(<\/a>)/$1#$2/ig;
	$s =~ s/<script/\x01/ig;
	$s =~ s/<\/script>/\x02/ig;
	$s =~ s/\x01[^\x01]*\x02//g;
	$s =~ s/\x01/<script/g;
	$s =~ s/\x02/<\/script>/g;
	if (length($s) > $maxlen) {
		$s = substr($s, 0, $maxlen - 20);
		$s .= " >\033(B</table>\n";
	}
	return $s;
}

sub nain($$$$);

sub nain($$$$) {
	my ($url, $maxlen, $timeout, $request_uri) = @_;
	my ($host, $port, $path, $base) = parse_url($url);
	if ($host ne "") {
		my ($status, $body, %header) = get_http($host, $port, $path, "GET", $timeout);
		if ($status > 0) {
			if (($status == 301 || $status == 302) && defined($header{"location"})) {
				# Moved Permanently
				nain($header{"location"}, $maxlen, $timeout, $request_uri);
			}
			else {
				my $k;
				foreach $k (("content-type", "last-modified")) {
					if (defined($header{$k})) {
						printf("%s: %s\r\n", $k, $header{$k});
					}
				}
				printf("\r\n");
				if (nz($header{"content-type"}, "") =~ /text\/html/i) {
					$body = rewrite_link($body, $base, $request_uri);
					$body = simplify($body, $maxlen);
				}
				printf("%s", $body);
			}
		}
		else {
		printf("Content-Type: text/html\r\n\r\n");
		print << "__END__";
<html><head><title>error</title></head><body>
error
</body></html>
__END__
		}
	}
	else {
		printf("Content-Type: text/html\r\n\r\n");
		print << "__END__";
<html><head><title>error</title></head><body>
url format error
</body></html>
__END__
		#printf(STDERR "format error\n");
	}
}

sub main()
{
	autoflush(\*STDOUT, 1);
	CGI::ReadParse();
	my $url = nz($::in{"u"});
	my $maxlen = nz($::in{"n"}, 4800);
	my $timeout = nz($::in{"t"}, 120);
	if ($url eq "") {
		printf("Content-Type: text/html\r\n");
		printf("\r\n");
		printf(<< "__END__");
<html><head>
<meta name="robots" content="nofollow">
<title>j-mode gateway</title></head>
<body><form method="GET" action="j.cgi">
URL:<input type="text" size=40 name="u">
<input type="submit" value="OK">
<h1>j-mode gateway</h1>
Copyright (C) 2004, 2005 <a href="http://www.bsddiary.net/">candy</a>
</form></body></html>
__END__
	}
	else {
		my $request_uri = nz($ENV{"REQUEST_URI"}, $0);
		$request_uri =~ s/\?.*//;
		nain($url, $maxlen, $timeout, $request_uri);
	}
	return 0;
}

exit main();