#!/bin/sh -- # A comment mentioning perl, to prevent perl from looping. Indented to work with bash.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

chop($Program = `basename $0`);

$Proxy_host_0 = '';

my $dom = `domain 2>/dev/null`;

if ( $ENV{WCAT_PROXY} ne '' ) {
	$Proxy_host = $ENV{WCAT_PROXY};
} elsif ( $ENV{WCAT_NOPROXY} ne '' ) {
	$Proxy_host = 'NONE';
} elsif ( $dom =~ /sun\.com/i ) {
	$Proxy_host_0 = 'webcache-eng.eng:8080';
} elsif ( $dom =~ /lbl\.gov/i ) {
	$Proxy_host_0 = 'NONE';
} elsif ( $dom =~ /runge\.home/i ) {
	$Proxy_host_0 = 'haystack:8080';
}

$alarm = 0;


$follow_300 = 0;
$prompt = 0;

$auth_basic = '';

$force_file = 0;

$view = 0;
$verbose = 0;

$shutdown = 0;

$post = 0;

$User_Agent_Default = 'Mozilla_Win95';
$User_Agent_Always = 1;
$user_agent = 0;

$User_Agent{Mozilla_Linux_Small}  = "User-Agent: Mozilla/4.04 [en] (X11; U; Linux 2.1.88 i686)\n";
$User_Agent{Mozilla_Linux_Small2} = "User-Agent: Mozilla/4.6 [en] (X11; U; Linux 2.1.88 i686)\n";

$User_Agent{Mozilla_Linux} = <<'END';
User-Agent: Mozilla/4.73 [en] (X11; U; Linux 2.2.21 i686)
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*
Accept-Encoding: gzip
Accept-Language: en
Accept-Charset: iso-8859-1,*,utf-8
END

$User_Agent{Mozilla_Win95} = <<'END';
User-Agent: Mozilla/4.7 [en] (Win95; U)
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*
Accept-Encoding: gzip
Accept-Language: en
Accept-Charset: iso-8859-1,*,utf-8
END

$SEP = "__SEP__";

foreach $ua (keys %User_Agent) {
	$User_Agent{$ua} =~ s/Accept-Encoding: gzip\n//g;
	$User_Agent{$ua} =~ s/\n/$SEP/g;
}

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

&Use_Ksockets();

$Usage = <<"END";

$Program: cat a URL to STDOUT

Usage: $0 [-B] [-bcfth] [-a <n>] [-P <h:p>] <url> [<url>, ...]

Options:
	-b	Retrieve URL in binary mode.
	-B	Save each url to its basename. (1st arg)
	-c	Retrieve Content Only, not Header
	-h	Retrieve Header Only (HEAD), not Content
	-hh	HEAD as in -h, but make sure to discard any
		Content the server sends anyway.
	-f	Follow 300 Document Moved directives
	-p	POST instead of GET a "?" query.
	-H str  Include "str" as an extra header.	
	-F	force interpretation as a file:
	-ua	Include a bogus User-Agent: header.
	-ua0	Do not include default User-Agent: header.
	-auth u:p  Use Auth Basic with user:password
	-i	prompt for a url to paste in.
	-shutdown	use shutdown(2) after sending request.
	-v	url cmd view it in a temporary file.
	-V	av  cmd view it in a temporary file.
	-verbose Verbose info to STDERR

	-P <h:p> Use proxy host "h" on port "p"
		Default: $Proxy_host_0

	-N	Do not use a proxy, make a direct connection.

	-t	Trim out HTML tags <FOO> before printing.

	-a <n>	Timeout (with alarm()) after n seconds.
	-timeout <n>

	-help	Print this help.

Notes:
	ftp:// protocol uses the external "ftp_get" script.

END

@args = @ARGV;

if ( $ARGV[0] eq '-B' ) {
	shift;
	my $last_arg = $ARGV[$#ARGV];
	if ($last_arg eq '' || $last_arg =~ /^-/) {
		print STDERR "URL> ";
		chop($tmp = <STDIN>);
		print STDERR "$tmp\n";
		push(@ARGV, $tmp);
	}
	my $base = basename($ARGV[$#ARGV]);
	$base = clean($base);
	unshift(@ARGV, '-cb');
	unshift(@ARGV, '-f');
	open(BASE, ">$base") || die "$!";
	my $pid = open(WCAT, "-|");
	die "$!" if ! defined($pid);
	if ( ! $pid ) {
		exec $0, @ARGV;
		exit 1;
	}
	while (<WCAT>) {
		print BASE $_; 
	}
	close(WCAT);
	$rc = $?;
	close(BASE);
	system 'ls', '-l', $base;
	exit $rc/256;
}

LOOP:
while (@ARGV) {
    $_ = shift;
    CASE: {
	/^-P$/ && ($Proxy_host = shift, last CASE);
	/^-N$/ && ($Proxy_host = 'NONE', last CASE);
	/^(-a|-timeout)$/ && ($alarm = shift, last CASE);
	/^-b$/ && ($binary = 1, last CASE);
	/^-t$/ && ($trim = 1, last CASE);
	/^-h$/ && ($head = 1, last CASE);
	/^-hh$/ && ($head = 2, last CASE);
	/^-shutdown$/ && ($shutdown = 1, last CASE);
	/^-H$/ && ($extra_header .= shift(@ARGV) . $SEP, last CASE);
	/^-ua$/  && ($extra_header .= $User_Agent{$User_Agent_Default}, $user_agent = 1, last CASE);
	/^-ua0$/ && ($User_Agent_Always = 0, last CASE);
	/^-ua1$/ && ($extra_header .= $User_Agent{Mozilla_Win95}, $user_agent = 1, last CASE);
	/^-ua2$/ && ($extra_header .= $User_Agent{Mozilla_Linux}, $user_agent = 1, last CASE);
	/^-auth$/ && ($auth_basic = shift, last CASE);
	/^-p$/ && ($post = 1, last CASE);
	/^-c$/ && ($content_only = 1, last CASE);
	/^-f$/ && ($follow_300 = 1, last CASE);
	/^-F$/ && ($force_file = 1, last CASE);
	/^-i$/ && ($prompt = 1, last CASE);
	/^-verb/ && ($verbose = 1, last CASE);
	/^-v$/ && ($view = 1, $follow_300 = 1, last CASE);
	/^-V$/ && ($view = 2, $follow_300 = 1, last CASE);
	/^--$/ && (last LOOP);	# -- means end of switches
	/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
	/^(-help)$/ && ((print STDERR $Usage), exit 0, last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		my($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
		last CASE;
	}
	/^-/ && ((print STDERR "Invalid arg: $_\n$Usage"), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

if ( $User_Agent_Always && ! $user_agent ) {
	$extra_header .= $User_Agent{$User_Agent_Default};
}

if ( $ENV{WCAT_COOKIE} ) {
	$extra_header .= $ENV{WCAT_COOKIE} . $SEP;
}

if ( $auth_basic ne '' ) {
	$extra_header .= 'Authorization: Basic ' . &tobase64($auth_basic) . $SEP;
}

if ( $extra_header ) {
	#print STDERR "extra_header: $extra_header\n";
	$extra_header =~ s/$SEP/\r\n/g;
	$extra_header =~ s/[\r\n]*$//;
	$extra_header .= "\r\n";
}

sub timeout {
	print STDERR "$Program: Got sig: $_[0]. Evidently timed out\n";
	close($HTTP) if $HTTP;
	$Error++;
}

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

if ( $Proxy_host ne 'NONE' ) {
	if ( $Proxy_host eq '' && $Proxy_host_0 ne '' ) {
		$Proxy_host = $Proxy_host_0;
	}
	($Proxy_host, $Proxy_port) = split(/:/, $Proxy_host);
}

foreach $arg (@args) {
	last if $arg eq $ARGV[0];
	push(@fork_args, $arg);
}

if ( $ENV{QUERY} ne '' ) {
	push(@ARGV, $ENV{QUERY});
	delete $ENV{QUERY};
} elsif ( $ENV{WCAT_QUERY} ne '' ) {
	push(@ARGV, $ENV{WCAT_QUERY});
	delete $ENV{WCAT_QUERY};
} 


if ( $prompt || @ARGV == 0 ) {
	print STDERR "URL> ";
	chop($tmp = <STDIN>);
	if ( $tmp =~ /^\s*$/ ) {
		print STDERR "trying X-Selection on $ENV{DISPLAY} ...\n";
		$tmp = `selection.tcl`;
		$tmp =~ s/\s*$//;
		$tmp =~ s/^\s*//;
	}
	push (@ARGV, $tmp);
}

if ( $ARGV[0] eq '' ) {
	print STDERR $Usage;
	exit 1;
}

$Ports{http}	= 80;
$Ports{https}	= 443;
$Ports{pnm}	= 'XXX';
$Ports{gopher}	= 70;
# ...

chop($CWD = `pwd`);

$Errors = 0;

sub clean {
	my ($str) = @_;
	my $metas = '`~!$&*()|;?<>/"';
	$str =~ s/['$metas]//og;
	return $str;
}

while (@ARGV) {
	$url = shift;

	my $http_version = "1.0";

	if ( $view ) {
		$Tmp_Count++;
		my($base, $tmp);
		chop($base = `basename '$url'`);
		$base = &clean($base);
		$tmp = "/tmp/wcat.$Tmp_Count.$$.$base";
		$url =~ s/'/%27/g;
		system("$0 -cf '$url' > $tmp");
		$Errors++ if $? != 0;
		if ( fork() == 0 ) {
			$0 = "$0 - sleeping child: unlink $tmp";
			sleep 30;
			unlink $tmp;
			exit 0;
		}
		if ( $view == 1 ) {
			system("url -f '$tmp'");
		} else {
			system("av '$tmp'");
		}
		sleep 4 if @ARGV;
		next;
	}

	if ( $force_file && $url !~ /^file:/ ) {
		if ( $url =~ m,^/, ) {
			$url = "file:$url";
		} else {
			$url = "file:$CWD/$url";
		}
	}

	if ( $url =~ m,^ftp://, ) {
		my $tmpdir = "/tmp/wcat.$$";
		mkdir($tmpdir, 0755) || die "$!";
		chdir($tmpdir);
		print STDERR "$Program: Retrieving \"$url\" via ftp_get program ...";
		$url =~ s/'/%27/g;
		system("ftp_get '$url' 1>&2");
		$Errors++ if $? != 0;
		system("cat *");
		chdir($CWD) || die "$!";
		system("rm -rf '$tmpdir'");
		next;
	} elsif ( $url =~ m,^file:(/+.*$), ) {
		my $localfile = $1;
		$localfile =~ s,^/+,/,;
		$localfile =~ s,/localhost,,;
		if ( ! -f $localfile ) {
			print STDOUT "HTTP/$http_version 404 NOT FOUND\n\n" unless $content_only;
			print STDERR "$Program: $localfile $!\n";
			next;
		}

		print STDOUT "HTTP/$http_version 200 OK\n\n" unless $content_only;
		next if $head;
		open(FILE, "<$localfile") || die "$!\n";
		while (<FILE>) {
			if ( $trim ) {
				$_ = &trimit($_);
			}
			print STDOUT $_;
		}
		close(FILE);
		next;
	}

	if ( $url !~ m,^(\w+)://, ) {
		$url = "http://$url";
	}

	if ( $url =~ m,^(\w+)://, ) {
		$proto = $1;
		($host, $file) = split(/\//, $', 2);
		$file = "/$file" unless $file =~ m,^/,;
	} else {
		$proto = "http";
		($host, $file) = split(/\//, $url, 2);
		$file = "/$file" unless $file =~ m,^/,;
	}

	my $host0 = $host;

	my $direct_note = '';
	my $item;
	if ( $Proxy_host eq 'NONE' || $Proxy_host eq '' ) {
		($host, $port) = split(/:/, $host, 2);
		if ( $port eq '' ) {
			$port = $Ports{$proto};
		}
		$port = $Ports{http} if $port eq '';
		$direct_note = '(direct) ';
		$item = $file;
		($HTTP) = &Connect($host, $port);
	} else {
		$item = $url;
		$direct_note = '(via_proxy) ';
		($HTTP) = &Connect($Proxy_host, $Proxy_port);
	}
	if ( $HTTP eq 'FILE' ) {
		;
	} elsif ( &SocketError($HTTP) ) {
		warn $HTTP;
		$Errors++;
		next;
	} else {
		print STDERR "Connection to $host0 OK.\n" if $verbose;
	}

	my $method = 'GET';
	$method = 'HEAD' if $head;
	$method = 'POST' if $post;

	if ( $binary ) {
		print STDERR "$Program: Retrieving ${direct_note}\"$method $url\" in binary mode ...\n";
	} else {
		print STDERR "$Program: Retrieving ${direct_note}\"$method $url\" ...\n";
	}

	alarm($alarm) if $alarm;

	if ( $post ) {
		($item, $query) = split(/\?/, $item, 2);
		$query_len = length($query);
	}

	print $HTTP  "$method $item HTTP/$http_version\r\n";
	print STDERR "$method $item HTTP/$http_version\r\n" if $verbose;

	if ( $http_version >= 1.0 && $extra_header !~ /Host: / ) {
		print $HTTP  "Host: $host0\r\n";
		print STDERR "Host: $host0\r\n" if $verbose;
	}
	print STDERR $extra_header . "\n" if $verbose;
	print $HTTP  $extra_header if $extra_header;

	if ( $post ) {
		print $HTTP "Content-type: application/x-www-form-urlencoded\r\n";
		print $HTTP "Content-length: $query_len\r\n";
		print $HTTP "\r\n";
		print STDERR "$Program: Posting: $query\n";
		print $HTTP $query, "\r\n";	# 2 extra characters?
	} else {
		print $HTTP "\r\n";
	}

	if ( $shutdown ) {
		shutdown($HTTP, 1);
	}

	my($in_header, $header);
	$in_header = 1;
	$header = '';

	my $length = '';
	while (<$HTTP>) {
		$header .= $_ if $in_header;
		print STDERR $_ if $verbose;
		if ( $_ =~ /^Content-length:\s+(\d+)/i ) {
			$length = $1;
		}
		if ( /^[\s\r\n]*$/ ) {
			$in_header = 0 if $in_header;
			last;
		}
	}

	($rc, $http_line, $cookie, $loc) = &check_header($header, $proto, $host);

	if ( $rc ne '' && $rc !~ /^2\d\d/ ) {
		$Errors++;
		print STDERR "\n$Program: HTTP_ERROR: $http_line\n";
		if ( $loc ne '' ) {
			print STDERR "$Program: LOCATION:   $loc\n\n";
		} else {
			print STDERR "\n";
		}
		if ( $follow_300 && ($rc =~ /^[34]\d\d/ && $loc ne '') ) {

			print STDERR "$Program: $rc REDIR HEADER was:\n";
			$header =~ s/[\n\r]*$//;
			$header =~ s/\n/\n$Program: /g;
			print STDERR "$Program: $header\n";
			print STDERR "$Program:\n";
			print STDERR "$Program: Following REDIR to $loc ...\n";

			if ( $cookie ) {
				print STDERR "$Program: Cookie is: $cookie\n";
				if ( $ENV{WCAT_COOKIE} ) {
					$ENV{WCAT_COOKIE} .= $SEP . $cookie;
				} else {
					$ENV{WCAT_COOKIE} = $cookie;
				}
			}
			print STDERR "\n";

			alarm(0) if $alarm;
			close($HTTP);

			my $old = $ENV{WCAT_RECURSE};
			$old = 0 unless $old ne '';

			$ENV{WCAT_RECURSE} = $old;
			$ENV{WCAT_RECURSE}++;
			if ( $ENV{WCAT_RECURSE} > 3 ) {
				print STDERR "$Program: WCAT_RECURSE: too many levels: $ENV{WCAT_RECURSE}\n";
			} else {
				system($0, @fork_args, $loc);
			}
			$ENV{WCAT_RECURSE} = $old;

			next;
		}
	}

	if ( ! $content_only ) {
		print STDOUT $header;
	}
	if ($head > 1) {
		# ignore any more data.
		alarm(0) if $alarm;
		close($HTTP);
		next;
	}

	if ( $length ne '' && $length < 4_000_000 && ! $trim ) {
                read($HTTP, $buf, $length);
		print STDOUT $buf;
	} elsif ( $binary ) {
		$buf_size = 2048;
                while (read($HTTP, $buf, $buf_size)) {
                        print STDOUT $buf;
                        last if eof($HTTP);
                }
	} else {
		while (<$HTTP>) {
			if ( $trim ) {
				$_ = &trimit($_);
			}
			print STDOUT $_;
		}
	}
	alarm(0) if $alarm;
	close($HTTP);
}

exit $Errors;

sub trimit {
	my ($x) = @_;
	#$x =~ s/<[^>]*>//g;
	$x =~ s/(<.*?>)+/ /g;
	$x =~ s/&nbsp;?/ /ig;
	return $x;
}

sub basename {
        # Like basename(1), returns basename of a path.

        my ($x) = @_;
        $x =~ s,/+$,,;                  # remove trailing /'s

        if ( $x =~ m,/([^/]+)$, ) {     # check if matches /
                $x = $1;                # grab stuff after the last /
        }
        $x = '.' if $x eq '';           # evidently input was null.
        return $x;
}

sub check_header {
	my($header, $proto, $host) = @_;

	# check header. Perhaps move this up
	my($loc, $http_line, $head_line, $rc);
	my($tmp, $cookie);
	$cookie = '';
	foreach $head_line (split(/[\n\r]+/, $header)) {
		if ( $head_line =~ m,^HTTP/([\d\.]+)\s+(\d+)\s*, ) {
			$rc = $2;
			$http_line = $head_line;
		} elsif ( $head_line =~ /^Location:\s*/i ) {
			$loc = $';
			if ( $loc !~ m,^(\w+)://, ) {
				if ( $loc =~ m,^/, ) {
					$loc = "${proto}://${host}${loc}";
				} else {
					$loc = "${proto}://${host}/${loc}";
				}
			}
		} elsif ( $head_line =~ /^Set-Cookie:\s*/i ) {
			$tmp = $';
			$tmp =~ s/;.*$//;
			$cookie .= "$tmp; ";
		}
	}
	$cookie =~ s/\s*$//;
	$cookie =~ s/;$//;
	if ( $cookie ) {
		$cookie = "Cookie: $cookie";
	}

	return ($rc, $http_line, $cookie, $loc);
}

sub tobase64 {
        my $res = "";
        my $eol = "\n";

        pos($_[0]) = 0; 
        while ($_[0] =~ /(.{1,45})/gs) {
                $res .= substr(pack('u', $1), 1);
                chop($res);
        }
        $res =~ tr|` -_|AA-Za-z0-9+/|;  #`

        ### Fix padding at the end:
        my $padding = (3 - length($_[0]) % 3) % 3;
        $res =~ s/.{$padding}$/'=' x $padding/e if $padding;

        ### Break encoded string into lines of no more than 76 characters each:
        $res =~ s/(.{1,76})/$1$eol/g if (length $eol);
        return $res;
} 

#----------------------------------------------------------------------
package Ksockets;

#===========================================================================
# Ksockets v0.3: Karl's sockets. Copyright (c) 1996-2006 by Karl J. Runge
# Socket macros to perl's low level socket interface. <runge@karlrunge.com>
#===========================================================================

sub main'Use_Ksockets {

    ###################################################################
    #
    # Initialize Ksockets Package
    #
    # USAGE:
    #
    # &Use_Ksockets();
    #
    ###################################################################

	if ( defined($ksockets_initialized) ) {
		return;
	}

	if (0) {
		# List of functions in this package:
		&main'Use_Ksockets;
		&main'Server;
		&main'Connect;
		&main'AcceptConnection;
		&main'Recv;
		&main'Send;
		&main'Ready;
		&main'SocketError;
		&main'IP_From_Name;
		&main'SocketInfo;
		&main'Local_IP;
		&main'spit_ksockets;
		&get_sock_type;

		# List of variables referenced:
		$main'Debug;
	}

	$pkg = 'Ksockets';

	$Server_Handles  = 'KSOCKETSSERVER00000';
	$Connect_Handles = 'KSOCKETSCONNECT0000';
	$Ksockets_Handle_String = 'KSOCKETS';

	$AF_INET = 2;			# choose INET family

	my $is_svr4 = '';

	if ( defined($main'IS_SYSV) ) {
		if ( $main'IS_SYSV ) {
			$is_svr4 = 1;
		} else {
			$is_svr4 = 0;
		}
	} elsif ( defined($main'Is_Sysv) ) {
		if ( $main'Is_Sysv ) {
			$is_svr4 = 1;
		} else {
			$is_svr4 = 0;
		}
	} else {
		if ( -x "/bin/uname" || -x "/usr/bin/uname" ) {
			# OK, this is quite a hack...
			my $osname  = `uname -s`;
			my $release = `uname -r`;
			if ( $osname =~ /sunos/i && $release !~ /^4\./ ) {
				$is_svr4 = 1;
			}
			# add others ...
		}
	}
	if ( ! $is_svr4 ) {
		$SOCK_STREAM = 1;		# BSD flavor
		$SOCK_DGRAM  = 2;		# known to work on Linux
						# SunOS 4.
	} else {
		$SOCK_STREAM = 2;		# SVR4 flavor
		$SOCK_DGRAM  = 1;		# known to work on solaris
	}

	# todo: SOCK_RAW SOCK_SEQPACKET SOCK_RDM

	$Default_Proto = 'tcp';
	$Default_Backlog = '8';

	# template for packing socket address into binary.
	$SockAddr = 'S n a4 x8';

	if ( $main'Local ne '' ) {
		$Hostname = $main'Local;
	} else {
		chop($Hostname = `hostname`);
	}
	my($name,$aliases,$type,$len,$localaddr) =
						gethostbyname($Hostname);

	$Local_IP = join('.', unpack('C4',$localaddr));

	$ksockets_initialized = 1;

}  # end Use_Ksockets

sub main'Server {

    ###################################################################
    #
    # Open a listening socket on a port.
    #
    # USAGE:
    #
    # $file_handle = &Server($port, $backlog[OPT], $proto_in[OPT])
    #
    # Then use $file_handle in  &AcceptConnection($file_handle) calls
    # Test for errors via a call to: &SocketError($file_handle)
    #
    # e.g:
    # 	$Server = &Server('8888');
    # 	die "$Server" if &SocketError($Server);
    # 	($Client) = &AcceptConnection($Server);
    # 	die "$Client" if &SocketError($Client);
    # 	... <read and write from $Client file handle>
    ###################################################################


	my($port, $backlog, $proto_in) = @_;
	my($name, $aliases, $proto);

	if ( !defined($proto_in) || $proto_in eq '' ) {
		$proto_in = $Default_Proto;
	}

	if ($port !~ /^\d+$/) {
		# port could be "smtp" though not likely
		($name, $aliases, $port, $proto) =
					getservbyname($port, $proto_in);
	}

	($name, $aliases, $proto) = getprotobyname($proto_in);

	$backlog = $Default_Backlog unless $backlog;

	print STDERR "Server:port:$port\n" if $main'Debug;

	# pack our address
	my $us = pack($SockAddr, $AF_INET, $port, "\0\0\0\0");

	my $listen = ++$Server_Handles;

	# force filehandles into callers' package
	my $package = caller;
	$listen =~ s/^[^']+$/$package'$&/;

	my $old = select($listen); $| = 1; select($old);

	my $SOCK_TYPE = &get_sock_type($proto_in);

	if ( ! socket($listen, $AF_INET, $SOCK_TYPE, $proto) ) {
		return "Error:$pkg:Server:socket($listen, $AF_INET, $SOCK_TYPE, $proto): \"$!\"";
	}

	if ( ! bind($listen, $us) ) {
		return "Error:$pkg:Server:bind($listen, SOCKADDR): \"$!\"";
	}

	if ( $proto_in eq 'tcp' ) {
	    if ( ! listen($listen, $backlog) ) {
		return "Error:$pkg:Server:listen($listen, $backlog): \"$!\"";
	    }
	}

	return $listen;

}  # end Server

sub main'Connect {

    ###################################################################
    #
    # Make a connection to a remote host port.
    #
    # USAGE:
    #
    # ($file_handle, $host_ip, $Local_IP, $host_sockaddr, $local_sockaddr) =
    #		&Connect($host, $port, $proto_in[OPT])
    #
    # Then use $file_handle in to read and write from remote connection
    #
    # Test for errors via a call to: &SocketError($file_handle)
    #
    # Use $host_ip and $local_ip as IP address information.
    # The $host_sockaddr and $local_sockaddr are packed socket addresses
    # for us in connectionless sockets (e.g. 'udp')
    #
    # e.g:
    # 	($Remote) = &Connect('www.netscape.com', '80');
    # 	die "$Remote" if &SocketError($Remote);
    # 	... <read and write from $Remote file handle>
    ###################################################################

	my($host, $port, $proto_in) = @_;
	my($name, $aliases, $proto);
	my($type,$len);
	my($local_addr, $local_sockaddr); # , $local_ip);
	my($host_addr,  $host_sockaddr,  $host_ip);

	if ( !defined($proto_in) || $proto_in eq '' ) {
		$proto_in = $Default_Proto;
	}

	if ($port !~ /^\d+$/) {
	    # port could be "smtp"
	    ($name, $aliases, $port, $proto) =
				getservbyname($port, $proto_in);
	    if ( $port eq '' ) {
		return ("Error:$pkg:Connect:getservbyname($port, $proto_in): Empty port returned", '', '', '', '');
	    }
	}

	($name, $aliases, $proto) = getprotobyname($proto_in);
	if ( !defined($proto) || $proto eq '' ) {
		return ("Error:$pkg:Connect:getprotobyname($proto_in): Empty proto returned", '', '', '', '');
	}

	if ( $host =~ /^\d+/ ) {
		$host_ip = $host;
		$host_addr = pack('C4', split(/\./, $host, 4));
	} else {
		($name,$aliases,$type,$len,$host_addr) =
						gethostbyname($host);
		if ( !defined($host_addr) || $host_addr eq '' ) {
		    return ("Error:$pkg:Connect:gethostbyname($host): Empty host_addr returned", '', '', '', '');
		}
		$host_ip = join('.', unpack('C4', $host_addr));
	}

#	$local_addr = pack('C4', split(/\./, $Local_IP, 4));
	$local_addr = pack('C4', split(/\./, "0.0.0.0", 4));

	$local_sockaddr = pack($SockAddr, $AF_INET, 0, $local_addr);

	$host_sockaddr  = pack($SockAddr, $AF_INET, $port, $host_addr);

	my $connection = ++$Connect_Handles;

	# force filehandles into callers' package
	my $package = caller;
	$connection =~ s/^[^']+$/$package'$&/;

	my $old = select($connection); $| = 1; select($old);

	my $SOCK_TYPE = &get_sock_type($proto_in);

	if ( ! socket($connection, $AF_INET, $SOCK_TYPE, $proto) ) {
	    return ("Error:$pkg:Connect:socket($connection, $AF_INET, $SOCK_TYPE, $proto): \"$!\"", '', '', '', '');
	}

	if ( ! bind($connection, $local_sockaddr) ) {
	    return ("Error:$pkg:Connect:bind($connection, $Local_IP): \"$!\"", '', '', '', '');
	}

	if ( $proto_in eq 'tcp' ) {
	    if ( ! connect($connection, $host_sockaddr) ) {
		return ("Error:$pkg:Connect:connect($connection, $host_ip): \"$!\"", '', '', '', '');
	    }
	}

	return ($connection, $host_ip, $Local_IP, $host_sockaddr, $local_sockaddr);

}  # end Connect

sub main'AcceptConnection {

    ###################################################################
    #
    # Wait for and accept a connection on a listening port.
    #
    # Listening port created with &Server();
    #
    # USAGE:
    #
    # ($file_handle, $address, $client_port) =
    #		&AcceptConnection($listen_file_handle))
    #
    # Then use $file_handle in to read and write from remote connection
    # Test for errors via a call to: &SocketError($file_handle)
    #
    # e.g:
    #   ($OurService) = &Server('8888');
    # 	die "$OurService" if &SocketError($OurService);
    # 	($Guest) = &AcceptConnection($OurService);
    # 	die "$Guest" if &SocketError($Guest);
    # 	... <read and write from $Guest file handle>
    ###################################################################

	my($listen_socket) = @_;
	my $real_socket = ++$Server_Handles;

	# force filehandles into callers' package
	my $package = caller;
	$real_socket =~ s/^[^']+$/$package'$&/;

	my $old = select($real_socket); $| = 1; select($old);
	my $address = '';
	my $fail = '';

	($address = accept($real_socket, $listen_socket)) ||
		($fail = "Error:$pkg:AcceptConnection:accept($real_socket, $listen_socket): \"$!\"");

	if ( $fail ne '' ) {
		close($real_socket);
		return ($fail, '', '');
	}

	my($af,$c_port,$inetaddr) = unpack($SockAddr,$address);
	$address = join('.', unpack('C4',$inetaddr));

	return ($real_socket, $address, $c_port);

}  # end AcceptConnection

sub main'Ready {

    ###################################################################
    #
    # See if a socket handle is ready to be read or written to.
    #
    # USAGE:
    #
    # ($handle_ready, $time_left ) =
    #			&Ready($socket_handle, $time_out, $mode[OPT])
    #
    # Given handle will be checked for readiness up to $time_out seconds
    # Default for $mode is 'read', but it could be 'write' or 'error'
    #
    # $handle_ready will be the integer result of the select() call,
    # i.e. the number of 'ready' handles. Should be 0 (problem) or
    # 1 (handle ready).
    #
    # If time_out is undef, it should block waiting for readiness.
    #
    # E.g.:
    # ($ready) = &Ready($socket, '30');
    # if ($ready) {
    #    <read from $socket>
    # } else {
    #    <not ready, do a wait or handle somehow>
    # }
    #
    ###################################################################

	my($socket, $time_out, $mode) = @_;
	my($handle_ready, $time_left, $in, $out) = ('', '', '','');

	vec($in, fileno($socket), 1) = 1;

	# note, the $out = $in stuff is not useful since they are
	# reset every time.

	if ( ! defined($mode) || $mode eq 'read' ) {
		($handle_ready, $time_left) =
			select($out = $in, undef, undef, $time_out);

	} elsif ( $mode eq 'write' ) {
		($handle_ready, $time_left) =
			select(undef, $out = $in, undef, $time_out);

	} elsif ( $mode eq 'error' ) {
		($handle_ready, $time_left) =
			select(undef, undef, $out = $in, $time_out);

	} elsif ( $mode eq 'sleep' ) { # undoc'd floating pt sleep
		($handle_ready, $time_left) =
			select(undef, undef, undef, $time_out);

	} else {			# should handle error case better
		$handle_ready = undef;
		$time_left = 'Error:Ready:unknown mode';
	}

	return ($handle_ready, $time_left);

}  # end Ready

sub main'Recv {

    ###################################################################
    #
    # Receive data from a socket.
    #
    # USAGE:
    #
    # ($data, $recv_address_info ) = &Recv($socket_handle, $size)
    #
    #
    ###################################################################

	my($socket, $size) = @_;
	my($recv_info, $buf) = ('', '');

	$recv_info = recv($socket, $buf, $size, 0);

	return ($buf, $recv_info);

}  # end Recv

sub main'Send {

    ###################################################################
    #
    # Send data to a socket.
    #
    # USAGE:
    #
    # $nchars = &Send($socket_handle, $message, $TO[OPT])
    #
    # $nchars is number of characters sent.
    # optional $TO is for 'udp' sockets. The Remote sockaddr
    # returned on Connect() say.
    #
    #
    ###################################################################

	my($socket, $message, $to) = @_;
	my $send_info = '';

	if ( !defined($to) || $to eq '' ) {
		$send_info = send($socket, $message, 0);
	} else {
		$send_info = send($socket, $message, 0, $to);
	}

	if ( !defined($send_info) ) {
		$send_info = "Error:$pkg:Send:send($socket, $message, 0, $to): \"$!\"";
	}

	return $send_info;

}  # end Send

sub main'SocketError {

    ###################################################################
    #
    # Test for error on a Ksocket command.
    #
    # USAGE:
    #
    # ($socket_file_handle, .... ) = &Ksocket_Command(...)
    #
    # Ksocket_Command can be:
    #		Server()
    #		Connect()
    #		AcceptConnection()
    #		IP_From_Name()
    #
    # $error = &SocketError($socket_file_handle)
    #
    # if ( $error ) {
    #  	<error condition>
    # } else {
    #  	<ok condition>
    # }
    #
    ###################################################################

	my($msg) = @_;

	if ( $msg  =~ /^\s*$/ ) {
		return 1;
	}
	if ( $msg  =~ /^\s*ERROR/i ) {
		return 1;
	}
	if ( $msg  !~ /$Ksockets_Handle_String/ && $msg !~ /^\d+\.\d+\.\d+\.\d+$/ ) {
		return 1;
	}
	return 0;

}  # end SocketError

sub main'IP_From_Name {

    ###################################################################
    #
    # Translate a machine host name into IP number nnn.nnn.nnn.nnn
    #
    # USAGE:
    #
    # $ip_number = &IP_From_Name($name)
    #
    # e.g.
    #  $ip_number = &IP_From_Name('www.netscape.com');
    #  die "$ip_number" if &SocketError($ip_number);
    #  ... <use $ip_number where needed>
    #
    ###################################################################

	my($input_name) = @_;
	my($remote_address);
	my($name, $aliases, $type, $len, $ip);

	if ( $input_name =~ /^\d+\./ ) {
		return $input_name;
	}

	# Turn name -> ddd.ddd.ddd.ddd
	($name,$aliases,$type,$len,$remote_address) =
					gethostbyname($input_name);

	if ( !defined($remote_address) || $remote_address eq '' ) {
		return "Error:$pkg:IP_From_Name:gethostbyname($input_name): \"$!\"";
	}
	$ip = join(".", unpack('C4',$remote_address));

	return $ip;

}  # end IP_From_Name

sub main'SocketInfo {

    ###################################################################
    #
    # Translate a internal address format into human readable information
    #
    # USAGE:
    #
    # ($r_port, $r_ip, $af) = &SocketInfo($address)
    #
    # $address comes from some socket operation, like recv
    # NOTE: not finished
    #
    ###################################################################

	my($input_address) = @_;
	my($af, $remote_port, $remote_address) =
					unpack($SockAddr, $input_address);
	$remote_address = join('.', unpack('C4', $remote_address));
	return ($remote_port, $remote_address, $af)

}  # end SocketInfo

sub get_sock_type {

    ###################################################################
    #
    # INTERNAL ROUTINE not available in main'.
    #
    # Translate string protocol name (e.g. tcp or udp)
    # into Socket type.
    #
    # USAGE:
    #
    # $SOCK_TYPE = &get_sock_type($name)
    #
    # e.g.
    #  $SOCK_TYPE = &get_sock_type('udp');
    #  ... <use $SOCK_TYPE where needed>
    #
    ###################################################################

	my($name) = @_;

	if ( $name eq 'tcp' || $name eq '' ) {
		return $SOCK_STREAM;
	} elsif ( $name eq 'udp' ) {
		return $SOCK_DGRAM;
	}

}  # end get_sock_type

sub main'Local_IP {
	my($ip) = @_;
	if ( $ip ne '' ) {
		$Local_IP = $ip;
	}
	return $Local_IP;

}  # end Local_IP

sub main'spit_ksockets {
	open(THIS_FILE, "$0");
	my $ok_to_print = '';
	my $first = 1;

	while (<THIS_FILE>) {

		if (0 && $first ) {
			$first = '';
			print STDOUT <<'EOQ';
  #!/bin/sh -- # A comment mentioning perl, to prevent perl from looping. Indented to work with bash.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;
EOQ
			print STDOUT "\n";
			print STDOUT "&Use_Ksockets();\n";
			print STDOUT "\n";
			print STDOUT "#----------------------------------------------------------------------\n";
		}
		if ( /^package Ksockets/ ) {
			$ok_to_print = 1;
		}
		print STDOUT if $ok_to_print;
		if ( /^[\s\#]*END OF PACKAGE Ksockets/ ) {
			$ok_to_print = '';
		}
	}
}

# END OF PACKAGE Ksockets