gopherget.pl

harvest是一个下载html网页得机器人

: # *-*-perl-*-*
    eval 'exec perl -S $0 "$@"'
    if $running_under_some_shell;  
#
#  gopherget.pl - Retrieves data via Gopher
#
#  Usage: gopherget.pl localfile hostname port GopherRequest
#
#  where URL-path is the command to give gopher as defined by the URL spec
#  (eg. supports %xx character encodings).
#
#  For example, 
#  gopherget.pl - gopher.colorado.edu 70 0/About CU Gopher.../CU Gopher
#
#  Darren Hardy, [e-mail], April 1994
#  Duane Wessels, [e-mail], June 1995
#
#  Based on gopher.pl by Oscar Nierstrasz 25/3/94 [e-mail]
#
#  gopherget.pl,v 1.9 1995/11/28 21:07:47 duane Exp
#
$ENV{'HARVEST_HOME'} = "/usr/local/harvest" if (!defined($ENV{'HARVEST_HOME'}));
unshift(@INC, "$ENV{'HARVEST_HOME'}/lib"); 	# use local installation
require "socket.ph";

&usage() if ($#ARGV != 3);

$lfile		= shift(@ARGV);		# local filename
$host		= shift(@ARGV);		# Gopher host
$port		= shift(@ARGV);		# Gopher port
$request	= shift(@ARGV);		# command
$timeout	= 120;			# Two minutes
$bufsize	= 8192;
$nbytes		= 0;			# transfer size
$MAX_TRANSFER_SIZE = 10 * 1024 * 1024;	# 10Meg

$URL = "gopher://$host:$port/$request";
$ME  = $0;

if ($lfile eq '-') {
	open (OUT, ">&STDOUT")	|| die "stdout: $!\n";
} else {
	open (OUT, ">$lfile")	|| die "$lfile: $!\n";
}


$SIG{'ALRM'} = 'timeout';
alarm($timeout);

$SRV = &client_socket ($host, $port);

print $SRV "$request\r\n";
alarm($timeout);

while ($n = read ($SRV, $buf, $bufsize)) {
	print OUT $buf;
	alarm($timeout);
	$nbytes += $n;
	if ($nbytes > $MAX_TRANSFER_SIZE) {
		printf STDERR ("$ME: $URL: WARNING! exceeded %d bytes of data, aborting transfer\n", $MAX_TRANSFER_SIZE);
		last;
	}

}
$SIG{'ALRM'} = 'IGNORE';
close $SRV;
close OUT;

exit(0);

# --- SUBROUTINES ---

sub usage {
	print STDERR "Usage: gopherget.pl localfile hostname port command\n";
	exit(1);
}

sub timeout { 
	die "$ME: $URL: timeout after $timeout seconds\n";
}

sub client_socket {
	local ($host, $port) = @_;
	local ($sockaddr) = 'S n a4 x8';
	local ($name, $aliases, $proto) = getprotobyname('tcp');
	local ($connected) = 0;
	
	# Lookup addresses for remote hostname
	#
	local($w,$x,$y,$z,@thataddrs) = gethostbyname($host);
	die("$ME: $URL: Unknown Host: $host\n") unless (@thataddrs);

	# bind local socket to INADDR_ANY
	#
	local ($thissock) = pack($sockaddr, &AF_INET, 0, "\0\0\0\0");
	die("$ME: $URL: socket: $!\n") unless
		socket (SOCK, &AF_INET, &SOCK_STREAM, $proto);
	die("$ME: $URL: bind: $!\n") unless
		bind (SOCK, $thissock);

	# Try all addresses
	#
	foreach $thataddr (@thataddrs) {
		local ($that) = pack($sockaddr, &AF_INET, $port, $thataddr);
		if (connect (SOCK, $that)) {
			$connected = 1;
			last;
		}
	}
	die "$ME: $URL: $host:$port: $!\n" unless ($connected);

	# Set socket to flush-after-write and return it
	#
	select (SOCK); $| = 1;
	select (STDOUT);
	return (SOCK);
}