#!/usr/local/bin/perl
#
# httpget.pl renewal version by Yutaka Oiwa <oiwa@is.s.u-tokyo.ac.jp>
#
$version = '0.71.beta2';
#
# original version by Harada <harada@graco.c.u-tokyo.ac.jp>,
#   with the patches made by Applause, Tellur.
#
# $Id: httpget.pl,v 1.46 1997/08/30 17:46:45 yutaka Exp $	
#

# << To Customize, search this file with keyword "customize". >>

#
## this is output of merge.pl 0.01 ##
#

sub setup_customizevar {
# --- HTTP & FTP Proxy Server ---

    $proxyserver = '';
# ex. $proxyserver = 'proxy.server.domainname:8080';

# default values: 
    $verbose = 2;
    $savetofile = 0;
    $listfile=0;
    $proxyon = 0;    # -p option
    $rawmode = 0;
    $overwrite = 2;
    $settimestamp = 1;
    $ftp_badurl = 0;
    $redirection_policy = 1;
    $Languages = "ja, en";
    # 0: no follow redirection
    # 1: save as OLD filename
    # 2: save as NEW filename

# ftp anonymous passwords.

    $ftp_anon_passwd = "anonymous@";

    %filter_aliases = 
	(
	 'euc', "nkf -e",
	 'sjis', "nkf -s",
	 'jis', "nkf",
	 'uuencode', "uuencode %s[.uu]",
	 'gzip', "gzip -f[.gz]",
	 'gzip9', "gzip -f9[.gz]",
	 'gunzip', "gzip -cdf[^.gz]",
	 'compress', "compress[.Z]",
	 );

    %aliases =
	(
	 # format: 'alias', 'url', ...
	 # %s is replaced with date string 'YY-MM-DD',
	 # %...d is replaced with number (like printf(3) in C language)
	 
	 # extended url field syntax:
	 #   ext:<key 1>=<value 1>; ... ;<key n>=<value n>
	 #   keys: url : URL of real data
	 #         filter: filter name of filter command
	 #         postfix: postfix of data
	 
	 'italklog',
	 'ext:url=http://proton.is.s.u-tokyo.ac.jp/~suma/italk/%s.italk',
	 
	 'proton',
	 'ext:url=http://proton.is.s.u-tokyo.ac.jp/~suma/italk/%s.italk',

	 'moon',
	 'ext:postfix=.moon;
      url=http://www.st.rim.or.jp/~mina/italk/%s.italk',

#	 'mnestra',
#	 'ext:postfix=.mnestra;
#	url=http://www-masuda.is.s.u-tokyo.ac.jp/~taka/italk-log/%s.italk',

	 'electra',
	 'ext:postfix=.electra;
      url=http://www-masuda.is.s.u-tokyo.ac.jp/~taka/unofficial/italk-log/%s.italk',

	 'mercury',
	 'ext:postfix=.mercury;
      url=http://www.st.rim.or.jp/~tak/italk-log/%s.italk',
	 
	 'current',
	 'http://www.is.s.u-tokyo.ac.jp/~oiwa/pub/httpget/httpget.pl',
	 
	 'current-doc',
	 'http://www.is.s.u-tokyo.ac.jp/~oiwa/pub/httpget/httpget.doc',
	 );
    
    %http_passwords = 
	(
	 # format: 'directory url' , 'user:password', ...
	 # password is used for all documents under specified url.
	 
	 # example: 
	 #   'http://www.nowhere.or.jp/restricted/', 'taro:fjkwehu2'
	 );

    %agent_aliases =
	(
	 'httpget', "$TrueAgentName",
	 'netscape', 'Mozilla/3.0 (X11; I; Linux 2.0.11 i586)'
	 );

    $AgentName = $agent_aliases{'httpget'};
}

# Main routine;

# Environment Detection (saved in $IsPerl5, $IsWin32)

&alephlib'init;

# Environmental Global Variable setup
&setup_fixedvar;
&setup_customizevar;
&read_initfile;

# package initialize
&dates'init;
&base64'init;
&tcp'init;


# Global Variable Usage:
# $SaveFilename: Filename seems to be saved (set even if -s0)
# $SourceFilename: Filename derived from URL
# $FilterSpec: Filter Command Line
# @Filter: Filters (specified in Option)

# read local rc file

# get alias from command name

$expander = $aliases{$ScriptName};

# main loop

$actioned = 0;
$range_from = $range_to = 0;
$statuscode = 0;

ARGLOOP: while (defined ($arg = shift(@ARGV))) {

    if($expander && $arg =~ m@^\d+$@o) { 
	# numbered-arg : access to shortcut
	&do_alias_get ($arg, $expander, $savetofile);
    } elsif ($arg =~ /^-/) {
	&parse_option($arg);
    } elsif ($arg =~ /(%[---0-9]*d)/o && $range_from != -1) {
	# %: expand
	local($inc, $i, @urls);
	$inc = 1;
	if ($range_from > $range_to) {
	    $inc = -1;
	}
	for ($i = $range_from; $i != $range_to + $inc; $i += $inc) {
	    push (@urls, $` . sprintf($1, $i) . $');
	}
	unshift (@ARGV, @urls);
    } elsif ($arg =~ m@^[a-z]+://@o) {
	# URL : get it!
	&do_get($arg, $savetofile);
    } else {
	# not seems to be URL : shortcut?
	foreach (keys %aliases) {
	    if ($arg eq $_) {
		$alias = $aliases{$_};
		if (-1 == index($alias, "\%")) {
		    # direct alias
		    &do_alias_get (0, $alias, $savetofile);
		} else {
		    # indirect alias
		    $expander = $alias;
		}
		next ARGLOOP;
	    } elsif ($arg =~ m/^$_\/(\d+)$/) {
		&do_alias_get ($1, $aliases{$_}, $savetofile);

		next ARGLOOP;
	    }
	}
	$actioned = 1;
	print STDERR "$ScriptName: $arg:\n   Invalid URL (or shortcut).\n";
    }
}

if (!$actioned && $expander) {
    push (@ARGV, ($range_from != -1 ? "%d" : 0)); goto ARGLOOP;
}

&usage unless ($actioned);
exit $statuscode;

sub usage {
# help message
    print "httpget version $version";
    print "(Win32)" if ($IsWin32);
    print <<"_EOF_";


usage: $ScriptName { -options | URL | shortcut{/day | days... | } }...
example: $ScriptName current
         $ScriptName -v2s1p0 http://www.komaba.ecc.u-tokyo.ac.jp/

  options format : --option[=value] or -<opt>[value]
         example : --verbose=1, --overwrite, -v1

   * options which takes number as argument

    --verbose    -v  0-3 (2) : verbose level 0=quiet 1=simple 2=norm 3=debug
                 -q          : same as -v0 (quiet)
    --proxy      -p  0-1 (0) : use proxy
    --overwrite  -w  0-2 (2) : overwrite. 0=never 1=if newer 2=ever
    --savetofile -s  0-1 (0) : save to file (as the same name of URL)
    --settimestamp   0-1 (1) : set timestamps if possible

   * options which takes strings as argument

    --proxy=<server>        : proxy server name
    --outputfile=<name>  -o : save to file as \'name\'
    --listfile=<file>    @  : list file

_EOF_
}

sub err_exit {
    print STDERR "$ScriptName: ", $_[0];
    exit 1;
}

sub parse_opt_arg {
    local($_, $def) = @_;
    s/^=//;
    $_ = $def if ($_ eq '');
    $_;
}

sub parse_option {
    local ($arg) = @_;

    if ($arg =~ /^--help$/o) {
	&usage;
	exit $statuscode;
    } elsif ($arg =~ /^--version$/o) {
	print STDERR "httpget version $version\n";
	exit $statuscode;
    } elsif ($arg =~ /^--verbose(=[0123])?$/o) {
	$verbose = &parse_opt_arg($1,2);
    } elsif ($arg =~ /^--savetofile(=[01])?$/o) {
	$savetofile = &parse_opt_arg($1,1);
    } elsif ($arg =~ /^--rawmode(=[01])?$/o) {
	$rawmode = &parse_opt_arg($1,1);
    } elsif ($arg =~ /^--overwrite(=[012])?$/o) {
	$overwrite = &parse_opt_arg($1,2);
    } elsif ($arg =~ /^--proxy(=[01])?$/o) {
	$proxyon = &parse_opt_arg($1,1);
    } elsif ($arg =~ /^--ftpinformalurl(=[01])?$/o) {
	$ftp_badurl = &parse_opt_arg($1,1);
    } elsif ($arg =~ /^--settimestamp(=[01])?$/o) {
	$settimestamp = &parse_opt_arg($1,1);
    } elsif ($arg =~ /^--redirectionpolicy(=[012])?$/o) {
	$redirection_policy = &parse_opt_arg($1,1);
    } elsif ($arg =~ /^--proxy=(..*)$/o) {
	$proxyon = 1;
	$proxyserver = $1;
    } elsif ($arg =~ /^--range=(\d+)-(\d+)$/o) {
	$range_from = $1;
	$range_to = $2;
    } elsif ($arg =~ /^--outputfile$/o) {
	defined($savetofile = shift(@ARGV)) || &opterr2($arg);
    } elsif ($arg =~ /^--outputfile=(..*)$/o) {
	$savetofile = $1;
    } elsif ($arg =~ /^--listfile$/o) {
	defined($listfile = shift(@ARGV)) || &opterr2($arg);
	&parse_listfile($listfile);
    } elsif ($arg =~ /^(--listfile=|@)(..*)$/o) {
	&parse_listfile($2);
    } elsif ($arg =~ /^--gzip(=[0-9])?$/o) {
	$gziping = &parse_opt_arg($1,6);
    } elsif ($arg =~ /^--filter=(.*)$/o) {
	local($f,$g);
	@filter = ();
	foreach $g (split(/,/, $1)) {
	    $f = $filter_aliases{$g};
	    $f || ($f = $g);
	    push (@filter, $f);
	}
    } elsif ($arg =~ /^--postfix=(.*)$/o) {
	$postfix = $1;
    } elsif ($arg =~ /^--agent=(..*)$/o) {
	$AgentName = ($agent_aliases{$1} || $1);
    } elsif ($arg =~ /^--languages?=(.*)$/o) {
	$Languages = $1;
    } elsif ($arg =~ /^--header=([A-Za-z0-9---]+):(.*)$/o) {
	$HTTP_Header{$1} = $2;
    } elsif ($arg =~ /^--debug$/o) {
	$actioned = 1;
	&diagnostics;
	$debug = 1;
    } elsif ($arg =~ /^--/) {
	&opterr1($arg);
    } elsif ($arg =~ /^-..*/) {
	# short options
	local($_) = substr($arg,1);
      OPTLOOP:
	while ($_ ne '') {
	    if (/^s([01])/) {
		&parse_option("--savetofile=$1");
	    } elsif (/^s/) {
		&parse_option("--savetofile");
	    } elsif (/^v([0-3])/) {
		&parse_option("--verbose=$1");
	    } elsif (/^v/) {
		&parse_option("--verbose");
	    } elsif (/^q/) {
		&parse_option("--verbose=0");
	    } elsif (/^p([01])/) {
		&parse_option("--proxy=$1");
	    } elsif (/^p/) {
		&parse_option("--proxy");
	    } elsif (/^r([01])/) {
		&parse_option("--rawmode=$1");
	    } elsif (/^r/) {
		&parse_option("--rawmode");
	    } elsif (/^w([012])/) {
		&parse_option("--overwrite=$1");
	    } elsif (/^w/) {
		&parse_option("--overwrite");
	    } elsif (/^o(=..*)?$/) {
		&parse_option("--outputfile$1");
	    } elsif (/^l(=..*)?$/) {
		&parse_option("--listfile$1");
	    } elsif (/^z([0-9])/) {
		&parse_option("--gzip=$1");
	    } elsif (/^z/) {
		&parse_option("--gzip");
	    } elsif (/^(.\d*)/) {
		&opterr1("-$1");
	    }
	    $_ = $';
	}
    }
}

sub opterr1 {
    local($_) = @_;
    print STDERR ("$ScriptName: $_: no such option.\n");
    exit 1;
}

sub opterr2 {
    local($_) = @_;
    print STDERR ("$ScriptName: $_: bad argument.\n");
    exit 1;
}

sub diagnostics {
	print "
httpget $version debug information:
    self name \$0:  $0
    perl name \$^X: $^X
    ScriptName:    $ScriptName
    Win32 Flag:    $IsWin32
";
	&alephlib'diagnostics; #'
}

sub parse_listfile {
    local($arg) = @_;
    local(@urls);
    $actioned = 1;
    unless (open(LISTFILE,$arg)) {
	print STDERR ("$ScriptName: $arg: no such list file.\n");
	return;
    }
    while(<LISTFILE>){
	chop($_);
	push(@urls, $_) if ($_ && ! (/^#/));
    }
    unshift(@ARGV, @urls);
    close(LISTFILE);
}

################################################################
#
# Initialize Routines
#
################################################################
sub setup_fixedvar {
    $TrueAgentName = "httpget/$version ($PerlSpec)";
    %HTTP_Header = ();
    $HTTP_Accepts = 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*';
    $Flag_alarm = ! $IsWin32;
    $Message = '';			# Error Messages
    $config_filename = "~/.httpgetrc";

    @filter = ();
    $debug = 0;
    $Timeout_Limit = 120;
}


sub read_initfile {
    $_ = $config_filename;

    s/~/$HomeDirectory/o;

    do $_ if (-o && -O && -r && -s && -f);
}

################################################################
#
# get routine
#
################################################################

### Process Alias

sub do_alias_get {
    local($arg, $expander, $savetofile) = @_;
    local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
    local($url,$date);
    if ($arg =~ /(\d\d)?(\d\d)(\d\d)/) {
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 
	    = localtime(time);
	$_ = $mday + ($mon + 1) * 100;
	$mday = $3;
	$mon = $2;
	$year = $1 if ($1);
	$year-- unless ($1 || $arg <= $_);
    } else { 
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 
	    = localtime(time - 60*60*24* $arg);
	$mon++;
    }
    $date = sprintf("%02d-%02d-%02d", $year, $mon, $mday);
    $_ = $expander;
    s/\%s/$date/;
    s/\%d/$arg/;
    $url = $_;

    local(@filter) = @filter;
    local($postfix) = $postfix;
    # Notice for Perl5 users: not "my" but "local"!!

    if ($url =~ /^ext:[\s\n]*/){
	$actioned = 1; # prevent infinitive loop
	local(@list) = split(/;[\s\n]*/, $');
	local($f);
	$url = '';
	while($_ = shift @list) {
	    if (/^$/) {
		# nothing
	    } elsif (/^url=(..*)$/) { 
		$url = $1;
	    } elsif (/^filter=(..*)$/) { 
		($f = $filter_aliases{$1}) || ($f = $1);
		unshift (@filter, $f);
	    } elsif (/^postfix=(..*)$/) {
		$postfix = $1 . $postfix;
	    } else {
		undef $url; last;
	    }
	}
	unless ($url) {
	    print STDERR "$ScriptName: malformed alias found.\n";
	    return;
	}
    }

    &do_get ($url, $savetofile);
}

### do_get : getting file via various protocol.

sub do_get {
    local($url, $savetofile) = @_;
    local($_, $t, $sourcefilename, $savefile);

    local(@filter) = @filter;
    # Notice for Perl5 users: not "my" but "local"!!

# Process --gzip option

    if ($gziping 
	&& (grep(/gzip/, @filter) == 0)
	&& ($savetofile)
	&& ($url !~ /\.t?gz$/)) {
	push (@filter, "gzip -f${gziping}[.gz]");
    }

    $actioned = 1;

    $url =~ s/#..*$//;

    $_ = rindex($url, '/');

    $t = substr($url, $_ + 1) unless ($_ == -1);

    unless($t) { 
	$t = 'index.html';
    } # default

    $sourcefilename = $t;
    ($savefilename, $filterspec) = 
	&get_savefilename($sourcefilename, $savetofile);

    if (!$overwrite && (-r $savefilename)) {
	print STDERR "$ScriptName: $t: File exists.\n" if $verbose;
	return if ($savetofile);
        open(S, $t);
	print while <S>;
	close(S);
	return;
    }

    $timestamp_to_check = 0; # assume very old
    if ($overwrite == 1
	&& (-r $savefilename)) {
	$timestamp_to_check = (stat(_))[9];
    }

    &get_protocol ($url,
		   $sourcefilename,
		   $savefilename,
		   $savetofile,
		   $filterspec,
		   $timestamp_to_check);
}

sub get_protocol {
    local($url) = @_;
    local($protocol);

    if ($url !~ m|^([a-z]+)://|) {
	print STDERR "$ScriptName: $url:\n   invalid URL.\n";
    }
    $protocol = $1;

    eval "&get_$protocol (\@_);";
    
    &set_alarm (0);			# This might be worthless, but make sure.

    if ($@) {			# Error!
	$_ = $@;
	$statuscode = 1;
	if (/Undefined subroutine \&main::get_/ # Perl5
	    || /Undefined subroutine \"main\'get_/) { # Perl4
	    $_ = "Unknown Protocol \"$protocol\".\n";
	}
	s/ at [a-z\/.]+ line \d+.$//;
	s/\n+$/\n/;		#strip too many \n's.
	print STDERR "$ScriptName: $url:\n   $_";
	$@ = '';
    }
}

sub get_savefilename {
    local($sourcefilename, $savetofile) = @_;
    local($_, $ext);

    local($outfilefilter) = "";
    local($outfilename) = $sourcefilename . $postfix;

    foreach $_ (@filter) {
	if (/^\[(..*)\]$/) {
	    $outfilename .= $1;
	} else {
	    $ext = '';
	    if (/^(..*)\[(..*)\]$/) {
		$_ = $1;
		$ext = $2;
	    }
	    s/%s/$outfilename/g;
	    $filter .= "|$_";
	    if ($ext =~ /\^/) {
		local($l) = length($');
		if (substr($outfilename,-$l) eq $') {
		    substr($outfilename,-$l) = '';
		}
	    } else {
		$outfilename .= $ext;
	    }
	}
    }

    if ($savetofile && $savetofile != 1) {
	return wantarray ? ($savetofile, $filter) : $savetofile;
    } else {
	return wantarray ? ($outfilename, $filter) : $outfilename;
    }
}

################################################################
#
# Chat Support Routine
#
################################################################

### set_timer : setting timer.

sub set_alarm {
    local($t) = @_;

    alarm($t) if ($Flag_alarm);
}

### talktoserver : send message to remote server.

sub talktoserver {
    local(*STREAM, $mesg, $vlevel) = @_;

    print STDERR $mesg if ($verbose >= $vlevel);
    print STREAM $mesg;
}

################################################################
#
# Protocol Get routines
#
################################################################

### get_http : Get Data via HTTP.

sub get_http {
    local(@args) = @_;
    local($url,
	  $sourcefilename,
	  $savefilename,
	  $savetofile,
	  $filterspec,
	  $timestamp_to_check) = @_;
    local($proto, $path, $them, $host);
    local($location, $t);
    local($authstr);
    local($username);
    local($authstr,$username,$password);

    $authstr = '';

# URL parse
    unless($url =~ m@^(http|ftp)://([^/]+)(/?.*)$@o){
	die 'Invalid URL syntax.';
	return;
    }
    
    $proto = $1;
    $path = $3 || '/';
    $them = $2;
    $host = $2;			# for Host: header
    $port = 80;
    
    if ($them =~ m!([^@]+)@(.*)!o) {
	$username = $1;
	$password = '';
	$them = $2;
	if ($username =~ m@^(..*):(..*)$@o) {
	    $username = $1;
	    $password = $2;
	}
    }

    foreach (keys %http_passwords) {
	if (index($url, $_) == 0) {
	    # string head match
	    $authstr = $http_passwords{$_};
	    last;
	}
    }

    if ($proxyon) {
	if ($proxyserver eq '') {
	    die "Proxy Server not configured.";
	}
        if ($proto eq "ftp") {
	    # keep authorization field in url
	    $path = $url;
	    $username = '';
	} else {
	    # remove authorization field
	    $path = "$proto://$them$path";
	}
        $them = $proxyserver;
        $port = 8080;
    } else {
	die 'Invalid URL syntax.' unless ($proto eq 'http');
    }

    if($them =~ m@^(.*):(\d+)$@o){
	$them = $1;
	$port = $2;
    }
    
    &connect_socket (*S, $them, $port);

    $SIG{'ALRM'} = 'http_timeout' if ($Flag_alarm);
    &set_alarm($Timeout_Limit);

    &talktoserver (S, "GET $path HTTP/1.0\r\n", 1); 
    &talktoserver (S, "Host: $host\r\n", 3) unless ($proxyon);
    if ($authstr eq '' && $username ne '') {
	$password = &getpass($username) if ($password eq '');
	$authstr = "$username:$password";
    }
    if ($authstr ne '') {
	$authstr = &base64encode($authstr);
	&talktoserver (S, "Authorization: Basic $authstr\r\n", 3);
    }
    &talktoserver (S, "User-Agent: $AgentName\r\n", 3);
    if ($Languages ne '' && $Languages ne 'none') {
	&talktoserver (S, "Accept-Language: $Languages\r\n", 3);
    }
    &talktoserver (S, "Accept-Charset: *\r\n", 3);

    if ($timestamp_to_check) {
	$_ = "If-modified-since: " . &strftime($timestamp_to_check) . "\n";
	&talktoserver (S, $_, 2);
    }
    foreach (keys HTTP_Header) {
	if ($HTTP_Header{$_} ne '') {
	    &talktoserver (S, "$_: $HTTP_Header{$_}\r\n", 3);
	}
    }
    &talktoserver (S, "Accept: $HTTP_Accepts\r\n\r\n", 3);
    $length = -1;

    $_ = <S>;
    if ($_ eq '') {
	close(S);
	die "http: Document contains no data.";
    }
    print STDERR $_ if($verbose);
    unless ( /(\d\d\d) ([^\r\n]*)\r?\n$/o ) {
	close(S);
	die "http: Malformed result.";
    }

    $result = $1;
    $location = '';
    $timestamp = -1;

    while(<S>){ # header
	print STDERR $_ if($verbose >= 2);
	last if(m/^\r?\n$/o);
	if(/^Content-Length:/io) {
	    $length=substr($_,rindex($_,':')+1);
	} elsif(/^Last-modified:\s+(..*)\r?\n$/io) {
	    $timestamp = &revstrftime($1);
	} elsif (/^Location: ([^\r]+)\r?\n$/i) {
	    $location = $1;
	}
    }
    &set_alarm(0);

    if ($result == 200 || $rawmode) {
	&download_file (*S, 
			$length,
			$timestamp,
			@args);
    } elsif ($result == 302 || $result == 301) {
	close(S);
	die "Http-redirect without `Location:' header." unless $location;
	print STDERR "$ScriptName: $url:\n   Redirected -> $location\n" if ($verbose);
	if ($redirection_policy == 1) {
	    # save as OLD filename
	    $args[0] = $location;
	    &get_protocol(@args);
	} elsif ($redirection_policy == 2) {
	    # save as NEW filename
	    unshift(@ARGV, $location);
	} else {
	    # do not follow redirection
	    die "Result from Server: $1 $2.";
	}
	return;
    } elsif ($result == 304) {
	print STDERR "$ScriptName: $url:\n   the document is not modified.\n";
    } else {
	close(S);
	die "Result from Server: $1 $2.";
    }
    close (S);
    return;

    sub http_timeout {
	close (S);&set_alarm(0);
	die 'http: reply time out.';
    }
}

### download_file: read data from socket.

sub download_file {
    local(*SOCKET, $length, $timestamp, @args) = @_;
    local($url,
	  $sourcefilename,
	  $savefilename,
	  $savetofile,
	  $filterspec,
	  $timestamp_to_check) = @args;
    local($dometer);
    local($curlen, $curbarlen, $barstep);

$barlength = 6;			# Bar length of Progress Meter 2
$areasize = 40;			# Area width for Progress Meter
$spaces = ' ' x $areasize;
$bardir = 1;
$curlen = 0;
$curbarlen = 0;

    $length = int($length);
    $dometer = $verbose;

    if (!$savetofile) {
	$dometer = 0;
	$savetofile = "-";
	$filespec = $sourcefilename;
	if ($#filter != -1) {
	    $openspec = $filterspec;
	} else {
	    $openspec = '>-';
	}
    } else {
	$filespec = $savefilename;

	if ($filterspec) {
	    $openspec = $filterspec . ">'$savefilename'";
	} else {
	    $openspec = ">$savefilename";
	}
	if ($verbose) {
	    print STDERR "save to file: \"$savefilename\"";
	    print STDERR " ($length bytes)" if ($length >= 0);
	    print STDERR ".\n";
	}
    }

    open (OUTPUT, $openspec)
	|| warn "fail to open file: $openspec\n";

    select(OUTPUT); $| = 1; binmode(OUTPUT); select(STDOUT);

    $curlen = 0;
    $curbarlen = 0;
    $barstep = 2048;
    if ($length > 0) {
	$barstep = 512;
	$barstep *= 2 while ($barstep < $length / 100);
	$barstep = 2048 if ($barstep > 1024);
    }
    $barposition = 0;

    $starttime = time;

    &do_meter($length, $curbarlen, 0) if $dometer;

#    while ($len = read(SOCKET,$_,$barstep)) {
    while (<SOCKET>) {
	print OUTPUT $_;

	# meter
	$curlen += length($_);
	if ($dometer && $curlen - $curbarlen >= $barstep) {
	    while($curlen - $curbarlen >= $barstep) {
		$curbarlen += $barstep;
	    }
	    &do_meter($length, $curbarlen, 0);
	}
    }
    if ($dometer) {
	&do_meter($length, $curlen, 1);
	print STDERR "\n";
    }
    close (OUTPUT);

    $t = time() - $starttime;
    
    if ($dometer) {
	print STDERR sprintf ("\"%s\": %d bytes Transfered",
			      $filespec, $curlen);
	print STDERR sprintf (" in %d sec (%.1f KB/sec)", 
			      $t, $curlen/1000./$t) if ($t > 10);
	print STDERR ".\n";
    }

    print STDERR "$ScriptName: file $filespec seems to be truncated.\n"
	if ($length >= 0 && $curlen < $length);

    if ($settimestamp && $timestamp != -1 && $savetofile ne '-') {
        # hack for Perl 5.001 Win32 Build 110
	# utime is supported on Perl 5.003 Win32 Build 303 beta.
	eval {
	    utime $timestamp, $timestamp, $savefilename;
	}; 
	$@ = '';
    }

}

# do_meter : routine for progress meter.
#            TNX to Applause.

sub do_meter {
    local($len, $cur, $fin) = @_;

    if ($len != -1) { # length information exist
	if ($len == 0) {
	    $ratio = ($fin ? 1.0 : 0.0);
	} else {
	    $ratio = $cur / $len;
	}
	print STDERR sprintf (" %3d%%", int($ratio*100)),
	 "|\x1b[7m", substr($spaces, 0, int($ratio*$areasize)),
	 "\x1b[0m", substr($spaces, 0, $areasize-int($ratio*$areasize)),
	 "|",sprintf ("%9d bytes  ", $cur),
	(($fin && $cur == $len)
	 ? "ETA:  0:00" # 
	 : sprintf("ETA:%6s", &calc_eta($cur, $len))), "\r";
    } else {
	# Knight_Rider
	if ($fin == 1) {
	    print STDERR sprintf (" fin ", int($ratio*100)),
	    "|\x1b[7m", substr($spaces, 0, $areasize),
	    "\x1b[0m", 
	    "| ",$cur," Bytes\r"; 
	} else {
	    print STDERR " -- %|",
	    substr($spaces, 0, $barposition),
	     "\x1b[7m", substr($spaces, 0, $barlength), 
	     "\x1b[0m", substr($spaces, 0, $areasize-$barlength-$barposition),
	    "| ",$cur," Bytes\r"; 
	    if ($bardir == 1) {
		if ($barposition + $barlength >= $areasize) {
		    $bardir = 0;
		    $barposition -= 2;
		} else {
		    $barposition += 2;
		}
	    } else {
		if ($barposition == 0) {
		    $bardir = 1;
		    $barposition += 2;
		} else {
		    $barposition -= 2;
		}
	    }
	}
    }
}

sub calc_eta {
    local ($cur, $len) = @_;
    local ($t) = time() - $starttime;
    local ($x);

    return " --:--" if ($t == 0 || $cur == 0 || $len < $cur);

    $x = $t * $len / $cur - $t;

    sprintf ("%3d:%02d", int($x / 60), $x % 60);
}

### getpass: get password from tty

sub getpass {
    local($username) = @_;
    local($password);

    &set_alarm(0);
    print STDERR "Enter Password for $username: ";
    open (OLDSTDIN, "<&STDIN");
    open (STDIN, "</dev/tty") ||
	die('cannot open tty to input password.');
    system 'stty -echo';
    $password = <STDIN>;
    chop($password);
    system 'stty echo';
    print STDERR "\n";
    close (STDIN);
    open (STDIN, "<&OLDSTDIN");
    close (OLDSTDIN);
    $password;
}

# URL decoder
sub urldecode {
    local($_) = @_;

    s/\%(..)/pack("H2",$1)/eg;
    $_;
}

### get_ftp : Get Data via FTP.

sub get_ftp {
    local(@args) = @_;
    local($url,
	  $sourcefilename,
	  $savefilename,
	  $savetofile,
	  $filterspec,
	  $timestamp_to_check) = @args;
    local($path, $them);
    local($rname, @cwdlist, $dir);

    unless($url =~ m@^ftp://([^/]+)(/?.*)$@o){
	die "Invalid URL syntax";
	return;
    }

    $path = $2 || '/';
    $them = $1;

    if ($proxyon) {
	&get_http(@args);
	return;
    }

    if ($ftp_badurl) {
	# Netscape Compatible Method
	$rname = $path;
	if ($rname =~ m!/~(.*)!o) {
	    $rname = "~$1";
	}
	@cwdlist = ();
    } else {
	# strict RFC Method;
	$_ = $path;
	s|^/||;
	while (/\//) {
	    push (@cwdlist, $`);
	    $_ = $';
	}
	$rname = $_;
    }

    $username = 'anonymous'; $password = $ftp_anon_passwd;
 
    if ($them =~ m!([^@]+)@(.*)!o) {
	$username = $1;
	$password = '';
	$them = $2;
	if ($username =~ m@^(..*):(..*)$@o) {
	    $username = $1;
	    $password = $2;
	}
    }
    $port = 21;			# ftp

    if($them =~ m@^(.*):(\d+)$@o){
	$them = $1;
	$port = $2;
    }

# make control connection
    
    &connect_socket (*S, $them, $port);

    print STDERR "Fetching $url ...\n" if ($verbose);
    
    $SIG{'ALRM'} = 'ftp_timeout' if ($Flag_alarm);
    &set_alarm($Timeout_Limit);

    local($stat, $mesg);

    ($stat, $mesg) = &ftp_wait (*S, 1);
    if ($stat != 220) {
	print STDERR 'ftp: replyed ', $mesg;
	close(S); &set_alarm(0);
	die ' cannot talk with server.';
    }
    &set_alarm($Timeout_Limit);

# logging in

    print STDERR "Logging in as $username...\n" if ($verbose >= 2);
    &talktoserver (S, "USER $username\r\n", 3);

    ($stat, $mesg) = &ftp_wait (*S, 2);
    if ($stat == 331) {
	$password = &getpass($username) if ($password eq '');
		
	&set_alarm($Timeout_Limit);
	&talktoserver (S, "PASS $password\r\n", 3);
	($stat, $mesg) = &ftp_wait (*S, 2);
    }
    if ($stat != 230) {
	&talktoserver (S, "quit\r\n", 3);
	close(S); &set_alarm(0);
	die 'ftp: login failed.';
    }

    while (defined ($dir = shift(@cwdlist))) {
	$dir = &urldecode($dir);
	$dir = ' ' . $dir if ($dir ne '');
	&talktoserver (S, "cwd$dir\r\n", 3);
	($stat, $mesg) = &ftp_wait (*S, 2);
	if ($stat != 250) {
	    &talktoserver (S, "quit\r\n", 3);
	    close(S); &set_alarm(0);
	    die 'ftp: CWD failed.';
	}
    }

# timestamp check

    &set_alarm($Timeout_Limit);

    $timestamp = -1;

    $rname = &urldecode($rname);
    if ($rname ne '') {
	$rname = ' ' . $rname;

	&talktoserver (S, "MDTM$rname\r\n", 3);
	($stat, $mesg) = &ftp_wait (*S, 3);
	if ($stat == 213) {
	    $timestamp = &revstrftime($mesg);
	}
	
	if ($overwrite == 1 && $savetofile && 
	    $timestamp != -1 && $timestamp <= $timestamp_to_check) {
	    # not modified
	    print STDERR "$ScriptName: $url:\n   the document is not modified.\n";
	    $stat = 226;
	    &talktoserver(S, 'QUIT\r\n', 3);
	    &set_alarm(0);
	    close(S);
	    if ($stat != 226) {
		die 'ftp : not completed';
	    }
	    return;
	}
    }

# binary mode selection

    &set_alarm($Timeout_Limit);
    &talktoserver(S, "TYPE I\r\n", 3);
    ($stat, $mesg) = &ftp_wait (*S, 2);
    if ($stat != 200) {
	close(S); &set_alarm(0);
	die 'ftp: failed to set binary mode.';
    }
    
# entering passive mode

    &set_alarm($Timeout_Limit);
    
    &talktoserver(S, "PASV\r\n", 3);
    ($stat, $mesg) = &ftp_wait (*S, 2);
    if ($stat != 227) {
	close(S); &set_alarm(0);
	die 'ftp failed to set passive mode.';
    }
    
    local($datahost, $dataport);
    
    if ($mesg =~ m@\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)@o) {
	$datahost = sprintf ("%d.%d.%d.%d", $1, $2, $3, $4);
	$dataport = $5 * 256 + $6;
	eval {
	    &connect_socket (*DATA, $datahost, $dataport);
	};
	if ($@) {
	    close (S); &set_alarm(0);
	    die 'ftp: passive connection failed.';
	}
    } else {
	close(S); &set_alarm(0);
	die 'ftp: reply to PASV broken.';
    }
    
    &set_alarm($Timeout_Limit);
    
# retrieve file
    
    if ($rname ne '') {
	&talktoserver (S, "RETR$rname\r\n", 3);
	($stat, $mesg) = &ftp_wait (*S, 1);
    }
    if ($rname eq '' || ($stat != 150 && $stat != 125)) {
	if ($rname eq '' ||     $mesg =~ /plain/) {
	    &talktoserver (S, "LIST$rname\r\n", 3);
	    ($stat, $mesg) = &ftp_wait (*S, 1);
	}
	if ($stat != 150 && $stat != 125) {
	    close(S); close(DATA); &set_alarm(0);
	    die 'ftp: cannot get file.';
	}
    }
    &set_alarm(0);
    local($length) = -1;
    if ($mesg =~ m@\((\d+) [Bb]ytes?\)@o ) {
	$length = $1 + 0;
    }
    &download_file(*DATA, 
		  $length,
		  $timestamp,
		  @args);
    close (DATA);
    &set_alarm($Timeout_Limit);
    ($stat, $mesg) = &ftp_wait (*S, 2);
    
# final negotiation

    &talktoserver(S, "QUIT\r\n", 3) if ($stat == 226);
    &set_alarm(0);
    close(S);
    if ($stat != 226) {
	die 'ftp : not completed';
    }
    return;

    sub ftp_timeout {
	die 'ftp: connection timed out.';
    }

    sub ftp_wait {
	local (*SOC, $vlevel) = @_;
	local ($line);
	local ($mes);
	local ($stat);
	
	unless ($line = <SOC>) {
	    close (SOC);
	    die 'ftp: connection closed by foreign host.';
	}
	
	print STDERR $line if ($verbose >= 3);
	
	if ($line !~ m@^(\d\d\d)([ -])@o) {
	    print STDERR 'ftp_wait: MALFORMED RESULT!\n';
	    return (500, $line);
	}
	$stat = $1;
	$mes = $';
	print STDERR $mes if ($verbose >= $vlevel && $verbose < 3);
	if ($2 eq '-') {
	    while (<SOC>) {
		$line = $_;
		print STDERR $line if ($verbose >= 3);
		s/^\d\d\d[ -]//;
		$mes .= $_;
		print STDERR $_ if ($verbose >= $vlevel && $verbose < 3);
		last if ($line =~ m@^\d\d\d @o);
	    }
	}
	print STDERR "s: $stat\n m: $mes\n" if ($debug);
	($stat, $mes);
    }
}


#--------------------- alephlib.pl begins ------------------
######################################################################
#
# Aleph's Library: Some Common Perl Routine
#
######################################################################

# this package provides:
#  $HomeDirectory
#  $IsWin32
#  $IsPerl5
#  $CommandName
#  $PerlSpec

# $Id: alephlib.pl,v 1.4 1997/05/17 19:08:25 yutaka Exp $

package alephlib;

sub init {
    return if $inited;
    $inited = 1;

    &detect_environment;
    $ScriptName = &get_command_name;
    $HomeDirectory = &get_user_vicinity;

    # export value
    $main'HomeDirectory = $alephlib'HomeDirectory;
    $main'ScriptName = $alephlib'ScriptName;
    $main'IsWin32 = $alephlib'IsWin32;
    $main'IsPerl5 = $alephlib'IsPerl5;
    $main'PerlSpec = $alephlib'PerlSpec;
}

sub yesno {
    $_[0] ? "yes" : "no";
}

sub diagnostics {
    printf ("
Alephlib Diagnostics:
  Is This Perl Version5? : %s
  Is This Perl Win32's?  : %s
  Script name            : %s
  Home Directory         : %s
  Perl Spec String       : %s
", &yesno($IsPerl5), &yesno($IsWin32),
		  $ScriptName, $HomeDirectory, $PerlSpec);
}

sub get_command_name {
    local($_) = $0;

    s|^..*/||o;
    s|\.[a-z]+$||io;		# extension .pl (.bat in WinNT)
    y/A-Z/a-z/;
    
    $_;
}

sub get_user_vicinity {
    if ($IsWin32) {
	$_ = $ENV{'HOME'} || $ENV{'LOGDIR'} || $ENV{'windir'};
	s/\\/\//g;
    } else {
	$_ = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
	    (getpwuid($<))[7];
    }
    $_ || die "$ScriptName: Can't find Home Directory!\n";
}

sub detect_environment {
    local ($@); # Error Trap is Local

    $IsWin32 = 0; #'

    eval q|$_ = &Win32'GetCwd;|;	#'
    $IsWin32 = 1 if (!($@)); 

    $PerlVersion = sprintf ("%g", $] + 0);
    $IsPerl5 = ($PerlVersion > 5.0); 

    if ($IsWin32) {
	$PerlSpec = "Perl $PerlVersion, Win32, " . &Win32'PerlVersion; #'
    } else {
	$PerlSpec = "Perl $PerlVersion, Unix";
    }
}

&init;
1;

package main;
exit 0; # ----------- end of alephlib.pl ------------------


#--------------------- dates.pl begins ------------------
#!/usr/local/bin/perl
#
# dates package
#
# provides:
#
# &revstrftime(String datespec);
# &strftime(Int time, optional Int fmt);
#
# $Id: dates.pl,v 1.1 1997/03/17 16:04:16 yutaka Exp $
#

# date calcs
package dates;

sub init {
    return if $inited;
    $inited = 1;

    %revmonthname = ('Jan', 1, 'Feb', 2, 'Mar', 3, 'Apr', 4,
	      'May', 5, 'Jun', 6, 'Jul', 7, 'Aug', 8,
	      'Sep', 9, 'Oct', 10, 'Nov', 11, 'Dec', 12);
    @monthname = ('', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
		  'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
    @wdayname = ('', 'Sunday', 'Monday', 'Tuesday', 'Wednesday',
	      'Thursday', 'Friday', 'Saturday');
}

sub main'revstrftime {
    local ($str) = @_;
    local ($y, $m, $d, $h, $min, $sec, $tz, $time, $tzshift);
    local ($_) = $str;
    
    if (m/^(\w*, +)?(\d\d?)[ -](\w\w\w)[ -](\d?\d?\d\d) (\d\d):(\d\d):(\d\d) ?(.+)?/) { # rfc850 / http
	$d = $2; $m = $revmonthname{$3}; $y = $4;
	$h = $5; $min = $6; $sec = $7; $tz = $8;
    } elsif (m/^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)\r?\n?$/) { #ftp MDTM
	$d = $3; $m = $2; $y = $1;
	$h = $4; $min = $5; $sec = $6; $tz = 'GMT';
    } else {
	return -1;
    }

    $y += 2000 if ($y < 70);
    $y += 1900 if ($y < 100);

    if ($tz eq 'GMT') {
	$tzshift = 0;
    } elsif ($tz =~ /^([+-]\d\d)(\d\d)$/) {
	$tzshift = -($1 * 3600 + $2 * 60);
    } else {
	$tzshift = 0;
    }

    return -1 if ($y < 1970 || $y > 2038 ||
		  $m < 1 || $m > 12 ||
		  $d < 1 || $d > 31 ||
		  $h < 0 || $h > 23 ||
		  $min < 0 || $min > 59 ||
		  $sec < 0 || $sec > 59);

    $y -= 1968;
    $time = $y * 365 + int($y / 4) - 365 * 2;
    $time += (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334)[$m-1];
    $time += $d - 1;
    $time -= 1 if ($y % 4 == 0 && $m < 3);
    $time *= 86400;
    $time += $h * 3600;
    $time += $min * 60;
    $time += $sec;
    $time += $tzshift;
}

sub main'strftime {
    local ($t) = @_;
    local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	gmtime($t);

    # mon, wday is 0 - origin
    sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
	    $wdayname[$wday+1], $mday, $monthname[$mon+1],
	    1900 + $year, $hour, $min, $sec);
}

&init;
1;
package main; # end package dates
exit 0; # ----------- end of dates.pl ------------------


#--------------------- base64.pl begins ------------------
# BASE64 Encoder
# This code is taken from mimew.pl
#
# # Copyright (C) 1993-94 Noboru Ikuta <ikuta@crc.co.jp>
# #
# # mimew.pl: MIME base64 encoder library Ver.2.00alpha ('94/08/27)

# this package provides: 
#   &base64encode

# $Id: base64.pl,v 1.2 1997/05/18 14:54:12 yutaka Exp $

package base64;
## MIME base64 alphabet table (from RFC1521)
sub init {
    return if $inited;
    $inited = 1;

    %mime = (
	     "000000", "A",  "000001", "B",  "000010", "C",  "000011", "D",
	     "000100", "E",  "000101", "F",  "000110", "G",  "000111", "H",
	     "001000", "I",  "001001", "J",  "001010", "K",  "001011", "L",
	     "001100", "M",  "001101", "N",  "001110", "O",  "001111", "P",
	     "010000", "Q",  "010001", "R",  "010010", "S",  "010011", "T",
	     "010100", "U",  "010101", "V",  "010110", "W",  "010111", "X",
	     "011000", "Y",  "011001", "Z",  "011010", "a",  "011011", "b",
	     "011100", "c",  "011101", "d",  "011110", "e",  "011111", "f",
	     "100000", "g",  "100001", "h",  "100010", "i",  "100011", "j",
	     "100100", "k",  "100101", "l",  "100110", "m",  "100111", "n",
	     "101000", "o",  "101001", "p",  "101010", "q",  "101011", "r",
	     "101100", "s",  "101101", "t",  "101110", "u",  "101111", "v",
	     "110000", "w",  "110001", "x",  "110010", "y",  "110011", "z",
	     "110100", "0",  "110101", "1",  "110110", "2",  "110111", "3",
	     "111000", "4",  "111001", "5",  "111010", "6",  "111011", "7",
	     "111100", "8",  "111101", "9",  "111110", "+",  "111111", "/",
	     );

## table for insert null bit and pad characters
    @zero = ( "", "00000", "0000", "000", "00", "0" );
    @pad  = ( "", "===",   "==",   "=" );
}

## MIME base64 encode
sub main'base64encode {
    local($_) = @_;
    $_ = unpack("B".((length)<<3), $_);
    $_ .= $zero[(length)%6];
    s/.{6}/$mime{$&}/go;
    $_.$pad[(length)%4];
}

&init;
1;

package main;
exit 0; # ----------- end of base64.pl ------------------


#--------------------- tcp.pl begins ------------------
#!/usr/local/bin/perl
#
# tcp.pl : Easy TCP Socket Library
#
# This Package Provides:
#
# &connect_socket(Handle *Socket, String host, Int Port,
#                 optional String Situation);
# &set_timeout(Int seconds);
#
# $Id: tcp.pl,v 1.3 1997/03/19 16:52:26 yutaka Exp $
#

###  connect_socket : make a connection with TCP socket.
 
package tcp;

sub init {
    return if $inited;
    $inited = 1;

# customize values
    $SOCK_STREAM = 1;
    $AF_INET = 2;

    &alephlib'init;

    $IsWin32 = $main'IsWin32; #'
    $Flag_alarm = ! $IsWin32;
    $timeout = 120;
}

sub set_timeout {
    $timeout = @_;
}

sub main'connect_socket { #'
    local(*SOCKET, $host, $port, $situation) = @_;
    local($name, $aliases, $proto, $aliases, $type, $len, $thataddr);
    local($thataddr, $that);
    local(%SIG, $mes);

    if (defined $situation) {
	$mes = " $situation:";
    } else {
	$mes = "";
    }

    # detect AF_INET value

    if (! defined $AF_INET || ! defined $SOCK_STREAM) {
	if ($IsPerl5) {
	    eval "use Socket";	# Perl5
	} else {
	    eval "require 'sys/socket.ph'";   # Perl4
	}
	die $@ if ($@);
	$AF_INET = &AF_INET;
	$SOCK_STREAM = &SOCK_STREAM;
    }

    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
	unless $port =~ /^\d+$/;

    if($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){
	$thataddr = pack('c4', $1, $2, $3, $4);
    } else {
	eval {
	    $SIG{'ALRM'} = "tcp'timed_out" if ($Flag_alarm); #'
	    &set_alarm($timeout);

	    ($name, $aliases, $type, $len, $thataddr) =  gethostbyname($host);

	    &set_alarm(0);
	};

	if ($@) {
	    die "connect_socket:$mes address resolver time out.";
	}
    }

    if (! $thataddr) {
	die "connect_socket:$mes Unknown host: $host.";
    }

    $that = pack('S n a4 x8', $AF_INET, $port, $thataddr);

    if (! socket(SOCKET, $AF_INET, $SOCK_STREAM, $proto)) {
	die "socket:$mes $!.";
    }

    $Message = '';

    eval {
	
	$SIG{'ALRM'} = 'timed_out' if ($Flag_alarm);
	&set_alarm($timeout);

	if (! connect(SOCKET, $that)) {
	    &set_alarm(0);
	    $Message = "connect:$mes $!.";
	}
	&set_alarm(0);
    };

    if ($@) {
	$Message = "connect_socket:$mes connection timed out.";
    }
    if ($Message) {
	close (SOCKET);
	die $Message;
    }

    select(SOCKET); $| = 1; binmode(SOCKET); select(STDOUT);

    return 1;
}

sub timed_out {
    die "";
}

sub set_alarm {
    alarm($_[0]) if ($Flag_alarm);
}

&init;
1;

package main;
exit 0; # ----------- end of tcp.pl ------------------

## End of httpget.pl