#!/usr/bin/perl

$agent="TangoAgent/1.0";
#$agent="Mozilla/3.0 (X11; I; IRIX 6.3 IP32)";
push(@INC,"/home/R10E/gcheng/java/javascript/html");

require 'socket.ph';

$index="index.html";
@cgidir=("/cgi-bin/","/htbin/","/cgi/","/usr-cgi/","/bin/");
@tags = ("background","src","action","lowsrc","dynsrc");
$rn="\r\n";
$tango_root = "http://greatwall.npac.syr.edu:1963/cgi-bin/tango/tango.pl?url=";
$tango_root_form = "http://greatwall.npac.syr.edu:1963/cgi-bin/tango/tango.pl";

$input=$ENV{'QUERY_STRING'};
if ($input !~ /^(url|TanGo_url)=(.*)/) {&error("Incorrect parsing: name=$qname url=$url");}
else {
    ($qname,$url)=split(/=/,$input);
    $qname=$1; $url=$2;
}
#    print "Content-type: text/html\n\n";
if ($qname eq "TanGo_url") {$url =~s/\&/\?/;}


$url = &unescape($url);
$fullurl = $url;

#print "<br>QUERY_STRING=$input<br>\n";
#print "url=$fullurl\n";

unless (($host,$port,$path,$file,$extra)=&split_url($url)) {
    &error("$0: Malformed http URL: $url\n") unless $path;
}

#print "$host,$port,$path,$file,$extra\n";

$cgi = 0;
if ($path=~/\?|\.cgi$/) {
    $cgi = 1;
}
else {	    
    foreach $_ (@cgidir) {
	if ($path=~/$_/) {
	    $cgi = 1;
	    last;
	}
    }
}


if (!$file) {$file=$index;}
if (!$path) {$path="/";}
if (($file !~ /\./) && ($cgi==0)) {
    $path .=$file . "/";
    $file=$index;
}


&init_sock($host,$port) || &error("$0: Cannot initialize socket\n");

&add_url("$path$file$extra",1,"");

 MAINLOOP: while ($file=shift(@files)) {
     
     $path=$file;
     $path=~s![^/]*$!!;
     $in="http://$host:$port$file";
     local($url) = $file;
     local($status,$code,$info,$line,$length,$html,$redirect,$update,$data,
	   $bytes,$step,$slice);
     socket(S,&PF_INET,&SOCK_STREAM,$local_prot) || &error("$0: socket: $!\n"); #P4
     bind(S,$local_sock) || &error("$0: bind: $!\n");
     connect(S,$remote_sock) || &error("901: TCP/IP error\n");
     $_=select(S); $|=1; select($_);
     
     $request = "$url HTTP/1.0${rn}" .
	 "User-Agent: $agent${rn}Accept: */*${rn}$update${rn}";

     #print S ($cgi?"POST $request":"GET $request");
     print S "GET $request";

     #&error("url=$fullurl GET $request");

     chop($status=<S>);

     $status=~s/\r$//;
     undef $code;
     ($code,$info)=($status=~m!^HTTP\S+\s+(\d\d\d)\s*(.*)$!i);

     if ($code==404) {&error("<HEAD><TITLE>File Not found</TITLE></HEAD>" . 
		       "<BODY><H1>File Not found</H1>" .
			     "The requested URL $url was not found on this server.<P> </BODY>");}

     if ($code==200 || $code==302) {
	 undef $length;
	 undef $redirect;
	 chop($line=<S>);
	 #print "$line\n";
	 $line=~s/\r$//;
	 while (defined $line) {
	     last if $line=~/^$/;
	     if ($line=~ m!^Content-Type:\s+[^/\s]+/html.*!i) {
		 $html=1;
		 print "$line\n\n";
		 
	     }
	     $redirect=$1 if $line=~/^Location:\s+(\S+)/i;
	     chop($line=<S>);
	     $line=~s/\r$//;
	 }
	 if ($code==302 && defined($redirect)) {
	     local($h,$n,$p,$f,$e)=&split_url($redirect);
	     &add_url( ($h eq $host && $n eq $port)?"$p$f$e":$redirect, 1, "");
	     while (defined($data=<S>)) { } # chomp!
	 }
	 else {  ##### start parsing ####
	     $/='<';		
	     while($_ = <S>) {
		 print;
		 $/='>';
		 last unless $format_str=<S>;
		 #print "##s## $format_str ##e##\n";
		 if  ($format_str =~ /\s*\bSCRIPT\b\s+\bLANGUAGE=\s*\"?\s*JAVASCRIPT\s*\"?\s*>/i) 
		 {  
		     print $format_str;
		     last unless $format_str=<S>;
		     while ($format_str !~ /<\/SCRIPT>/i) { 
			 print $format_str ; 
			 $format_str = <S>;            
		     }       
		     if ($format_str =~ /<\/SCRIPT>/i) { 
			 print $`;
			 $end_str = $&;
			 chop $end_str;
			 print  $end_str;              
			 $format_str = $';        
		     }    
		 }
		 while($format_str =~ /</)
		 {         
		     #print "\nbfore##$format_str##\n";
		     last if ($format_str =~ /\s*\bHREF\s*=\s*\"?/i ||$format_str =~ /\s*\bIMG\s*=\s*\"?/i);
		     $/='>';
		     $format_str = $`;
		     #print "\nafter##$format_str##\n";
		     $format_str .= <S>;
		 }
		 chop $format_str;
                 #print "==s== $format_str ==s==\n";
		 $format_str=&normalize_form($format_str);
		 #print "_s_ $format_str _e_\n";

		 print $format_str,">";
		 $/='<';
	     }
	     
	     close(S);
	 }
     }	
 }

exit;


sub normalize_form {
    local($fs)=@_;
    return $fs unless $fs =~ /^\s*(a|img|body|frame|applet|area|input|form)\s+/i;

    if($fs =~ m!(\bhref\s*=\s*\"?)([^\"\s]+)!i) {
	if ($fs =~ /mailto:|ftp:|gopher:|wais:/) {return $fs;} 
	$left=$` . $1;
	$righ=$';
	$addr=$2;
        if ($left !~ /.*\"$/) {
            $left .="\"";
	}
        $righ=~s/^\"(.*)/$1/;
	if ($addr =~ /^\s*\#/) 
        {
	    $onclick = "\" onClick=\"top.opener.shared('$fullurl$addr')\"";
	    $fs=$left . $tango_root . $fullurl.$addr . $onclick . $righ;
        } else
        {
	    $addr=&calculate_addr($fullurl,$addr);
	    $onclick = "\" onClick=\"top.opener.shared('$addr')\"";
	    $fs=$left . $tango_root . $addr . $onclick . $righ;
        }
    }
    
    foreach $tag (@tags) 
    {
	if ($fs =~ /(\b$tag\s*=\s*\"?)([^\"\s]+)/i) 
        {
	$left=$` . $1;
	$righ=$';
	$addr=$2;
	$addr=&calculate_addr($fullurl,$addr);
	$fs=$left . $addr . $righ;
        #$fs=~s/'//g;
        }
    }
    if($fs =~ m!(frame.*\bsrc\s*=\s*\"?)([^\"\s]+)!i) {
	$left=$` . $1;
	$righ=$';
	$addr=$2;   
        $addr=&calculate_addr($fullurl,$addr);
	$fs=$left . $tango_root . $addr . $righ;
    }
    if($fs =~ m!(form.*\baction\s*=\s*\"?)([^\"\s]+)!i) {
	$left=$` . $1;
	$righ=$';
	$addr=$2;   
        $addr=&calculate_addr($fullurl,$addr);
        $righ =~s/post/get/i;
	#print "<br>###$fullurl###$addr###<br>";
	$onsubmit = "\" onSubmit=\"top.opener.sharedform(this)\"";
	$fs=$left . $tango_root_form . $onsubmit . $righ . ">";
	$fs .= "<input type=\"hidden\" name=\"TanGo_url\" value=\"$addr\"";
    }
return $fs;
}
    
sub calculate_addr
{
    local($oldaddr, $newaddr)=@_;  
#print "<br>before=$newaddr<br>";
    return $newaddr unless ($newaddr !~ /http:/i); 
    local($prot,$host,$path)=('','','');                  
    local($oldprot,$oldhost,$oldpath);
    local($h,$po,$pa,$f,$e) = &split_url($oldaddr);
    
    $newaddr =~ tr?\"??d;                # removing quotes
    #$oldaddr =~ m!^(.*)://([^/]+)/([^\s\"]*)$!; #"
    
    ($oldprot,$oldhost,$oldpath)=("http","$h:$po","$pa$f$e");
    $prot = $1 if $newaddr =~ s!^([^/:]*):!!;
    $host = $1 if $newaddr =~ s!//([^/]*)/?!!;
    $path = $newaddr;
    $path=~s/^'(.*)'$/$1/;

    $prot = $oldprot if $prot eq "";
    $host =~ s!:80\s*$!!;
    if($host eq "")
    {
	$host = $oldhost;
	$oldpath =~ s!/?[^\/]*$!!;
	$path = $oldpath . '/' . $path if $path !~ m!^/!;
    }
    $path = $1 if $path =~ m!^/(.*)$!;
    $newaddr = "$prot://$host/$path";
#print "<br>after=$newaddr<br>";
    return $newaddr;
}



sub split_url {
    local($url)=@_;
    local($host,$port,$path,$file,$extra,$v);
    ($url,$extra)=$url=~m!^([^\?\#]*)(.*)$!;
    $v=$url=~m!^http:(//([^:/]*)(:(\d*))?)?((/([^/]+/)*)?([^/]*))?$!;
    return () unless $v;
    ($host,$port,$path,$file)=(($2?$2:"localhost"),($4?$4:80),$6,$8);
    ($host,$port,$path,$file,$extra);
}

sub init_sock {
    local($host,$port)=@_;
    $sockaddr='S n a4 x8';
    chop($local_host=`hostname`);
    $local_prot=(getprotobyname('tcp'))[2];
    $local_sock=pack($sockaddr,&AF_INET,0,(gethostbyname($local_host))[4]); #P4
    $remote_sock=pack($sockaddr,&AF_INET,$port,(gethostbyname($host))[4]); #P4
}

sub unescape {
    ($_)=@_;
    #tr/+/ /;
    s/%(..)/pack("c",hex($1))/ge;
    $_;
}

sub encode {
    local($arg)=@_;
    local($b64)=
	"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
    local($len,$rem,$bin,$code,$char);
    $len=length($arg)*8;
    $bin=unpack("B".$len,$arg);
    $rem=$len%6;
    $bin.="0"x(6-$rem) if $rem;
    $code="";
    while (length($bin)) {
	$char=substr($bin,0,6);
	$bin=substr($bin,6);
	$code.=substr($b64,unpack("C",pack("B8","00$char")),1);
    }
    $rem=length($code)%4;
    $code.="="x(4-$rem) if $rem;
    $code;
}

sub add_url {
    local($ref,$cando,$what)=@_;
    local($isdir,$qs,$dir,@new,$url,$ext);
    if ($ref=~/^\s*$/) {
	return;
    }
    $ref=~s/\#.*$//; # Remove NAME references
    $ref="$path$ref" unless $ref=~m!^/!;
    ($ref,$qs)=$ref=~m!^([^?]*)(.*)$!;
    $isdir=$ref=~m!/$!;
    @new=();
    foreach $dir (split('/',$ref)) {
	if ($dir eq "..") {
	    pop(@new);
	} elsif ($dir ne ".") {
	    push(@new,$dir);
	}
    }
    $url=join('/',@new);
    $url.="/" if $isdir;
    $url.=$qs;
    ($ext)=($url=~m!\.([^/.]*)$!);
    unless (defined($cache{$url}) || defined($cache{&unescape($url)})) {
	push(@files,$url);
	$cache{&unescape($url)}=$depth+($error!=302);
    } else {
	print " previous-ref\n";
    }
}    
sub error {
    local($msg) = @_;
    print "Content-type: text/html\n\n";
    print "<pre>" . $msg . "</pre>\n";
    exit;
}
