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

#-----------------------------------------------------------------------------
# latency version 0.1
# Copyright (c) 1997-2001 by Karl J. Runge <runge@karlrunge.com>
#-----------------------------------------------------------------------------
# Defaults:
# (these variables may be overridden in ~/.latentcyrc or ./.latencyrc)
$Bins = 78;
$Histo = 'ascii';		# or 'plot' or ''
$ConnectMode = 'echo';		# or 'rlogin' or ...
$GetTimeMode = 'syscall';	# or 'external' for external C program
$Prompt = '';
$Counts = 1000;
$Refresh = 0;
$LoopForever = 0;
$Sleep = '0.0';
$Quiet = '';
$Timer = 'CPIPE';		# or C (For GetTimeMode = 'external')
$Width = 10;
$Decimals = 5;
$ScrollMode = '';
$ExtendedScrolling = '';
$TimeRange = '';
$HeightRange = 1.0;
$Timer_Prog_Bin = '/tmp/timeprog';
$Keep_Timer_Prog = 0;
$Service_Match = 'echo|rlogin|smtp|ftp|nntp|annex|\d+';
$Freq = '';
$Initial_Skip = 1;
$Echo_Size = 1;
$Send_Char = "X";
#-----------------------------------------------------------------------------

$DoRC = 1;
foreach $arg (@ARGV) {
	$DoRC = 0 if $arg eq '-nc';
}
$home = $ENV{'HOME'};
foreach $file ("$home/.latencyrc", "./.latencyrc")  {
	next unless $DoRC;
	require $file if -f $file;
}

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

$CaughtSignal = 0;
$StartTime = time;

$Usage = <<"END";

$Program: make a TCP connection to a remote host and measure "keystroke"
	latency. Print out statistics and a histogram of data.

Usage:
	$Program [<options>] <host>

Options:

	-r <prompt>	Use "rlogin" instead of "echo" service.
			<prompt> matches the remote host cmd line prompt.

			Note: set <prompt> to "." to match trimmed hostname.
			(e.g. "foo.bar.com" gets trimmed to "foo")

	-s <service>	Use <service> for a dialog with remote host.
			Currently supported:
				$Service_Match
			(Hack: annex only works for vanilla Xylogics.
			       \\d+ means a port number redirected to
			       the echo (7) port on some machine.)

	-b <size>	For echo(7) service send text of <size> bytes.
			and a newline (default: $Echo_Size). Note that -l
			flag will send an extra 5 bytes indicating the
			packet number.

	-C <char>	Use <char> as the character to send instead of "$Send_Char"

	-c <count>	Measure <count> keystrokes. (default: $Counts)

	-f <count>	Print out info every <count> keystrokes (otherwise
			the printing frequency is determined dynamically).

	-k <count>	Skip the first <count> packets in the averages.

	-l		Loop forever.

	-R <n>		Refresh running min/max/ave stats every <n> seconds.

	-S		Scroll lines each refresh interval.

	-X <code>	Extended scrolling.  When <code> yields true, print
			a newline + timestamp.	You can learn the available
			variable names, etc, from reading this script. Look
			for "ExtendedScrolling". IF ... THEN ... END ...
			are described there as well with examples.

			Also, -X <n> is shorthand for times <n> times greater
			than the running average of times.

	-i <time>	Sleep this (floating point) amount of time between
			keystrokes. (default: $Sleep)

	-q		Be quiet while collecting the data.

	-nc		Do not read ~/.latencyrc or ./.latencyrc files.

	-n <n>		Make histogram have <n> bins. (default: $Bins)
			Setting this will make the X-Y plot output.
			(Hack: unless <n> starts with "a", e.g. "a40", will
			 make ascii plot only and with 40 bins)

	-T t1,t2	Plot only times t with t1 < t < t2, e.g. -T 0.01,0.50

	-H <f>		On the ascii plot, only show data between zero and
			fraction <f> of maximum height. e.g. -H 0.01

	-t <mode>	Method to gettimeofday(). <mode> can be
			'external' for an external C program or
			'syscall' to use the perl syscall function.
			Prefix mode with 'test-' to display some clock
			timing tests.
			Default: $GetTimeMode

	-p		Output X-Y plot histogram to stdout.

	-np		No plots at all.

	-h		Print out this help.

	-K		Do not remove the timer program at end of run.

			The timer program is attempted to be kept around
			in $Timer_Prog_Bin by default. -K makes sure it is
			not removed whatever its name is.

Notes:
	Remote host must not deny "echo" service to you.

	Instead of -s you can use "host:service", e.g. foobar:4321

	With -r, remote host must use hosts.equiv or .rhosts to let
	you rlogin w/o a password.

	With -p, stderr will still get the lovely ascii plot.

	The prompt match is actually "\\s<prompt>\\S*\\s", the \\S* allows
	chars appended to the prompt, e.g. "hostname% "
	
	When doing rlogin, using -r 'hostname\\[' is often useful to
	avoid matching the hostname too early.

	When doing rlogin or annex if the hostname contains a space,
	then the hostname is really a command to attach to instead.
	If hostname is like /dev/ttypa or /dev/ttypa:23452 then the
	special file is connected to.  For the second case the numerical
	pid of the process follows the ":" so it can be killed when done.

	~/.latencyrc file contains perl code to be sourced at beginning.
	See the "Defaults" section at the top of the script for ideas
	about what can be set.

	Joe says the only way to go is: $Program -l -X 4 -np <machine>

Comparison with "ping":
	+ Pings faster (like ping -f, but always gets an ACK).
	+ Measures the interactive latency caused by dropped packets.
	+ Nifty histograms/plots of ping times and ave & standard deviation.
	+ Probes the userland component of the connection via TCP.
	+ Measures "real" user response via rlogin.
	+ Scolling can be triggered by events of interest.
	- Hi-res time measurement not very robust.
	- Requires "echo", "rlogin" or other services provided by remote host.
	- Only sends 1 or 2 bytes of actual data per packet.
	- Depends on perl and possibly cc(!)

END

LOOP:
while (@ARGV) {
    $_ = shift;
    # print "arg: $_\n";
    CASE: {
	/^-r$/  && ($Prompt= shift, $ConnectMode = 'rlogin', last CASE);
	/^-s$/  && ($ConnectMode = shift, last CASE);
	/^-c$/  && ($Counts = shift, last CASE);
	/^-b$/  && ($Echo_Size = shift, last CASE);
	/^-C$/  && ($Send_Char = shift, last CASE);
	/^-k$/  && ($Initial_Skip = shift, last CASE);
	/^-f$/  && ($Freq = shift, last CASE);
	/^-R$/  && ($Refresh = shift, last CASE);
	/^-S$/  && ($ScrollMode = 1, last CASE);
	/^-X$/  && ($ExtendedScrolling = shift, last CASE);
	/^-l$/  && ($LoopForever = 1, last CASE);
	/^-K$/  && ($Keep_Timer_Prog = 1, last CASE);
	/^-t$/  && ($GetTimeMode = shift, last CASE);
	/^-i$/  && ($Sleep = shift, last CASE);
	/^-q$/  && ($Quiet = 1, last CASE);
	/^-p$/  && ($Histo = 'plot', last CASE);
	/^-np$/ && ($Histo = '', last CASE);
	/^-nc$/ && ($DoRC = 0, last CASE);
	/^-n$/  && ($Histo = 'plot', $Bins = shift, last CASE);
	/^-d$/  && ($Debug = 1, last CASE);
	/^-T$/  && ($TimeRange = shift, last CASE);
	/^-H$/  && ($HeightRange = shift, last CASE);
	/^--$/  && (last LOOP);
	/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
	/^(-h|-help)$/ && ((&help), exit 0, last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		local($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
		last CASE;
	}
	/^-/ && ((&help("Invalid arg: $_\n$Usage")), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

if ( $GetTimeMode =~ /^test/ ) {
	&GetTime();
	exit 0;
}

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

$Width-- if $ScrollMode;

if ( $ScrollMode && ! $Refresh ) {
	$Refresh = 10;
}

if ( $Bins =~ /^a(\d+)$/i ) {
	$Bins = $1;
	$Histo = 'ascii';
}

if ( $ConnectMode !~ /^($Service_Match)$/ ) {
	&help("\nInvalid Connect mode. Try: $Service_Match\n\n$Usage");
	exit 1;
}

if ( $ARGV[0] eq '' ) {
	&help();
	exit 1;
} else {
	$RemoteHost = $ARGV[0];
}

if ($RemoteHost =~ /:/) {
	$RemoteHost = $`;
	$ConnectMode = $';
}

if ( $Prompt eq '.' ) {
	$Prompt = $RemoteHost;
	$Prompt =~ s/\..*$//;
}

&Initialize();

($RDR, $WTR) = &MakeConnection($RemoteHost);
select($WTR); $| = 1; select(STDOUT);

&PingLoop();

&Histo();

&CleanUp();

exit 0;

############################################################################
sub PingLoop {

	if ( $Freq ne '' ) {
		$keep_freq = 1;
	} else {
		$Freq = 5;
		$keep_freq = 0;
	}
	$freq0 = $Freq;
	$inf = 9999999.0;

	$Rsum  = 0.0;
	$Rsum2 = 0.0;
	$Rcnt  = 0;
	$Rmax  = 0.0;
	$Rmin  = $inf;

	$rsum  = 0.0;
	$rsum2 = 0.0;
	$rcnt  = 0;
	$rmax  = 0.0;
	$rmin  = $inf;

	$lasttime = time;

	&GetTime();	# start the timing stuff.

	local($cond);
	&SetupExtendedScrolling();

	if ($Quiet) {
		&msg("Collecting data ... ");
	} else {
		$s_delay = &Fit($Width, "DELAY");
		local($tot) = '';
		if ( $Refresh ) {
			$tot =  ' ' x ($Decimals + 2 - 3) . ' (overall) ';
			$Width2 = $Width + $Decimals + 4;
			&msg("Refreshing stats every $Refresh seconds. \"overall\" denotes stats over the whole run.\n\n");
		} else {
			$Width2 = $Width;
		}
		$s_ave   = &Fit($Width2, "AVE" . $tot);
		$s_min   = &Fit($Width2, "MIN" . $tot);
		$s_max   = &Fit($Width2, "MAX" . $tot);
		if ( $ScrollMode ) {
			$s_count = &Fit($Width,  "COUNT (time)");
		} else {
			$s_count = &Fit($Width,  "COUNT");
		}
		&msg($s_delay . $s_ave . $s_min . $s_max . $s_count . "\n");
	}


	$stars = '*' x ($Decimals + 2);
	$dostars = 0;

	# vars $wait, $PingCount, $time, $rmax, $rmin, $rcnt, $lasttime
	#
	$mycnt = 0;
	while ( $PingCount < $Counts || $LoopForever ) {
		$wait = &PingIt();
		next unless $mycnt++ > $Initial_Skip;
		$cond = 0;
		$msg = '';
		$xmsg = '';
		$PingCount++;
		###########################
		# Vars for extended scrolling:
			$t = &Float($wait);
			$i = $PingCount;
		###########################
		if ( $wait > 0.0 ) {
			if ( $ExtendedScrolling ne '' ) {
				$T = &Float(&GetTime);
				$cond = &condition();
				if ( $cond ) {
					$dostars = 0;
					$scrolltime = &GetTime;
				}
			}
			if ( $Refresh && ! $cond ) {
			    $time = time;
			    if ( $time >= $lasttime + $Refresh ) {
				$dostars = 1 unless $dostars;
				$rsum  = 0.0;
				$rsum2 = 0.0;
				$rcnt  = 0;
				$rmax  = 0.0;
#&msg("\nRMAX ZERO $time");
				$rmin  = $inf;
				$lasttime = $time;
				$showtime = $lastmax;
			    }
			}
			$rsum  += $wait;
			$rsum2 += $wait**2;
			$rcnt++;
			if ($wait > $rmax) {
				$rmax = $wait;
				$lastmax = &GetTime;
#&msg("\nLASTMAX: $lastmax :: rmax: $rmax\n");
			}
			$rmin = $wait if $wait < $rmin;
			$rave = $rsum/$rcnt;

			$Rsum  += $wait;
			$Rsum2 += $wait**2;
			$Rcnt++;
			$Rmax = $wait if $wait > $Rmax;
			$Rmin = $wait if $wait < $Rmin;
			$Rave = $Rsum/$Rcnt;
		}
		if ( ! $Quiet && ($PingCount % $Freq == 0 || $cond) ) {
			local($w)  = $Width;
			local($w2) = $Width2;
			local($out, $ave, $min, $max);
			if ( $Refresh ) {
				$ave = ' (' . &Trim(&Float($Rave)) . ') ';
				$min = ' (' . &Trim(&Float($Rmin)) . ') ';
				$max = ' (' . &Trim(&Float($Rmax)) . ') ';
			} else {
				$ave = '';
				$min = '';
				$max = '';
			}
			$out  = &Fit($w, &Float($wait));
			if ( $cond ) {
				if ( $ScrollMode && $xmsg eq '') {
					$xmsg = '*';
				}
				$scrolltime =~ s/(\.\d\d).*$/$1/;
				$msg = " (${scrolltime}${xmsg})\n";

				$out .= &Fit($w2, &Float($rave) . $ave);
				$out .= &Fit($w2, &Float($rmin) . $min);
				$out .= &Fit($w2, &Float($rmax) . $max);

			} elsif ( $dostars ) {
				if ( $ScrollMode ) {
				    if ( $dostars ne 'from_cond' ) {
					local($st) = $showtime;
					$st =~ s/(\.\d\d).*$/$1/;
					&msg(" (${st})\n");
				    }
				}
				$out .= &Fit($w2, $stars . $ave);
				$out .= &Fit($w2, $stars . $min);
				$out .= &Fit($w2, $stars . $max);
			} else {
				$out .= &Fit($w2, &Float($rave) . $ave);
				$out .= &Fit($w2, &Float($rmin) . $min);
				$out .= &Fit($w2, &Float($rmax) . $max);
			}
			$out .= &Fit($w, $PingCount);
			$out =~ s/\s*$//;
			&Flash($out);
			if ( $dostars ) {
				&fsleep(0.25);
				$dostars = 0;
			} elsif ( $cond ) {
				$dostars = 'from_cond';
			}
			&msg($msg) if $msg ne '';
		}
		$Times[$PingCount - 1] = $wait;

		if ( ! $keep_freq ) {
			$Freq = $freq0;
			$Freq =   1 if $PingCount > 15 && $rave > 0.1;
			$Freq =  20 if $PingCount > 15 && $rave < 0.02;
			$Freq = 150 if $PingCount > 15 && $rave < 0.004;
		}
		&fsleep($Sleep);
	}
}

sub PingIt {
    local($begin, $end, $diff, $send, $recv);

    local($tmp);

    if ( $ConnectMode =~ /^(echo|smtp|ftp|nntp|\d+)$/ ) {

	$send = "noop\r\n"	if $ConnectMode =~ /^(smtp|ftp|nntp)$/;

	if ( $ConnectMode eq 'echo' || $ConnectMode =~ /^\d+$/ ) {
		$send = $Send_Char x $Echo_Size;
		if ( $LoopForever ) {
			$tmp = '00000' . $PingCount;
			$tmp =~ s/^.*(\d{4})$/$1/;
			$send = $tmp . $send;
		}
		$send .= "\n";
	}

	# print STDERR "sending: $send";
	$begin = &GetTime;
	print $WTR $send;
	$recv = <$RDR>;
	$end = &GetTime;
	if ($ENV{LATENCY_VERBOSE}) {
		print STDERR "recv: $recv";
	}

	# might need a loop for "200-" type lines.

	local($err) = 0;
	$err = 1 if $ConnectMode =~ /echo|\d+/ && $send ne $recv;
	$err = 1 if $ConnectMode =~ /^(smtp|ftp)$/ && $recv !~ /^2\d\d\s/;
	$err = 1 if $ConnectMode eq 'nntp' && $recv !~ /^[25]\d\d\s/;

	if ($err) {
		&msg("BAD RCV: $recv\n");
		&fsleep(0.25);
		return -1.0;
	}

    } elsif ( $ConnectMode =~ /^(rlogin|annex)$/ ) {

	$Prompt = "annex:" if $ConnectMode eq 'annex';

	if ( $PingCount > 0 && $PingCount % 40 == 0) {
		local($resp, $str, $db);
		$db = 0;
		if ( ! $Quiet && $Freq < 50 ) {
			&Flash("CLEANING COMMAND LINE...", "CLEAR")
		}
		print $WTR "\n";

		&fsleep(0.5) if $ConnectMode eq 'annex';

		chop($resp = <$RDR>);
		$resp =~ s/[\n]+$//;
		&Flash("%$resp%", "CLEAR") if $db;

		$str = &WaitFor("\\s$Prompt\\S* ", $RDR);
		&fsleep(0.1) if $db;

		$str =~ s/\n//g;
		&Flash($str, "CLEAR") if $db;
		&fsleep(0.1) if $db;
		&Flash("", "CLEAR") unless $Quiet || $Freq >= 50;
	}

	$send = $Send_Char;

	$begin = &GetTime;
	print $WTR $send;
	$recv = getc($RDR);
	$end = &GetTime;

	if ( $send ne $recv ) {
		&msg("\nBAD RCV: $recv\n");
		&fsleep(0.25);
		return -1.0;
	}
    }
    return $end - $begin;
}

sub SetupExtendedScrolling {


#	With -X flag you can make the output line scroll on
#	an "arbitrary" condition.
#
#	Whenever your code is true, the line will be scrolled.
#	Your code is run *every* ping so be wary of efficiency.
#
#	Here are variables to use
#
#		$t	Latest ping time.
#		$T	Current time since start of program.
#		$i	ping count.
#
#		Data specific to the current report interval:
#			$rave	Running average of ping times.
#			$rcnt	Number of pings.
#			$rmin	Minimum ping time.
#			$rmax	Maximum ping time.
#			$rsum	Sum of ping times.
#			$rsum2	Sum of squares of ping times.
#			&rdev	Standard deviation of ping times.
#		Data specific to the whole run:
#			$Rave	Running average of ping times.
#			$Rcnt	Number of pings.
#			$Rmin	Minimum ping time.
#			$Rmax	Maximum ping time.
#			$Rsum	Sum of ping times.
#			$Rsum2	Sum of squares of ping times.
#			&Rdev	Standard deviation of ping times.
#
#		What else? Times? Have to think about it.
#               Put info messages in $xmsg.
#
#	Anyway, your condition is implemented by a subroutine:
#
#		sub condition {
#			if ( ... )  {
#				return 1;
#			} else {
#				return 0;
#			}
#		}
#
#	and &condition() is run every ping. Simplest case your
#	conditional code replaces the "..." above. But if your
#	code matches 'return' it is assumed you've done everything
#	and your code comprises all of the sub. Finally, if your code
#	contains the string "IF" the stuff before the "IF" is
#	code to be executed before "if ( ... ) and the stuff
#	after the "IF" is placed in the "...". How exciting!
#	The best part is that the code is in perl not lisp.
#	There are now THEN and END keywords.


# Examples:
#
#	latency -l -X '$t > 0.4' jfku.edu
#	latency -l -X '$t > $Rave + 3.0 * &Rdev' jfku.edu
#	latency -l -X '$t > 2. * $Rave' -S -R 5 jfku.edu
#	latency -l -X '$i > 100 && $t > 2. * $Rave' -S -R 5 jfku.edu
#	latency -l -X 'IF $t > 2. * $Rave END $xmsg = " FOO" if $ret' -S -R 5 jfku.edu
#	latency -l -X 'IF $t > 2*$Rave THEN $xmsg = " GOO"' -S jfku.edu
#	latency -l -X 'IF $t > 2*$Rave THEN $xmsg = " GOO" END system("xterm")' -S jfku.edu
#	latency -l -X 'IF $t > 1.0 * $Rave THEN $xmsg = " $t"' jfku.edu
#
#
#

	if ( $ExtendedScrolling ) {
		local($x) = $ExtendedScrolling;
		if ( $x =~ /^[\d\.]+$/ ) {
			$ExtendedScrolling = '$t > ' . $x . ' * $Rave';
		}
		sub rdev {
			return &dev($rsum2, $rsum, $rcnt);
		}
		sub Rdev {
			return &dev($Rsum2, $Rsum, $Rcnt);
		}
		local($code);
		if ( $ExtendedScrolling =~ /return/ ) {
			$code = $ExtendedScrolling;
			eval "sub condition {
				$code
			}";
			return;
		}
		$code = $ExtendedScrolling;
		if ( $code !~ /\bIF\b/ ) {
			$code = 'IF ' . $code . ' THEN END ';
		} elsif ( $code !~ /\bTHEN\b/ ) {
			if ( $code =~ /\bEND\b/ ) {
				$code =~ s/\bEND\b/THEN END/;
			} else {
				$code .= ' THEN END';
			}
		} elsif ( $code !~ /\bEND\b/ ) {
			$code .= ' END';
		}
		local($then) = '';
		local($rest) = '';
		local($end) = '';
		if ( $code =~ /\bTHEN\b/ ) {
			$code = $`;
			$rest = $';
		}
		if ( $rest =~ /\bEND\b/ ) {
			$then = $` . ' ; ';
			$end  = $' . ' ; ';
		}

		if ( $code =~ /^\s*IF\s+([\d\.]+)\s*$/ ) {
			$code = 'IF $t > ' . $1 . ' * $Rave';
		}

		$code =~ s/\bIF\b/; if ( /;

		local($eval) = "sub condition {
			local(\$ret, \$return);
			$code ) {
				\$return = 1;
				$then
			} else {
				\$return = 0;
			}
			\$ret = \$return;
			\$xmsg = \$M;
			$end
			return \$return;
		}";
		eval $eval;
#		print STDERR $eval, "\n";
	}
}

sub Flash {
	local($text, $mode) = @_;
	if ( $mode eq 'CLEAR' ) {
		local($line) = ' ' x 76;
		&msg("\r");
		&msg($line);
	}
	&msg("\r");
	&msg($text);
}

sub Fit {
	local($w, $str, $side) = @_;
	local($pad) = ' ' x ($w - length($str));
	if ( $side =~ /^r/i ) {
		$str = $pad . $str;
	} else {
		$str = $str . $pad;
	}
	return $str;
}

sub Trim {
	local($x) = @_;
	$x =~ s/^\s*//;
	$x =~ s/\s*$//;
	return $x;
}

sub Float {
	local($x) = @_;
	local($w) = $Width;
	local($d) = $Decimals;
	$w = $w - $d;

	if ( $x > 10 ) {
		$d--;
	}
	$x = sprintf("%${w}.${d}f", $x);
	return $x;
}

sub msg {
	print STDERR @_;
}

sub TimeInRange {
	local($t) = @_;
	return 0 if $t < $Tmin;
	return 1 if $Tmax =~ /inf/i;
	return 0 if $t > $Tmax;
	return 1;
}

sub dev {
	# $sum2 is sum of squares of values
	# $sum1 is sum of values
	local($sum2, $sum1, $n) = @_;
	$sum1 = $sum1/$n;
	$sum2 = $sum2/$n;
	$sum2 = $sum2 - $sum1**2;
	if ( $sum2 > 0.0 ) {
		$sum2 = sqrt($sum2);
	} else {
		$sum2 = 0.0;
	}
	return $sum2;
}

sub Histo {
	local($t, $h, $bin, $bmax, $cnt, $min, $max, $ave, $dev);

	if ( $TimeRange ne '' && $TimeRange !~ /,/ ) {
		$TimeRange = ',' . $TimeRange;
	}
	($Tmin, $Tmax) = split(/\s*,\s*/, $TimeRange);
	$Tmin = 0.0   unless $Tmin ne '';
	$Tmax = 'inf' unless $Tmax ne '';

	$cnt = 0;
	foreach $t (@Times) {
		next if $t < 0.0;
		if ( $TimeRange ) {
			next unless &TimeInRange($t);
		}

		$cnt++;
		$min = $t if $min eq '' || $t < $min;
		$max = $t if $max eq '' || $t > $max;

		$ave += $t;
		$dev += $t**2;
	}

	if ( ! $cnt ) {
		&msg("\nNO COUNTS!\n");
		return;
	} elsif ( ! $Bins || ! $max ) {
		&msg("bah.\n");
		return;
	} else {
		$dev = &dev($dev, $ave, $cnt);
		$ave = $ave/$cnt;
	}

	$ave = &Float($ave);
	$dev = &Float($dev);
	$min = &Float($min);
	$max = &Float($max);

	local($dx) = ($max+0.0)/$Bins;
	$dx = 1.01 * $dx;



	$cnt = 0; $bmax = 0;
	local($bad1, $bad2, $avefac, $devfac);
	$avefac = 2;
	$devfac = 3;

	foreach $t (@Times) {
		next if $t < 0.0;
		if ( $TimeRange ) {
			next unless &TimeInRange($t);
		}

		$cnt++;
		$bin = int($t/$dx);
		$Histo[$bin]++;
		$bmax = $bin if $bin > $bmax;
		$bad1++ if $t > ( $avefac * $ave);
		$bad2++ if $t > $ave +  ($devfac * $dev);
	}

	local($bt1, $bt2) = ($bad1, $bad2);
	$bad1 = (100.0 * $bad1)/$cnt if $cnt;
	$bad2 = (100.0 * $bad2)/$cnt if $cnt;
	$bad1 = sprintf("%5.2f%% [%d/%d > %d*ave]",
					$bad1, $bt1, $cnt, $avefac);
	$bad2 = sprintf("%5.2f%% [%d/%d > ave + %d*dev]",
					$bad2, $bt2, $cnt, $devfac);


	$hmax = 0.0;

	for($bin=0; $bin <= $bmax; $bin++) {
		next unless $cnt;
		$h = ($Histo[$bin] + 0.0)/($cnt + 0.0);
		$Histo[$bin] = $h;
		$hmax = $h if $h > $hmax;
	}

	if ( $Histo eq 'plot' ) {
		print STDOUT "\n";
		local($x);
		for($bin=0; $bin <= $bmax; $bin++) {
			$x = $bin * $dx;
			print STDOUT "$x   $Histo[$bin]\n";
		}
	}
	if ( $Histo =~ /ascii|plot/ ) {
		local($ceil) = int(0.4*$Bins);
		local($ix, $iy, $ixm, $iym, $t, $f);

		if ( $Histo eq 'plot' ) {
			select(STDERR);
		} else {
			select(STDOUT);
		}
		print "\n\n";

		$ixm = 0;
		$iym = 0;
		for($bin=0; $bin <= $bmax; $bin++) {
			$h = $Histo[$bin];
			if ( $h > $HeightRange * $hmax ) {
				$h = $HeightRange * $hmax;
			}
			$iy = int($ceil * ($h/($HeightRange * $hmax) ) );
			$x = $bin * $dx;
			$ix = $bin;
			for ( $i = 0; $i < $iy; $i++) {
				$f{$ix,$i} = '#';
			}
			if ( $iy == 0 && $h > 0.0 ) {
				$f{$ix,$iy} = '.';
			}
			$ixm = $ix if $ix > $ixm;
			$iym = $iy if $iy > $iym;
		}
		for ($iy = $iym; $iy >= 0; $iy--) {
			print "|";
			local($out) = '';
		 	for ($ix = 0; $ix <= $ixm; $ix++) {
				$t = $f{$ix,$iy};
		 		if ( $t ne '' ) {
		 			$out .= "$t";
		 		} else {
		 			$out .= ' ';
		 		}
		 	}
			$out =~ s/\s*$//;
			print $out, "\n";
		}
		print '-' x $bmax, "--\n";
		local($s) = "0.0 ";
		local($c) = length($s);
		$line = $s;
		$s = " $max (sec)";
		$c += length($s);
		$line .= ' ' x ($Bins - $c) . $s;
		print $line, "\n";
	} else {
		&msg("\n");
	}

	&msg("\ncounts: $cnt\n");
	&msg("time: " . sprintf("%.2f", $T) . "\n") if $ExtendedScrolling;
	&msg("host: $RemoteHost\n");
	&msg("ave: $ave\n");
	&msg("dev: $dev\n");
	&msg("min: $min\n");
	&msg("max: $max\n");
	&msg("bad: $bad1,  $bad2\n");
}

sub Initialize {

#	$IS_SYSV = 0;                           # set to 1 for solaris, etc.
#
#	if ( -x "/bin/uname" ) {
#		# OK, this is quite a hack...
#		local($OS_Name)    = `/bin/uname -s`;
#		local($OS_Release) = `/bin/uname -r`;
#		if ( $OS_Name =~ /sunos/i && $OS_Release !~ /^4\./ ) {
#			$IS_SYSV = 1;
#		}
#		# add others
#	}

#	foreach $sig (qw(HUP INT QUIT ILL TRAP ABRT BUS FPE KILL USR1 SEGV USR2 PIPE ALRM TERM STKFLT CHLD CONT STOP TSTP TTIN TTOU URG XCPU XFSZ VTALRM PROF WINCH POLL PWR UNUSED)) {
#		$SIG{$sig} = 'foosig';
#	}

	$SIG{'INT'}  = 'Sig';
	$SIG{'TERM'} = 'Sig';
	# foreach $sig ('CHLD', 'HUP', 'PIPE', 'QUIT') {
	foreach $sig ('HUP', 'PIPE') {
		$SIG{$sig} = 'foosig';
		# $SIG{$sig} = 'IGNORE';
	}
}

sub Sig {
	local($sig) = @_;
	# print STDERR "sig: $sig\n";
	if ( $CaughtSignal > 0 ) {
		exit 1 if $sig eq 'INT';
		return;
	} else {
		$SIG{$sig} = 'IGNORE';
	}
	$CaughtSignal++;

	&msg("\n\n** Caught signal: " . $sig . "  Processing the data we got ... **\n\n");
	&CleanUp();
	&Histo();
	print STDERR "Done.\n";
	exit 1;
}

sub foosig {
	local($sig) = @_;
	# print STDERR "foosig: $sig\n";
}

sub MakeConnection {
    local($host) = @_;

    if ( $ConnectMode =~ /^(echo|smtp|nntp|ftp|\d+)$/ ) {

	&msg("\n## Connecting to service \"$ConnectMode\" on host \"$host\" ... ");

	&Use_Ksockets();
	local($sock) = &Connect($host, $ConnectMode);
	if ( &SocketError($sock) ) {
		$sock =~ s/Error:Ksockets://;
		die "\nSocket error: $sock";
	}
	if ( $ConnectMode =~ /^(smtp|nntp|ftp)$/ ) {
		local($ret, $first);
		$first = 1;

		while (1) {
			$ret = <$sock>;
			if ( $first ) {
				$first = 0;
				&msg("\n\n");
			}
			&msg("$ret");
			if ( $ret =~ /^2\d\d-/ ) {
				next;
			} elsif ( $ret =~ /^2\d\d\s/ ) {
				&msg("\n");
				last;
			} else {
				die "\nProtocol handshake error: $!";
			}
		}
	}
	&msg("## ") unless $ConnectMode =~ /echo|\d+/;
	&msg("Connection OK\n\n");
	return ($sock, $sock);

    } elsif ( $ConnectMode eq 'annex' ) {

	&require_open2();
	local($rdr, $wtr) = ('READIT', 'WRITEIT');
	&msg("\n## Connecting to service \"annex\" on host \"$host\" ... ");

	local($h_tmp, $p_tmp) = split(/:/, $host);

	if ( $host =~ /\s/ ) {
		# host is really a command to run:
		$TelnetPid = &open2($rdr, $wtr, "$host 2>&1");
	} elsif ( $h_tmp =~ m,/, && -e $h_tmp ) {
		# e.g. /dev/ttypd  or /dev/ttypd:23432
		$host = $h_tmp;
		$TelnetPid = $p_tmp;
		$TelnetPid = -1 unless $TelnetPid > 0;

		$wtr = $rdr;
		open(READIT, "+>$host") || die "$!";
		$TelnetPid = -1;
	} else {
		$TelnetPid = &open2($rdr, $wtr, "telnet $host 2>&1");
	}
	die "telnet $host failed: $!" unless $TelnetPid;
	&msg("PID is $TelnetPid\n\n");

	print $wtr "\n";
	&fsleep(0.25);
	print $wtr "cli\n";

	local($str, $c);
	$str = &WaitFor("\\sannex:\\S* ", $rdr, 'echo');

	&msg("\n\n## Connection OK\n\n");
	return ($rdr, $wtr);

    } elsif ( $ConnectMode eq 'rlogin' ) {

	&require_open2();
	local($rdr, $wtr) = ('READIT', 'WRITEIT');
	&msg("\n## Connecting to service \"rlogin\" on host \"$host\" ... ");

	local($h_tmp, $p_tmp) = split(/:/, $host);

	if ( $host =~ /\s/ ) {
		# host is really a command to run:
		$RloginPid = &open2($rdr, $wtr, "$host 2>&1");
	} elsif ( $h_tmp =~ m,/, && -e $h_tmp ) {
		# e.g. /dev/ttypd  or /dev/ttypd:23432
		$host = $h_tmp;
		$RloginPid = $p_tmp;
		$RloginPid = -1 unless $RloginPid > 0;
		$wtr = $rdr;
		open(READIT, "+>$host") || die "$!";
	} else {
		$RloginPid = &open2($rdr, $wtr, "rlogin $host 2>&1");
	}
	die "rlogin $host failed: $!" unless $RloginPid;
	&msg("\nPID is $RloginPid\n");
	&msg("Prompt is \"$Prompt\"\n\n");

	local($sawlastlogin) = 1; # hack it out for now...
	local($str) = '';
	local($c);
	while (1) {
		$c = getc($rdr);
		$str .= $c;
		&msg($c);
		if ( $str =~ /\sPassword:/ ) { # not working.
			print STDERR "READ\n";
			$pw = <STDIN>;
			print STDERR "\nGOT: $pw\n";
			print $wtr $pw;
		}
		if ( $str =~ /last.login/i ) { # is this always OK?
			$sawlastlogin = 1;
		}
		last if $str =~ /$Prompt\S* / && $sawlastlogin;
	}
	&msg("\n\n## Connection OK\n\n");
	return ($rdr, $wtr);

    } else {
	die "Bad ConnectMode: $ConnectMode";
    }
}

sub WaitFor {
	local($pattern, $handle, $mode) = @_;

	local($c, $str, $db);

	$db = 0;

	&msg("\nINTO WaitFor (/$pattern/, $handle, $mode)\n") if $db;

	while (1) {
		$c = getc($handle);
		$str .= $c;
		&msg($c) if $mode =~ /echo/;
		last if $str =~ /$pattern/;
	}
	&msg("GOTIT WaitFor ($str)\n") if $db;

	return $str;
}

sub GetTime {
	if ( $GetTimeMode eq 'syscall' ) {
		return &GetTime_Syscall();
	} elsif ( $GetTimeMode eq 'external' ) {
		return &GetTime_External_C_Program();
	} elsif ( $GetTimeMode =~ /test-/ ) {
		$GetTimeMode = $';
		$Debug = 1;
		&GetTime();
		#&GetTime_Syscall();
		for ($i=0; $i<10; $i++) {
			$str .= &GetTime . "\n";
			#$str .= &GetTime_Syscall . "\n";
		}
		$old = '';
		foreach $line (split(/\n/, $str)) {
			if ( $old ne '' ) {
				$diff = sprintf("%9.6f", $line - $old);
			} else {
				$diff = '';
			}
			$old = $line;
			$line = sprintf("%10.6f", $line);
			$line =~ s/^\s*//;
			print STDOUT "$line	$diff\n";
		}
		exit 0;
	}
	print STDERR "Invalid GetTimeOfDay mode: $GetTimeMode\n";
	exit 1;
}

sub GetTime_Syscall {
	if ( ! $GetTime_Syscall_Init ) {
		local($dir, $found_it);
		$found_it = 0;
		foreach $dir (@INC) {
			if ( -f "$dir/sys/syscall.ph" ) {
				$found_it = 1; # whew!
				last;
			}
		}
		if ( ! $found_it ) {
			# bummer... try to guess the syscall #
			$OS_Name = `uname -s` unless $OS_Name;
			if ( $OS_Name =~ /sunos/i ) {
				eval "sub SYS_gettimeofday { return 156; }";
			} elsif ( $OS_Name =~ /linux/i ) {
				eval "sub SYS_gettimeofday { return 78; }";
			}
		} else {
			require 'sys/syscall.ph';
		}
		&SYS_gettimeofday() || die "$!";
		$GetTime_Syscall_Init = &SYS_gettimeofday();
		print STDERR "Initialized: GetTime_Syscall $GetTime_Syscall_Init\n" if $Debug;
	}

	# let's keep these global...
	# my ($tv, $tv_sec, $tv_usec);
	# Allocate the "timeval" space:
	$tv = ("\0" x 4) x 2;	# assumes long is 4 bytes.
	$tz = ("\0" x 4) x 2;	# assumes long is 4 bytes.
	syscall($GetTime_Syscall_Init, $tv, $tz);

	($tv_sec, $tv_usec) = unpack("L2", $tv);
#	$tv_sec  = substr($tv, 0, 4);
#	$tv_usec = substr($tv, 4, 4);
#	$tv_sec  = unpack("l", $tv_sec);
#	$tv_usec = unpack("l", $tv_usec);
	$tv_usec2 = sprintf("%8.6f", $tv_usec/1000000.0);

	if ( $tv_usec2 =~ /^0\./ ) {
		$tv_usec2 =~ s/^0\././;
		$tv_sec = "$tv_sec$tv_usec2";
	} else {
		$tv_sec = $tv_sec + ($tv_usec/1000000.0);
	}
	if ( $StartTime ne '' ) {
		$tv_sec -= $StartTime;
	}
	return $tv_sec;
}

sub GetTime_External_C_Program {
	local($debug) = 0;
	if ( ! $TimeProg && $Timer =~ /^(C|CPIPE)$/ ) {
	    $TimeProg = &MakeTimeProg();
	    print STDERR "TimeProg: $TimeProg\n" if $Debug;
	    if ( $Timer eq 'CPIPE' ) {
		&require_open2();
		$TimerPid = &open2('TIMER_RDR', 'TIMER_WTR', "$TimeProg");
		if ( $debug ) {
			print TIMER_WTR "a\n";
			$x = <TIMER_RDR>;
			&msg("xx: $x\n");
		}
	    }
	    print STDERR "Initialized: GetTime_External_C_Program\n" if $Debug;
	}

	local($t, $sec, $usec);
	if ( $Timer =~ /^(C|CPIPE)$/ ) {
		if ( $Timer eq 'C' ) {
			chop($t = `$TimeProg once_only`);
		} elsif ( $Timer eq 'CPIPE' ) {
			print TIMER_WTR "a\n";
			chop($t = <TIMER_RDR>);
			&msg("t: $t\n") if $debug;
		}
		($sec, $usec) = split(/:/, $t);
		$sec = $sec - $StartTime;
		return $sec + $usec;
	}
}

sub MakeTimeProg {

	local($base);
	chop($base = `basename $Timer_Prog_Bin`);
	system("type $base >/dev/null 2>&1");
	if ( $? == 0 ) {
		return $base;
	}

	if ( -x $Timer_Prog_Bin ) {
		# Assume it works fine.
		return $Timer_Prog_Bin;
	}

	local($tmp) = "/tmp/timeprog$$.c";

	open(CODE, ">$tmp") || die "open $tmp: $!";

	# the following code, when accessed from perl, is accurate
	# to about 100-200 usec on Pentium 200 MHz machine.
	# compare with 20 usec for pure C code.
	print CODE <<"END";

#		include <sys/time.h>
#		include <unistd.h>
#		include <stdio.h>

		void gtod(void);
		main(int argc, char **argv) {
			char buf[100];

			if (argc > 1) {
				gtod();
				return 0;
			}

			/* setlinebuf(stdout); */
			setbuf(stdout, NULL);

			while (fgets(buf, sizeof(buf), stdin) != NULL) {
				/* fprintf(stderr, "EGG: %s\\n", buf); */
				if ( buf[0] == '\\0' || buf[0] == 'Q' ) {
					break;
				}
				gtod();
			}

			return 0;
		}

		void gtod(void) {
			struct timeval tv;
			double frac;

			gettimeofday(&tv,NULL);
			frac = ((double) tv.tv_usec)/1000000.;
			printf("%d:%f\\n", tv.tv_sec, frac );
			/* fflush(stdout); */
		}
END
	close(CODE);
	system("cat $tmp") if $Debug;
	local($time_prog) = "$tmp"; $time_prog =~ s/\.c$//;
	system("cc -o $time_prog $tmp; chmod 755 $time_prog");

	die "Could not compile timer program: $!" if ! -x $time_prog;

	unlink($tmp) unless $Debug;

	if ( ! -x $Timer_Prog_Bin ) {
		system("cp $time_prog $Timer_Prog_Bin");
		if ( -x $Timer_Prog_Bin ) {
			unlink($time_prog);
			$time_prog = $Timer_Prog_Bin;
		}
	}

	return $time_prog;
}

sub CleanUp {

	# &msg("CLEANUP!\n");
	if ( defined($TimeProg) && -f $TimeProg ) {
		if ( defined($Timer_Prog_Bin) && $TimeProg eq $Timer_Prog_Bin ) {
			;
		} elsif ( defined($Keep_Timer_Prog) && $Keep_Timer_Prog ) {
			print STDERR "\nKeeping timer program in $TimeProg\n";
		} else {
			unlink $TimeProg if defined($TimeProg) && ! $Debug;
		}
	}
	if ( defined($Timer) &&  $Timer eq 'CPIPE' ) {
		print TIMER_WTR "Q\n";
		kill TERM, $TimerPid if defined($TimerPid);
		close(TIMER_WTR);
		close(TIMER_RDR);
	}

	if ( ! defined($ConnectMode) ) {
		;
	} elsif ( $ConnectMode =~ /^(smtp|ftp|nntp)$/ ) {
		print $WTR "quit\n" if defined($WTR);
		&fsleep(0.25);
	} elsif ( $ConnectMode eq 'annex' ) {
		print $WTR "hangup\n" if defined($WTR);
		&fsleep(0.25);
		kill TERM, $TelnetPid if defined($TelnetPid) && $TelnetPid > 0;
	} elsif ( defined($RloginPid) ) {
		print $WTR "\nexit\nexit\n" if defined($WTR);
		&fsleep(0.25);
		kill TERM, $RloginPid if $RloginPid > 0;
	}
	close($RDR) if defined($RDR);
	close($WTR) if defined($WTR);
}

sub fsleep {
	local($time) = @_;
	return unless $time > 0.0;
	select(undef, undef, undef, $time);
}

sub require_open2 {
	# is this really needed?
	# require 'open2.pl' unless $RequiredOpen2;
	&Use_open2() unless $RequiredOpen2;
	$RequiredOpen2 = 1;
}

sub help {
	local($data) = @_;
	$data = $Usage if $data eq '';

	if ( $ENV{'PAGER'} ne '' && open(PAGER, "|$ENV{'PAGER'}") ) {
		# open pipeline to user's pager
		print PAGER "$data";
		close(PAGER);
	} elsif ( open(MORE, "|more") ) {       # open pipeline to "more"
		print MORE "$data";
		close(MORE);
	} else {
		print STDERR "$data";
	}
}

##########################################################################
# Do this before calling &open2(): &Use_open2;
#==============================================================================
# &open2: tom christiansen, <tchrist@convex.com>
#
# usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
#    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
#
# spawn the given $cmd and connect $rdr for
# reading and $wtr for writing.  return pid
# of child, or 0 on failure.
#
# WARNING: this is dangerous, as you may block forever
# unless you are very careful.
#
# $wtr is left unbuffered.
#
# abort program if
#	rdr or wtr are null
# 	pipe or fork or exec fails

package open2;

sub main'Use_open2 {

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

	$fh = 'FHOPEN000'; # package static in case called more than once
	$open2_initialized = 'True';

} # end Use_open2

sub main'open2 {
    local($kidpid);
    local($dad_rdr, $dad_wtr, @cmd) = @_;

    $dad_rdr ne '' 		|| die "open2: rdr should not be null";
    $dad_wtr ne '' 		|| die "open2: wtr should not be null";

    # force filehandles into callers' package
    local($package) = caller;
    $dad_rdr =~ s/^[^']+$/$package'$&/;
    $dad_wtr =~ s/^[^']+$/$package'$&/;

    local($kid_rdr) = ++$fh;
    local($kid_wtr) = ++$fh;

    pipe($dad_rdr, $kid_wtr) 	|| die "open2: pipe 1 failed: \"$!\"";
    pipe($kid_rdr, $dad_wtr) 	|| die "open2: pipe 2 failed: \"$!\"";

    if (($kidpid = fork) < 0) {
	die "open2: fork failed: \"$!\"";
    } elsif ($kidpid == 0) {
	close $dad_rdr; close $dad_wtr;
	open(STDIN,  "<&$kid_rdr");
	open(STDOUT, ">&$kid_wtr");
	$debug = 0 unless $debug;
	warn "execing @cmd\n" if $debug;
	exec @cmd;
	die "open2: exec of @cmd failed";
    }
    close $kid_rdr; close $kid_wtr;
    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
    $kidpid;

} # end open2

###1; # so require is happy

#----------------------------------------------------------------------
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