#!/usr/local/bin/perl
#	wwget
#        World Wide Getter(?)
#           by Yoshioka Tsuneo(ke3057yt@ex.ecip.osaka-u.ac.jp)
#      Copy, Edit, Distribute FREE !!     
#
# support Proxy Server
# support GET,POST method
# Only Support HTTP Protocol
#
#	You need client.pl
$prog=__FILE__;
$progdir=$prog;
$progdir=~s|/[^/]*$||;
push(@INC,"$progdir");
require 'client.pl';
# package wwget;
local($default_proxy);
local($default_limit_time,$default_limit_size);
if(-e '/ECIP'){
    $default_proxy="http://wwwproxy:8080/";
}

# If you need proxy server,leave # and set server,port.
#	$default_proxy="http://server:port/";

local($public_delegate_server)="http://ringer.etl.go.jp/";

# please see /usr/include/sys/socket.h 
#     or /usr/include/linux/socket.h and so on. 
# eval("require 'sys/socket.h'");
local($AF_INET,$SOCK_STREAM);
if($ENV{'OSTYPE'} =~ m/(linux|next)/i){
    $AF_INET=2;$SOCK_STREAM=1;
}elsif($ENV{'OSTYPE'} =~ m#sun#i){
    $AF_INET=2;$SOCK_STREAM=2;
}elsif((-e '/NextApps') || (-e '/sbin/lilo')){
    $AF_INET=2;$SOCK_STREAM=1;
}elsif($ENV{'OSTYPE'} eq 'irix'){
    $AF_INET=2;$SOCK_STREAM=2;
}elsif(`uname -s` eq 'osf1'){
    $AF_INET=2;$SOCK_STREAM=1;
}else{
    $AF_INET=2;$SOCK_STREAM=2;
    $AF_INET=2;$SOCK_STREAM=1;
}


sub purse_URL
{
    local($URL)=@_;
    local($proto,$server,$port,$path);
    # print "URL is [$URL]\n";
	if(! ($URL =~ m|^(\w+):|)){
		print "<h3>URL [$URL] isn't correct</H3><p>\n";
		exit 1;
	}
	local($post) = $';
	$proto=$1;$proto =~ tr/A-Z/a-z/;
	if($proto eq "http"){
		if(! ($post=~ m|^//([^/:]+)(:\d+)?(/.*)?$|)){
			print "<h3>URL [$URL] isn't correct</H3><p>\n";exit 1;
		}
		$server=$1;
		$port=$2;if($port ne ""){$port =~ s/^://;}else{$port=80;}
		$path=$3;if($path eq ""){$path="/";}
	}elsif($proto eq "ftp"){
		if(! ($post=~ m&^//([^/:]+|.*:.*\@[^/:]+)(:\d+)?(/.*)?$&)){
		#|.*:.*\@[^/:]+
			print "<h3>URL [$URL] isn't correct</H3><p>\n";exit 1;
		}
		$server=$1;
		$port=$2;if($port ne ""){$port =~ s/^://;}else{$port=80;}
		$path=$3;if($path eq ""){$path="/";}
	}elsif($proto eq "file"){
		if(! ($post=~ m|^/+(.*)?$|)){
			print "<h3>URL [$URL] isn't correct</H3><p>\n";exit 1;
		}
		$path=$1;if($path eq ""){$path="/";}
	}else{
		# $port= ((getservbyname($proto,'tcp'))[2]);
		print "Protocol [$proto] not supported\n";
		exit 1;
	}
	# print "proto=$proto,server=$server,port=$port,path=$path\n";
	($proto,$server,$port,$path);
}
sub getbody
{
    # local($path)=@_;
    local(*S)=@_;
	local($i);
    
    $i=0;$|=1;
    while(read(S,$_,4096)>0){
		$i+=4;
		if(($limit_size ne "") && ($i>$limit_size)){
	   	 print "<h1>warning: "
			. "this file is over $limit_size lines.</h1>\n";
	    	return;
		}
		print $_;
    }
}
sub getbody2
{
	local(*S)=@_;
	while(<S>){
		s/\n//g;s/\r//g;
		if(/^$/){
			last;
		}
	}
	&getbody(*S);
}
sub setheader
{
	local($TAG,$level)=@_;
	local($header,$body);
	if($TAG eq 'GET' || $TAG eq 'HEAD'){
		if($level eq ""){
			$header="";$body="";
		}else{
    		while(<STDIN>){
				chop;
				$header.= $_ . "\n";
				if(/^$/){last;}
    		}
			$body="";
		}
	}elsif($TAG eq 'POST'){
		if($level eq ""){
    		while(<STDIN>){
				$body.=$_;
    		}
			$header.= "Content-length: " . length($body) . "\n";
		}else{
			local($len)=0;
    		while(<STDIN>){
				chop;
				if(/^$/){last;}
				$header.=$header . "\n";
				if(/^Content-length: (\d+)/){$len=$1;}
    		}
    		if($len!=0){
				read(STDIN,$body,$len);
    		}
		}
	}else{
		print "[wwget error]setheader($TAG,$level)\n";
	}
	# print "setheader($TAG,$level) end\n";
	($header,$body);
}
#$default_limit_size=50;
#$default_limit_time=60*5;
sub wwget_usage
{
	local($prog)=`basename $0`;chop($prog);
    print "usage: $prog [<options>] [GET|POST|HEAD] <URL> [HTTP/<level>]\n";
	print " option: -s<size> :Limit Size to get(KB)\n"; 
#(default $default_limit_size(kb))\n";
	print "         -t<time> :Limit Time to get(sec)\n"; 
#(default $default_limit_time(sec))\n";
	print "         -p<proxy server URL> :ProxyServer Hostname(or setenv http_proxy)\n";
	print "         -noproxy :force not to use proxy server\n";
	print "         -nocache :force not to use cache\n";
	print "(example) $prog http://www.osaka-u.ac.jp/\n";
	print "          $prog -s50000 -p'http://wwwproxy:8080/' http://www.osaka-u.ac.jp/\n";
	print "          $prog http://www.rd.ecip.osaka-u.ac.jp:8080/ HTTP/1.0\n";
	print "                and enter Entity Header and Return key\n";
	print "          $prog POST http://hogehoge/cgi-bin/foo.cgi\n";
	print "                and enter Entity Body and Return Key\n";
}
sub alarm_handler
{
    local($sig)=@_;
    print "<H1>time out via $0 (signal-$sig)</H1>\n";
    close(S);
    exit(0);
}
sub connect_http{
    local(*S,$path,$TAG,$level,$header,$body)=@_;
	# print "connect_http(S,$path,$TAG,$level,$header,$body)\n";
    # local($method);
	if(($level eq "") && ($header ne "")){$level="HTTP/1.0";}
	if($level ne ""){
		print S "$TAG $path $level\n";
		print S $header;
		print S "\n";
		if($body ne ""){print S $body,"\n";}
	}else{
		print S "$TAG $path HTTP/1.0\n";
		print S $header;
		print S "\n";
	}
}

sub wwget
{
	local(*S,$proxy,$TAG,$URL,$level,$header,$body)=@_;
	if($proxy eq ""){
		$proxy=$default_proxy;
    	if($ENV{'http_proxy'} ne ""){$proxy=$ENV{'http_proxy'};}
    }
    local($proto,$server,$port,$path);
    ($proto,$server,$port,$path)=&purse_URL($URL);
	if($proto eq "file"){
		print "printing $path\n";
		open(FILEFH,"<$path")||die "$!: can't open $path";
		print <FILEFH>;
		close(FILEFH);
		return 0;
	}
	#if($proto =~ /^(ftp|gopher|wais)$/){
	#	#$URL="http://www.osaka-u.ac.jp:8080/-\%5F-$URL";
	#	$URL="${public_delegate_server}-\%5F-$URL";
	#	($proto,$server,$port,$path)=&purse_URL($URL);
	#}
    if((  ((gethostbyname("$server"))[0])  eq "") && ($proxy ne "")){
		($proto,$server,$port,$path)=&purse_URL($proxy);
		$path=$URL;
    }
	# print "server is $server,port=$port,path=$path,proto=$proto,tag=$TAG\n";

    if (&login_server(*S,$server,$port)==-1){
		print "<h3><p>login_server error : $err_msg($server,$port)</h3><p>\n";
		return -1
    }

    if($proto eq "http"){
		&connect_http(*S,$path,$TAG,$level,$header,$body);
    }else{
		print "[wwget:wwget]$0:Protocol [ $proto ] isn't supported\n";
		return -1;
    }
	return 0;
}	
#------------main-----------------------------
if($0 eq __FILE__){
    local($limit_size,$limit_time,$TAG,$level,$proxy);
	local($URL);
    $limit_size=$default_limit_size;
    $limit_time=$default_limit_time;
    $TAG="GET";
    $level="";
	local($nocache)=0;
    while($_=$ARGV[0]){
	if(/^-s(\d+)$/){
	    $limit_size=$1;
	}elsif(/^-t(\d+)$/){
	    $limit_time=$1;
	}elsif(/^-p(.*)$/){
	    $proxy=$1;
	}elsif(/^-nocache$/){
		$nocache=1;
	}elsif(/^-/){
	    &wwget_usage;
	    exit;
	}elsif(/^(GET|POST|HEAD)$/){
	    $TAG=$1;
	}elsif(m|^HTTP/.+$|){
	    $level=$_;
	}else{
	    $URL=$_;
	}
	shift;
    }
    if($URL eq ""){
		&wwget_usage;
		exit;
    }
    if($limit_time ne ""){
		$SIG{'ALRM'}='alarm_handler';
		alarm($limit_time);
    }
	local(*S);
	# ($header,$body)=&setheader($proxy,$TAG,$URL,$level);
	($header,$body)=&setheader($TAG,$level);
	if($nocache==1){
		$header.="Pragma: no-cache\n";
	}
	# wwget(*S,$proxy,$TAG,$URL,$level,$header,$body);
	# if(wwget(*S,$proxy,$TAG,$URL,$level)==-1){
	# if(wwget(*S,$server,$port,$metod,$header,$body)==-1){
	if(wwget(*S,$proxy,$TAG,$URL,$level,$header,$body)==-1){
		print "wwget error\n";
		exit 1;
	}
	if ($level ne ""){
    	&getbody(*S);  
    }else{
		&getbody2(*S);
	}
	close S;
}