#!/usr/bin/perl -w
#
# multiclient.pl - scalable generic client with internal socks support
#

#  Copyright (c) 2011, 2012, 2013, 2014, 2015
#       Inferno Nettverk A/S, Norway.  All rights reserved.
# 
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. The above copyright notice, this list of conditions and the following
#     disclaimer must appear in all copies of the software, derivative works
#     or modified versions, and any portions thereof, aswell as in all
#     supporting documentation.
#  2. All advertising materials mentioning features or use of this software
#     must display the following acknowledgement:
#       This product includes software developed by
#       Inferno Nettverk A/S, Norway.
#  3. The name of the author may not be used to endorse or promote products
#     derived from this software without specific prior written permission.
# 
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
#  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
#  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
#  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
#  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
#  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
#  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
#  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
#  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
#  THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 
#  Inferno Nettverk A/S requests users of this software to return to
# 
#   Software Distribution Coordinator  or  sdc@inet.no
#   Inferno Nettverk A/S
#   Oslo Research Park
#   Gaustadalleen 21
#   NO-0349 Oslo
#   Norway
# 
#  any improvements or extensions that they make and grant Inferno Nettverk A/S
#  the rights to redistribute these changes.

use Time::HiRes qw(gettimeofday tv_interval time usleep);
use IO::Socket::INET;
use Errno qw(EINTR EINPROGRESS);
use Getopt::Std;
use IO::File;
use warnings;
use strict;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);

##rtt:
#plot 'log-rtt-rtt-0-0.log' using ($1):($4):($4-$5/2):($4+$5/2) with errorbars

my $app = __FILE__;
$app =~ s/.*\/([^\/]+)$/$1/; #basename filename
my $usage = "$app: [-v] [-b file] [-f format] -l <sec> [-O iplist] [-r <rate>] [-s <host>:<port>] [-t file] <clientspec 1> [...]
 -b file                  : read addresses to bind to from file
 -L <host>:<port>         : bind local end to <host>:<port> before connecting
 -l <sec>                 : test duration in seconds
 -O iplist                : set list of option28 socket options before connect
 -f <format>              : if 'csv', log in cvs format
 -r <rate>                : rtt mode send rate (packets/second)
 -s <host>:<port>         : connect through socks server at <host>:<port>
 -t file                  : read target address list from file
 -v                       : verbose

The client specification controls client behavior and has the following format:

<type>:<clientcnt>:<proto>:<clients/sec>:<host>:<port>[:clients/process][:id]

type: client type: send|recv|sendrecv|rtt|connect
  -send        : data sending client (host:port should be a discard server)
  -recv        : data receiving client (host:port should be a chargen server)
  -sendrecv    : data send and receive (host:port should be an echo server)
  -rtt         : data latency measuring client (host:port should be an echo server)
  -connect     : connect latency measuring client (host:port can be any server)
  -connectbyte : as 'connect', but include rtt time with a single byte
  -connecsec   : as 'connect', but sleep for one second before closing

clientcnt: number of clients to start.

proto: protocol type, only tcp supported.

clients/sec: rate at which new client connections are opened.

host:port: hostname/ip address and port number clients attempt to connect to.

clients/process: optional value, specifies the number of connections/process.
                 will default to using only a single process if not given.

id: optional value, can be used to name client when logging.

The host field can include usernames and passwords in the following format:
 user;password\@host
";

my $DURATION = 60; #default value
my $WSIZE = 65536;
my $RSIZE = 65536 * 10;
my $SOCKSSERVER;
my $SOCKSPORT;
my $LOGFORMAT;
my $ID;
my $RANDHOSTID = 0; #generate random hostid values for each new connection
my $VERBOSE = 0; #verbose output of program operations
my $RTTPKGRATE; #'rtt' send/generated packet rate (outgoing)

#parse arguments
getopts('b:f:L:l:O:Rr:s:t:v');
(defined $::opt_v) and ($VERBOSE = $::opt_v);
my @BINDHOSTS;
if (defined $::opt_b) {
    my $bindhostfile = $::opt_b;
    open(FILE, "<$bindhostfile") or die "$app: error: open: $bindhostfile: $!\n";
    while (<FILE>) {
	die "$app: error: unexpected format: $_" unless /^(\S+)$/;
	push @BINDHOSTS, $1;
    }
}
(defined $::opt_f) and ($LOGFORMAT = $::opt_f);
my ($LHOST, $LPORT);
if (defined $::opt_L) {
    if (@BINDHOSTS) {
	die "$app: error: cannot specify bind address (-L) when using -b option\n";
    }
    die "$app: invalid host/port specification: $::opt_L\n" unless
	$::opt_L =~ /^([^\s:]+)$/ or $::opt_L =~ /^([^\s:]+):(\S*)$/;
    $LHOST = $1;
    $LPORT = $2 if $2;
}
if (defined $::opt_l) {
    die "$app: invalid duration value: $::opt_l\n" unless
	$::opt_l =~ /^\d+$/;
    $DURATION = $::opt_l;
}

if (defined $::opt_r) {
    $RTTPKGRATE = $::opt_r;
}

if (defined $::opt_s) {
    if ($::opt_s =~ /^([^:]+):([^:]+)$/) {
	($SOCKSSERVER, $SOCKSPORT) = ($1, $2);
	warn "$app: using socks server at $SOCKSSERVER:$SOCKSPORT\n" if $VERBOSE;
    } else {
	die "$app: error: invalid socks server specification: $::opt_s\n";
    }
}
my @TARGETHOSTS;
if (defined $::opt_t) {
    my $targethostfile = $::opt_t;
    open(FILE, "<$targethostfile") or die "$app: error: open: $targethostfile: $!\n";
    while (<FILE>) {
	die "$app: error: unexpected format: $_" unless /^(\S+)$/;
	push @TARGETHOSTS, $1;
    }
}
my @OPT28IPS;
my $optdata = "";
if (defined $::opt_O) {
    @OPT28IPS = split(/,/, $::opt_O);
    for my $ip (@OPT28IPS) {
	die "$app: invalid option28 ip address: $ip\n" unless
	    $ip =~ /^\d+\.\d+\.\d+\.\d+$/;
	$optdata .= inet_aton($ip);
    }
}
my $optstr = join " ", @OPT28IPS;
(defined $::opt_R) and ($RANDHOSTID = $::opt_R);

if ($RANDHOSTID and $optstr) {
    die "$app: error: cannot specify both random and predefined hostid values";
}

my @reqs = @ARGV;

die "$usage" unless @reqs;

# :<client type>:<#clients>:<proto>:<new clients/sec>:<servname>:<servport>:<clients/process>:<id>

#connect process
# -short connect times will lead to many connect attempts, perhaps
#  focus more on the number of connect attempts per second
#  <#clients>        : upper limit on connections in connect state
#  <new clients/sec> : number of connect attempts per second

my @children;

#kill any child processes if main process is interrupted
sub cleanup {
    if (@children) {
	kill 9, @children;
	while (wait != -1) {}
    };
}
$SIG{INT} = \&cleanup;
$SIG{TERM} = \&cleanup;

system("uname > log-uname.txt");
system("hostname > log-hostname.txt");
my $HOSTNAME = `cat log-hostname.txt`;
chomp $HOSTNAME;
my $logstart;
if (-e "log-starttime.txt") {
    #reuse starttime if it already exists
    $logstart = `cat log-starttime.txt`;
    chomp $logstart;
} else {
    $logstart = time;
    system("echo $logstart > log-starttime.txt");
}

my $speccnt = 0;
my @specidlist;
my $procid = 0;
for my $clientspec (@reqs) {
    my ($type, $maxconn, $proto, $connspersec, $host, $portarg, $connsperproc,
	$id, $extra) = split(/:/, $clientspec);
    die "$app: invalid specification: $clientspec" if defined $extra;
    die "$app: invalid type: $type" unless
	grep /^$type$/, qw(rtt send recv sendrecv connect connectbyte connectsec);
    die "$app: invalid connection count value: $maxconn" unless
	$maxconn =~ /^\d+$/;
    die "$app: invalid proto in specification: $proto" unless
	grep /^$proto$/, qw(tcp udp);
    my $port;
    if ($portarg !~ /^\d+$/) {
	$port = getservbyname($portarg, $proto);
    } else {
	$port = $portarg;
    }
    die "$app: invalid port: $portarg" unless defined $port and $port =~ /^\d+$/;
    die "$app: invalid connections/sec value" unless
	$connspersec =~ /^\d+$/;
    if (defined $connsperproc and $connsperproc ne "") {
	die "$app: invalid connections/process value: $connsperproc" unless
	    $connsperproc =~ /^\d+$/;
    } else {
	#default to all connections in one process
	$connsperproc = $maxconn;
    }

    my $specid = defined $id ? $id : $speccnt;
    push @specidlist, $specid;

    #start client based on specification
    my $conns = 0;
    #multiple processes might not be needed
    my $procs;
    if ($maxconn <= $connsperproc) {
	$procs = 1;
    } else {
	$procs = $maxconn/$connsperproc;
	if ((int $procs) != $procs) {
	    $procs = int $procs;
	    $procs++; #round up
	}
    }
#    warn "procs: $procs";

    if ($procs > 1) {
	#spread connections evenly among processes
	$connsperproc = int($maxconn/$procs) ;
#	warn "procs: $procs -> prr: $connsperproc";
    }

    while ($conns < $maxconn) {
	my $newconns;
	my $firstclientid = $conns;
#	warn "conns: $conns connsperproc: $connsperproc maxconn: $maxconn\n";
	if ($procid + 1 < $procs) {
	    $newconns = $connsperproc;
	} else {
	    $newconns = $maxconn - $conns;
	}
	$conns += $newconns;

	my $pid;
	if (!defined ($pid = fork()) or $pid == -1) {
	    die "$app: fork: $!\n";
	} elsif ($pid == 0) {
	    my $ncps;
	    if ($connspersec == 0) {
		#calculate automatically if value is zero
		$ncps = $newconns/$DURATION;
	    } else {
		$ncps = $connspersec/$procs;
	    }

	    my ($rttrate, $procrttrate, $rttrateinterval);
	    if (defined $RTTPKGRATE) {
		$procrttrate = $RTTPKGRATE / $procs;
		$rttrate = $RTTPKGRATE / ($procs * $newconns);
		$rttrateinterval = 1 / $rttrate;
#		print "rttrate: $rttrate rttrateinterval: $rttrateinterval\n";
	    }

#	    warn "newconns: $newconns, ncps: $ncps\n";
	    clientproc($specid, $procid, $firstclientid, $type, $newconns,
		       $ncps, $proto, $host, $port, $SOCKSSERVER,
		       $SOCKSPORT, $rttrateinterval, $procrttrate);
	    exit 0;
	}
	push @children, $pid;
	$procid++;
    }
    $speccnt++;
}
open(IDS, ">>log-specids.txt") or die "$app: open: $!\n";
printf IDS "%s\n", join " ", @specidlist;
close IDS;

for (;;) {
    my $pid = wait;
    last if $pid == -1; 
#    warn "client $pid ended\n";
}

exit 0;

######################################################################

sub clientproc {
    my $specid = shift @_;
    my $procid = shift @_;
    my $firstclientid = shift @_;
    my $type = shift @_;
    my $maxconn = shift @_;
    my $connspersec = shift @_;
    my $proto = shift @_;
    my $host = shift @_;
    my $port = shift @_;
    my $socksserver = shift @_;
    my $socksport = shift @_;
    my $rttrateinterval = shift @_;
    my $procrttrate = shift @_;

    if ($host =~ /;.*\@/ and !defined $socksserver) {
	die "$app: user/password only valid when socks server used";
    }

    my $key = "$HOSTNAME:$type:$procid";

    my $req = "x" x $WSIZE;

    warn "$app: starting $type process ($procid) $maxconn connections $host:$port\n" if $VERBOSE;
    my $pconns = sprintf "%0.1f", $connspersec;
    warn "$app: '$type' proc $procid: $pconns conns/sec\n" if $VERBOSE;
    if ($connspersec > 0) {
	usleep rand(1000000 * 1/$connspersec); #randomize start time for process
    }

    $SIG{PIPE} = sub { die "sigpipe!" };

    my @conns;

    my $starttime = time;
    my $prevtime = $starttime;
    my $prevconntime;
    my $currclient = $firstclientid;

    my $connvars = {}; #per-connection variables
    my $globalvars = {}; #global vars, common for all clients
    globalvarinit($globalvars);
    $globalvars->{'key'} = "$key";
    $globalvars->{'clienttype'} = "$type";
    $globalvars->{'hostname'} = "$HOSTNAME";
    $globalvars->{'starttime'} = "$logstart";
    $globalvars->{'specid'} = "$specid";
    $globalvars->{'procid'} = "$procid";
    $globalvars->{'type'} = "$type";

    $globalvars->{'conncount'} = 0;
    $globalvars->{'targetokconncount'} = 0;
    $globalvars->{'socksokconncount'} = 0;
    $globalvars->{'connerrs'} = 0;
    $globalvars->{'errors'} = {};
    $globalvars->{'packetrate'} = {}; #rtt mode 'packet' send rate

    $globalvars->{'logtypes'} = {};
    if ($type ne 'connect' and
	$type ne 'connectsec') {
	$globalvars->{'logtypes'}->{'logbw'} = 1;
    }
    $globalvars->{'logtypes'}->{'logconn'} = 1;
    $globalvars->{'logtypes'}->{'logconn2'} = 1;
    $globalvars->{'logtypes'}->{'logconnavg'} = 1;
    if ($type eq 'connectbyte') {
	$globalvars->{'logtypes'}->{'logconnbyte'} = 1;
    }
    if ($type ne 'connect' and $type ne 'connectsec') {
	$globalvars->{'logtypes'}->{'logbw'} = 1;
    }
    $globalvars->{'logtypes'}->{'logerr'} = 1;
    if ($type eq 'rtt') {
	$globalvars->{'logtypes'}->{'logrtt'} = 1;
    }
    if ($type ne 'connect') {
	$globalvars->{'logtypes'}->{'logact'} = 1;
    }

    if (@TARGETHOSTS and $host) {
	die "$app: error: both host and target host file specified\n";
    }

    my ($connhost, $connport);
    if (defined $socksserver) {
	($connhost, $connport) = ($socksserver, $socksport);
    } else {
	($connhost, $connport) = ($host, $port);
    }
    my $connip = gethostbyname($connhost);
    die "$app: error: gethostbyname failed: $connhost" unless defined $connip;
    $connip = inet_ntoa($connip);

    my $currbyte = "\000";

    loginit($globalvars);

    my $conncnt = 0;
    for (;;) {
	#print?
	my $now = time;

	my $pnow = "$now: [proc $procid]";

	if ($type eq "connectsec" and exists $globalvars->{'connsecconns'}) {
	    while (@{ $globalvars->{'connsecconns'} }) {
		my ($desc, $t0) = @{ ${ $globalvars->{'connsecconns'} }[0] };
		my $remaining = 1 - tv_interval($t0);
		if ($remaining < 0) {
		    #at least one second passed, close
		    connclose($desc, \@conns, $connvars, $globalvars);
		    warn "$pnow: closed connectsec connection, active: $globalvars->{'active'}\n" if $VERBOSE;
		} else {
#		    warn "$pnow: not closing, still remaining $remaining\n";
		    last; #should be sorted by time, can stop looking
		}
	    }
	}

	if ($now > $prevtime + 1) {
	    my $dur = $now - $prevtime;
	    my $tdur = $now - $starttime;
#	    warn "$pnow: $tdur passed";
	    $prevtime = $now;
	    for my $fileno (keys %$connvars) {
		logvals($globalvars, $connvars->{$fileno}, $now, "logbw");
		$connvars->{$fileno}->{'readbytes'} = 0;
		$connvars->{$fileno}->{'wrotebytes'} = 0;
		if ($type eq "rtt") {
		    logvals($globalvars, $connvars->{$fileno}, $now, "logrtt");
		    delete $connvars->{$fileno}->{'rttvals'};
		}
	    }
	    if (exists $globalvars->{'conntimevals'}) {
		logvals($globalvars, undef, $now, "logconnavg");
		delete $globalvars->{'conntimevals'};
	    }
	    #time to end?
	    if ($now > $starttime + $DURATION) {
		warn "$pnow: time to end client, duration complete ($DURATION)\n" if $VERBOSE;
		last;
	    }
	}

	#start new connection?
	my $initnew = 0;
	if (!defined $prevconntime) {
	    $initnew = 1;
	} elsif (scalar keys %$connvars < $maxconn) {
	    if (($type eq "connect" or
		 $type eq "connectbyte" or
		 $type eq "connectsec") and
		$connspersec == 0) {
		#always start new connection if connspersec is zero
		$initnew = 1;
	    } elsif ($conncnt < ($now - $starttime) * $connspersec) {
		#otherwise follow rate limit; rate limit determined by
		#start time and number of connections per second
		#(might lead to many connections being opened after hang)
		my $tdiff = $now - $starttime;
		if ($conncnt < $maxconn) {
		    $initnew = 1;
		}
	    }
	}
	if ($initnew) {
	    $conncnt++;
	    my $off = sprintf "%0.3f", $now - $starttime;
	    warn "$pnow: opening new connection ($conncnt/$maxconn - active: $globalvars->{'active'}, off: ${off}s)\n" if $VERBOSE;
	    my $t0 = [gettimeofday];

	    warn "$pnow: connecting to $connhost($connip).$connport ($type)\n" if $VERBOSE;
	    #only create object, need to set any option28 data before connect
	    my $desc = new IO::Socket::INET(Proto => $proto,
					    Blocking => 0);
	    die "$pnow: descriptor creation failed: $!\n" unless defined $desc;

	    if ($optdata) {
		my $OPTION28 = 28;
		my $SOL_TCP = 6;
		warn "$pnow: setting option28 data: $optstr\n" if $VERBOSE;
		setsockopt($desc, $SOL_TCP, $OPTION28, $optdata) 
		    or die "$pnow: error: setsockopt: $!\n";
	    } elsif ($RANDHOSTID) {
		my $OPTION28 = 28;
		my $SOL_TCP = 6;
		my $randip = int rand 255;
		$randip .= ".";
		$randip .= int rand 255;
		$randip .= ".";
		$randip .= int rand 255;
		$randip .= ".";
		$randip .= int rand 255;
		my $optdata .= inet_aton($randip);

		#XXX test below should indicate '50% chance'
		if (rand 100 > 50) {
		    #one more ip
		    my $randip = int rand 255;
		    $randip .= ".";
		    $randip .= int rand 255;
		    $randip .= ".";
		    $randip .= int rand 255;
		    $randip .= ".";
		    $randip .= int rand 255;
		    $optdata .= inet_aton($randip);
		}

		warn "$pnow: setting random option28 data: $randip\n" if $VERBOSE;
		setsockopt($desc, $SOL_TCP, $OPTION28, $optdata) 
		    or die "$app: error: setsockopt: $!\n";
	    }

	    #bind local end, if requested
	    my $sockname;
	    if (defined $LHOST or defined $LPORT or @BINDHOSTS) {
		my ($bindhost, $bindport);
		if (@BINDHOSTS) {
		    #XXX rotate through entries using shift/push
		    $bindhost = shift @BINDHOSTS;
		    push @BINDHOSTS, $bindhost;
		    $bindport = 0; #XXX set to zero for now
		} else {
		    $bindhost = (defined $LHOST ? $LHOST : "0.0.0.0");
		    $bindport = (defined $LPORT ? $LPORT : "0");
		}
		warn "$pnow: binding to $bindhost.$bindport ($type)\n" if $VERBOSE;
		bind($desc, sockaddr_in($bindport, inet_aton($bindhost)))
		    or die "$app: error: bind: ${bindhost}.$bindport $!";
		$sockname = sockname($desc);
	    } else {
		$sockname = "unknown";
	    }

	    if (@TARGETHOSTS and !defined $socksserver) {
		#XXX rotate through entries using shift/push
		$host = shift @TARGETHOSTS;
		$connip = gethostbyname($host);
		die "$app: error: gethostbyname failed: $host" unless defined $connip;
		$connip = inet_ntoa($connip);
		push @TARGETHOSTS, $host;
	    }

	    $globalvars->{'conncount'}++;
	    my $dur0 = tv_interval($t0);
	    my $r = connect($desc, sockaddr_in($connport, inet_aton($connip)));
	    my $errval = $!;
	    if (!defined $r and !$!{EINPROGRESS}) {
		warn "$pnow: connect: $host:$port: $!\n" if $VERBOSE;
		connerr($globalvars, $errval);
		$prevconntime = $now;
	    } else {
		die "$app: error: desc undefined" if !defined $desc;
		$prevconntime = $now;
		my $fileno = $desc->fileno;
		clientvarinit($connvars, $fileno, $currclient, $t0);
		$currclient++;
		my $clientvars = $connvars->{$fileno};
		die "$app: no clientvars" unless defined $clientvars;
		$clientvars->{'sockname'} = $sockname if $sockname;
		$clientvars->{'peername'} = "${connip}.${connport}";
		$conns[$fileno] = $desc;
		if ($desc->connected) {
		    #XXX set time after connect return above?
		    my $t1 = [gettimeofday];
		    $clientvars->{'connectend'} = $t1;
		    push @{ $globalvars->{'conntimevals'} }, $dur0;
		    logvals($globalvars, $clientvars, $now, "logconn");
		    if ($type eq 'connect' and !defined $socksserver) {
			warn "$pnow: immediate connect to $host:$port\n" if $VERBOSE;
			#close socket
			connclose($desc, \@conns, $connvars, $globalvars);
			next;
		    }
		    if (defined $socksserver) {
			die "$app: undef a" unless defined $conns[$fileno];

			if (@TARGETHOSTS) {
			    #XXX rotate through entries using shift/push
			    $host = shift @TARGETHOSTS;
			    push @TARGETHOSTS, $host;
			}
			$globalvars->{'socksokconncount'}++;
			$clientvars->{'socksnegstart'} = [gettimeofday];
			socksreq($globalvars, $pnow, $conns[$fileno], $clientvars, $host, $port);
			$clientvars->{'state'} = 'socksneg';
		    } else {
			$globalvars->{'targetokconncount'}++;
			$globalvars->{'active'}++;
			$clientvars->{'state'} = 'active';
			warn "$pnow: connected (immediate) (desc: $fileno), active: $globalvars->{'active'}\n" if $VERBOSE;
			logvals($globalvars, undef, $now, "logact", "+");
			if ($type eq "connectsec") {
			    push @{ $globalvars->{'connsecconns'} }, [$desc, $t1];
			}
			logvals($globalvars, $clientvars, $now, "logconn2");
		    }
		} else {
#		    print LOG "not yet connected to $host:$port\n";
		    $clientvars->{'state'} = 'connecting';
		}
	    }
	}

	#prepare for select
	my (@rlist, @wlist);
	for my $fileno (keys %$connvars) {
	    my $clientvars = $connvars->{$fileno};
	    die "$app: no clientvars" unless defined $clientvars;
	    my $descstate = $clientvars->{'state'};
	    if ($descstate eq 'connecting') {
		push @wlist, $conns[$fileno];
		push @rlist, $conns[$fileno];
	    } elsif ($descstate eq 'socksneg') {
		my $wantop = $clientvars->{'socksneg'}->{'wantop'};
		if ($wantop eq 'read') {
		    push @rlist, $conns[$fileno];
		} elsif ($wantop eq 'write') {
		    push @wlist, $conns[$fileno];
		    push @rlist, $conns[$fileno];
		} else {
		    die "$app: unexpected socks io operation: $wantop";
		}
	    } elsif ($descstate eq 'active') {
		if ($type eq "send") {
		    push @wlist, $conns[$fileno];
		    push @rlist, $conns[$fileno];
		} elsif ($type eq "recv") {
		    push @rlist, $conns[$fileno];
		} elsif ($type eq "sendrecv") {
		    push @rlist, $conns[$fileno];
		    push @wlist, $conns[$fileno];
		} elsif ($type eq "connectsec") {
		    #awaiting no data, but might have errors
		    push @rlist, $conns[$fileno];
		} elsif ($type eq "rtt" or $type eq "connectbyte") {
		    #waiting for reply?
		    if (exists $clientvars->{'rttsendtime'}) {
			push @rlist, $conns[$fileno];
		    } else {
			my $tdiff;
			if ($type eq "rtt" and defined $rttrateinterval and
			    exists $clientvars->{'prevrttsendtime'}) {
			    #NOTE: rate is controlled by not checking for
			    #      a writable socket if it is too early to
			    #      send new data. simplifies code, but might
			    #      introduce delays if socket is not writable
			    #      at the time a write is desired.

			    #first check global value
			    my $tdiff0 = tv_interval($globalvars->{'prevrttsendtime'});
			    if ($tdiff0 < $rttrateinterval/$maxconn) {
				#too little delay since last send
				next;
			    }

			    $tdiff = tv_interval($clientvars->{'prevrttsendtime'});
			}
			if (defined $tdiff and defined $rttrateinterval and
			    $tdiff < $rttrateinterval) {
			    #delay until rate interval reached
			} else {
			    push @wlist, $conns[$fileno];
			}
			push @rlist, $conns[$fileno];
		    }
		} else {
		    die "$app: unknown type: $type";
		}
	    } else {
		die "$app: unexpected state: $descstate";
	    }
	}

	#select
	my $timeout;
	if ($connspersec == 0) {
	    $timeout = 0;
	} else {
	    #use shorter timeout to get better resistance against variance
	    $timeout = 1/(2 * $connspersec);
	}
	if ($type eq "connectsec" and
	    exists $globalvars->{'connsecconns'} and @{ $globalvars->{'connsecconns'} }) {
	    my ($conninitt0) = ${ $globalvars->{'connsecconns'}[0] }[1];
	    my $remaining = 1 - tv_interval($conninitt0);
	    $timeout = $remaining if ($remaining < $timeout);
#	    warn "$pnow: preselect: $remaining until next connclose";
	}
	if ($type eq "rtt" and defined $rttrateinterval) {
	    #adjust timeout as necessary based on send rate
	    if (exists $globalvars->{'prevrttsendtime'}) {
		my $tdiff = tv_interval($globalvars->{'prevrttsendtime'});

		if ($tdiff < $rttrateinterval/$maxconn) {
		    my $alttimeout = $rttrateinterval/$maxconn - $tdiff;
		    if ($alttimeout < $timeout) {
			$timeout = $alttimeout;
#			warn "adjusting timeout: -> $timeout ($tdiff)";
		    }
		} else {
		    #already passed, setting short timeout
		    $timeout = 0.000001;
#		    warn "adjusting timeout2: -> $timeout ($tdiff)";
		}
	    } else {
		if ($rttrateinterval/$maxconn < $timeout) {
		    $timeout = $rttrateinterval/$maxconn;
#		    warn "adjusting timeout3: -> $timeout";
		}
	    }
	}
#	warn "$pnow: setting select timeout to $timeout\n";
	my ($n, $rfds, $wfds, $efds) = selectfds([@rlist], [@wlist], $timeout);
	my $selecttime = [gettimeofday];
	if ($n == -1) {
	    next if $! == EINTR;
	    die "$app: select failed: $!";
	} elsif ($n == 0) {
#	    warn "$pnow: timeout";
	    next;
	} else {
	    my $errh = {};
	    my $errdesc = {};
	    my @socksio;
	    #error flagged descriptors
	    for my $desc (@{ $efds }) {
		my $fileno = $desc->fileno;
		die "$app: no fileno" unless defined $fileno;
		$errh->{$desc->fileno} = 1;
		$errdesc->{$fileno} = $desc;
	    }
	    #handle writeable descriptors (active only)
	    for my $desc (@{ $wfds }) {
		my $fileno = $desc->fileno;
		my $clientvars = $connvars->{$fileno};
		die "$app: no clientvars" unless defined $clientvars;
		next if exists $errh->{$fileno};
		if ($clientvars->{'state'} eq 'socksneg') {
		    push @socksio, $fileno;
		} elsif ($clientvars->{'state'} eq 'active') {
#		    print "writeable\n";
		    my $buf;
		    my $res;
		    my $errval;
		    if ($type eq "send") {
			$res = syswrite($desc, $req);
			$errval = $!;
		    } elsif ($type eq "sendrecv") {
			$res = syswrite($desc, $req);
			$errval = $!;
		    } elsif ($type eq "rtt" or $type eq "connectbyte") {
			vunset($clientvars, 'rttsendtime');
			delete $clientvars->{'prevrttsendtime'};
			$clientvars->{'rttsendtime'} = [gettimeofday];
			$globalvars->{'prevrttsendtime'} = $clientvars->{'rttsendtime'};
			$res = syswrite($desc, $currbyte);
			$errval = $!;
			$currbyte = chr((ord($currbyte) + 1) % 256);
			my $currsec = int time;
			$globalvars->{packetrate}->{total}++;
			if (defined $rttrateinterval) {
			    $globalvars->{packetrate}->{$currsec}++;
			}
		    } else {
			die "$app: unexpected type: $type";
		    }
		    if (!defined $res or $res == 0) {
			if (!defined $res) {
			    $! = $errval;
			    warn "$pnow: connection error: $!\n";
			    connerr($globalvars, $errval);
			    logvals($globalvars, undef, $now, "logerr");
			} else {
			    die "syswrite: zero return value";
			}
			die "$app: no fileno" unless defined $desc->fileno;
			$errdesc->{$fileno} = $desc;
		    } else {
			#update io stats
			$clientvars->{'wrotebytes'} += $res;
		    }
		}
	    }
	    #handle readable descriptors
	    for my $desc (@{ $rfds }) {
		my $fileno = $desc->fileno;
		next if exists $errh->{$fileno};
		my $clientvars = $connvars->{$fileno};
		die "$app: no clientvars" unless defined $clientvars;
		if ($clientvars->{'state'} eq 'socksneg') {
		    push @socksio, $fileno;
		} elsif ($clientvars->{'state'} eq 'active' or
			 $clientvars->{'state'} eq 'connecting') {
#		    warn "$pnow: readable\n";
		    my $buf;
		    my $res = sysread($desc, $buf, $RSIZE);
		    my $errval = $!;
		    if (!defined $res) {
			$! = $errval;
			warn "$pnow: read failure (desc: $fileno): $!\n";
			connerr($globalvars, $errval);
			logvals($globalvars, undef, $now, "connerrs");
			die "$app: no fileno" unless defined $desc->fileno;
			$errdesc->{$fileno} = $desc;
		    } elsif ($res == 0) {
			warn "$pnow: EOF (desc: $fileno)\n";
#			$globalvars->{'errors'}->{'PEERCLOSEDCONN'}++;
#			$globalvars->{'connerrs'}++;
#			logvals($globalvars, undef, $now, "connerrs");
			die "$app: no fileno" unless defined $desc->fileno;
			$errdesc->{$fileno} = $desc;
		    } else {
			if ($clientvars->{'state'} eq 'connecting') {
			    #only expect error if state is connecting
			    die "$app: unexpected 'connecting' state";
			}
			#update io stats
			$clientvars->{'readbytes'} += $res;

			if ($type eq "rtt" or $type eq "connectbyte") {
			    die "$app: unexpected reply size: $buf" unless $res == 1;
			    vset($clientvars, 'rttsendtime');
			    $clientvars->{'rttrecvtime'} = $selecttime;
			    my $dur = tv_interval($clientvars->{'rttsendtime'}, $selecttime);
			    die "$app: invalid rtt: $dur" if $dur <= 0;
			    push @{ $clientvars->{'rttvals'} }, $dur;
			    push @{ $globalvars->{'rttvals'} }, $dur;
			    if ($type eq "connectbyte") {
				logvals($globalvars, $clientvars, $now, "logconnbyte");
				#got byte, close socket
				connclose($desc, \@conns, $connvars, $globalvars);
				warn "$pnow: connectbyte: got byte, closing\n" if $VERBOSE;
			    }
			    $clientvars->{'prevrttsendtime'} =
				$clientvars->{'rttsendtime'};
			    delete $clientvars->{'rttsendtime'};
			}
		    }
		} else {
		    die "$app: unexpected state: $clientvars->{'state'}";
		}
	    }
	    #handle writeable descriptors (connecting only)
	    for my $desc (@{ $wfds }) {
		my $fileno = $desc->fileno;
		die "$app: no fileno" unless defined $fileno;
		my $clientvars = $connvars->{$fileno};
		die "$app: no clientvars" unless defined $clientvars;
		next if exists $errh->{$fileno};
		if ($clientvars->{'state'} eq 'connecting') {
		    my $errval = $desc->sockopt(SO_ERROR);
		    #XXX sometimes invalid value, if descriptor not valid?
		    $errval = 0 unless $errval =~ /^\d+$/;
		    if ($desc->connected) {
			vset($clientvars, 'connectstart');
			$clientvars->{'connectend'} = $selecttime;
			my $dur = tv_interval($clientvars->{'connectstart'},
					      $clientvars->{'connectend'});
			push @{ $globalvars->{'conntimevals'} }, $dur;
			logvals($globalvars, $clientvars, $now, "logconn");
			if ($type eq 'connect' and !defined $socksserver) {
			    #connected, close socket
			    connclose($desc, \@conns, $connvars, $globalvars);
			    next;
			}
			if (defined $socksserver) {
			    $globalvars->{'socksokconncount'}++;
			    $clientvars->{'state'} = 'socksneg';
			    die "$app: undef b" unless defined $conns[$fileno];
			    $clientvars->{'socksnegstart'} = [gettimeofday];
			    socksreq($globalvars, $pnow, $conns[$fileno], $clientvars, $host, $port);
			} else {
			    $globalvars->{'targetokconncount'}++;
			    warn "$pnow: connected (${dur}s) (desc: $fileno)\n" if $VERBOSE;
			    $globalvars->{'active'}++;
			    $clientvars->{'state'} = 'active';
			    logvals($globalvars, undef, $now, "logact", "+");
			    if ($type eq "connectsec") {
				push @{ $globalvars->{'connsecconns'} }, [$desc, $selecttime];
			    }
			    logvals($globalvars, $clientvars, $now, "logconn2");
			}
		    } else {
			if ($errval == 0) {
			    my $buf;
			    #connect() likely failed; read() to get errno
			    my $res = sysread $desc, $buf, 1;
			    $errval = $!;
			}
			connerr($globalvars, $errval);
			$! = $errval;
			warn "$pnow: connect error: (desc: $fileno) $!\n";
			logvals($globalvars, undef, $now, "logerr");
			$errdesc->{$fileno} = $desc;
		    }
		}
	    }
	    #handle socks negotiation
	    for my $fileno (@socksio) {
		next if exists $errh->{$fileno};
		next if exists $errdesc->{$fileno};
		my $clientvars = $connvars->{$fileno};
		die "$app: no clientvars" unless defined $clientvars;
		my $desc = $conns[$fileno];
		die "$app: undef conns desc (desc: $fileno)" unless defined $desc;
		socksreq($globalvars, $pnow, $desc, $clientvars, $host, $port);
		if ($clientvars->{'socksneg'}->{'state'} eq 'done') {
		    #socks negotiation complete
		    $globalvars->{'targetokconncount'}++;
		    vset($clientvars, 'connectstart');
		    vset($clientvars, 'connectend');
		    vset($clientvars, 'socksnegstart');
		    my $t1 = [gettimeofday];
		    $clientvars->{'socksnegend'} = $t1;
		    my $conndur = tv_interval($clientvars->{'connectstart'},
					      $clientvars->{'connectend'});
		    my $socksdur = tv_interval($clientvars->{'socksnegstart'},
					       $clientvars->{'socksnegend'});
		    warn "$pnow: connected (${conndur}/${socksdur}s) (desc: $fileno)\n" if $VERBOSE;
		    push @{ $globalvars->{'socksnegtimes'} }, $socksdur;
		    logvals($globalvars, $clientvars, $now, "logconn");
		    if ($type eq 'connect') {
			#connected, close socket
			warn "$pnow: socksneg done, ending connect socket\n" if $VERBOSE;
			connclose($desc, \@conns, $connvars, $globalvars);
			next;
		    }
		    $globalvars->{'active'}++;
		    $clientvars->{'state'} = 'active';
		    logvals($globalvars, undef, $now, "logact", "+");
		    if ($type eq "connectsec") {
			push @{ $globalvars->{'connsecconns'} }, [$desc, $t1];
		    }
		    logvals($globalvars, $clientvars, $now, "logconn2");
		} elsif ($clientvars->{'socksneg'}->{'state'} eq 'error') {
		    $errdesc->{$fileno} = $desc;
		}
	    }

	    #close failed connections
	    for my $fileno (keys %$errdesc) {
		my $desc = $errdesc->{$fileno};
		connclose($desc, \@conns, $connvars, $globalvars);
	    }
	}
#    print "active: $globalvars->{'active'}\n";
#    last if ($globalvars->{'active'} > 10);
    }

    #close all connections
    my @opendescs = @conns;
    for my $desc (@opendescs) {
	next unless defined $desc;
	connclose($desc, \@conns, $connvars, $globalvars);
    }
    my $now = time;
    warn "$now: [proc $procid]: terminating\n" if $VERBOSE;
#    logvals($globalvars, undef, $now, "logact", "0");

    logclose($globalvars);

    my $testdur = sprintf "%0.2f", ($now - $globalvars->{'starttime'});
    print "[proc $procid]: $type type client ($specid), runtime ${testdur}s, $globalvars->{conncount}/$maxconn connection(s) attempted opened\n";
    if ($maxconn > 1) {
	my $pcps = sprintf "%0.2f", $connspersec;
	print "[proc $procid]: (requested connect rate of $pcps conns/sec)\n";
    }
    if (defined $socksserver) {
	print "[proc $procid]: connections made using SOCKS server $socksserver:$socksport\n";
    } else {
	print "[proc $procid]: connections made directly\n";
    }
    my $okprc = 100 * ($globalvars->{'targetokconncount'} / $globalvars->{'conncount'});
    $okprc = sprintf "%0.2f", $okprc;
    my $failprc = 100 * ($globalvars->{'connerrs'} / $globalvars->{'conncount'});
    $failprc = sprintf "%0.2f", $failprc;
    print "[proc $procid]: $globalvars->{'conncount'} connect requests, $globalvars->{'targetokconncount'} to target succeeded ($okprc%), $globalvars->{'connerrs'} failures ($failprc%)\n";
    if (defined $socksserver) {
	my $sfailprc = 100 * ($globalvars->{'socksokconncount'} / $globalvars->{'conncount'});
	$sfailprc = sprintf "%0.2f", $sfailprc;
	print "[proc $procid]: $globalvars->{'socksokconncount'} requests to socks server succeeded ($sfailprc%)\n";
    }
    if ($globalvars->{'connerrs'}) {
	print "[proc $procid]: failure overview:\n";
	my $e = $globalvars->{'errors'};
	for my $key (sort { $e->{$b} <=> $e->{$a} } keys %$e) {
	    print "[proc $procid]:  $key: $e->{$key}\n";
	    last if $e->{$key} == 0;
	}
    }

    if (exists $globalvars->{packetrate}->{total} and $DURATION > 0) {
	my $totrate = $globalvars->{packetrate}->{total} / $DURATION;
	delete $globalvars->{packetrate}->{total};
	printf "[proc $procid]: average send rate: %0.3f/sends per second\n", $totrate;
	printf "[proc $procid]: (requested rate: %0.3f/sends per second for process)\n", $procrttrate;
	#XXX measure more correctly
	printf "[proc $procid]: (estimated total send/receive rate: %0.3f/packets per second for process)\n", $totrate * 2;

	if ($VERBOSE) {
	    warn "[proc $procid]: send rates:\n";
	    for my $sec (sort { $a <=> $b } keys %{ $globalvars->{packetrate} }) {
		warn "[proc $procid]: $sec\t$globalvars->{packetrate}->{$sec}\n";
	    }
	}
	my $file = "log-${procid}-rtt-avgsendrate.dat";
	open(RATE, ">$file") or die "$app: error: open: $file: $!\n";
	print RATE "$totrate\n";
	close RATE;
    }
}

sub loginit {
    my $globalvars = shift @_;

    my @meta = (['key', 'string', "$globalvars->{'key'}"],
		['clienttype', 'string', "$globalvars->{'clienttype'}"],
		['hostname', 'string', "$globalvars->{'hostname'}"],
		['app', 'string', "multiclient"],
		['starttime', 'epoch', "$globalvars->{'starttime'}"],
		['id', 'string', "$globalvars->{'specid'}"]);
    my $specid = $globalvars->{'specid'};
    my $type = $globalvars->{'type'};
    my $procid = $globalvars->{'procid'};
    if ($LOGFORMAT) {
	if (exists $globalvars->{'logtypes'}->{'logbw'}) {
	    $globalvars->{'logbw'} =
		openlog("$specid-$type-bw-${procid}",
			[['time', 'epoch'],
			 ['clientid', 'integer'],
			 ['readbytes', 'bytes'],
			 ['wrotebytes', 'bytes']],
			[@meta, ['datatype', 'string', 'bw']]);
	}

	if (exists $globalvars->{'logtypes'}->{'logrtt'}) {
	    $globalvars->{'logrtt'} =
		openlog("$specid-$type-rtt-${procid}",
			[['time', 'epoch'],
			 ['clientid', 'integer'],
			 ['med', 'seconds'],
			 ['avg', 'seconds'],
			 ['stddev', '-'],
			 ['min', 'seconds'],
			 ['max', 'seconds']],
			[@meta, ['datatype', 'string', 'conn']]);
	}
	if (exists $globalvars->{'logtypes'}->{'logconn'}) {
	    $globalvars->{'logconn'} =
		openlog("$specid-$type-conn-${procid}",
			[['time', 'epoch'],
			 ['clientid', 'integer'],
			 ['conntime', 'seconds']],
			[@meta, ['datatype', 'string', 'conn']]);
	}
    
	if (exists $globalvars->{'logtypes'}->{'logconnbyte'}) {
	    $globalvars->{'logconnbyte'} =
		openlog("$specid-$type-conn-${procid}",
			[['time', 'epoch'],
			 ['clientid', 'integer'],
			 ['bytertt', 'seconds'],
			 ['conntime', 'seconds']],
			[@meta, ['datatype', 'string', 'conn']]);
	}
    }

    my $dat;
    if (exists $globalvars->{'logtypes'}->{'logbw'}) {
	$dat = "log-$specid-$type-bw-${procid}.dat";
	open(LOGBW, ">$dat") or die "$app: error: $dat: $!\n";
    }
    if (exists $globalvars->{'logtypes'}->{'logconn'}) {
	$dat = "log-$specid-$type-conn-${procid}.dat";
	open(LOGCONN, ">$dat") or die "$app: error: $dat: $!\n";
	$dat = "log-$specid-$type-conn2-${procid}.dat";
	open(LOGCONN2, ">$dat") or die "$app: error: $dat: $!\n";
	$dat = "log-$specid-$type-connavg-${procid}.dat";
	open(LOGCONNAVG, ">$dat") or die "$app: error: $dat: $!\n";
    }
    if (exists $globalvars->{'logtypes'}->{'logconnbyte'}) {
	$dat = "log-$specid-$type-connbyte-${procid}.dat";
	open(LOGCONNBYTE, ">$dat") or die "$app: error: $dat: $!\n";
    }
    if (exists $globalvars->{'logtypes'}->{'logerr'}) {
	$dat = "log-$specid-$type-err-${procid}.dat";
	open(LOGERR, ">$dat") or die "$app: error: $dat: $!\n";
    }
    if (exists $globalvars->{'logtypes'}->{'logrtt'}) {
	$dat = "log-$specid-$type-rtt-${procid}.dat";
	open(LOGRTT, ">$dat") or die "$app: error: $dat: $!\n";
    }
    if (exists $globalvars->{'logtypes'}->{'logact'}) {
	$dat = "log-$specid-$type-active-${procid}.dat";
	open(LOGACT, ">$dat") or die "$app: error: $dat: $!\n";
    }
}

sub logvals {
    my $globalvars = shift @_;
    my $clientvars = shift @_;
    my $now = shift @_;
    my $type = shift @_;
    my $arg = shift @_; #optional argument

    #skip unless logging value
    return unless exists $globalvars->{'logtypes'}->{$type};

    my $pre = "$now $globalvars->{'key'}";
    if ($type eq "logact") {
	print LOGACT "$pre 0 $arg\n";
    } elsif ($type eq "logbw") {
	print LOGBW "$pre $clientvars->{'fileno'} $clientvars->{'readbytes'} $clientvars->{'wrotebytes'}\n";
	logcsv($globalvars->{'logbw'}, {
	    'time' => "$now",
	    'clientid' => "$clientvars->{'clientid'}",
	    'readbytes' => "$clientvars->{'readbytes'}",
	    'wrotebytes' => "$clientvars->{'wrotebytes'}"});
    } elsif ($type eq "logerr") {
        print LOGERR "$pre 1 $globalvars->{'connerrs'}\n";
    } elsif ($type eq "logrtt") {
	#XXX overwrite each at each invocation (+at normal exit)
	if (exists $globalvars->{packetrate}->{total}) {
	    my $tdiff = time - $globalvars->{starttime};
	    if ($tdiff > 0) {
		my $totrate = $globalvars->{packetrate}->{total} / $tdiff;
		my $file = "log-${procid}-rtt-avgsendrate.dat";
		open(RATE, ">$file") or die "$app: error: open: $file: $!\n";
		print RATE "$totrate\n";
		close RATE;
	    }
	}

	if (exists $clientvars->{'rttvals'}) {
	    my $rttvals = $clientvars->{'rttvals'};
	    my $medval = sprintf("%f", med($rttvals));
	    my $avgval = sprintf("%f", avg($rttvals));
	    my $stddevval = sprintf("%f", stddev($rttvals));
	    my $minval = sprintf("%f", min($rttvals));
	    my $maxval = sprintf("%f", max($rttvals));
	    printf LOGRTT "$pre $clientvars->{'fileno'} $medval $avgval $stddevval $minval $maxval\n";

	    logcsv($globalvars->{'logrtt'}, {
		'time' => "$now",
		'clientid' => "$clientvars->{'clientid'}",
		'med' => "$medval",
		'avg' => "$avgval",
		'stddev' => "$stddevval",
		'min' => "$minval",
		'max' => "$maxval"});
	}
    } elsif ($type eq "logconn") {
	my $dur = tv_interval($clientvars->{'connectstart'},
			      $clientvars->{'connectend'});
	print LOGCONN "$pre 0 $dur\n";
	logcsv($globalvars->{'logconn'}, {
	    'time' => "$now",
	    'clientid' => "$clientvars->{'clientid'}",
	    'conntime' => "$dur" });
    } elsif ($type eq "logconn2") {
	my $t1 = tv2sec($clientvars->{'connectstart'});
	my $t2 = tv2sec($clientvars->{'connectend'});
	print LOGCONN2 "$pre 0 $t1 $t2 $clientvars->{'sockname'} $clientvars->{'peername'}\n";
    } elsif ($type eq "logconnavg") {
	printf LOGCONNAVG "$pre 0 %f\n", med($globalvars->{'conntimevals'});
    } elsif ($type eq "logconnbyte") {
	my $conndur = tv_interval($clientvars->{'connectstart'},
				  $clientvars->{'connectend'});
	my $socksdur = 0;
	if (exists $clientvars->{'socksneg'}) {
	    $socksdur = tv_interval($clientvars->{'socksnegstart'},
				    $clientvars->{'socksnegend'});
	}
	my $bytertt = tv_interval($clientvars->{'rttsendtime'},
				  $clientvars->{'rttrecvtime'});
	my $totdur = $conndur + $socksdur + $bytertt;

	print LOGCONNBYTE "$pre 0 $totdur $bytertt\n";

	logcsv($globalvars->{'logconnbyte'}, {
	    'time' => "$now",
	    'clientid' => "$clientvars->{'clientid'}",
	    'conntime' => "$totdur",
	    'sockstime' => "$socksdur",
	    'bytertt' => "$bytertt"});
    }
}

sub logclose {
    my $globalvars = shift @_;

    if ($LOGFORMAT) {
	if (exists $globalvars->{'logtypes'}->{'logbw'}) {
	    closelog($globalvars->{'logbw'});
	}
	if (exists $globalvars->{'logtypes'}->{'logconn'}) {
	    closelog($globalvars->{'logconn'});
	}
	if (exists $globalvars->{'logtypes'}->{'logconnbyte'}) {
	    closelog($globalvars->{'logconnbyte'});
	}
    }
    if (exists $globalvars->{'logtypes'}->{'logbw'}) {
	close(LOGBW);
    }
    if (exists $globalvars->{'logtypes'}->{'logconn'}) {
	close(LOGCONN);
    }
    if (exists $globalvars->{'logtypes'}->{'logconnbyte'}) {
	close(LOGCONNBYTE);
    }

    if (exists $globalvars->{'logtypes'}->{'logconnavg'}) {
	close(LOGCONNAVG);
    }
    if (exists $globalvars->{'logtypes'}->{'logerr'}) {
	close(LOGERR);
    }
    if (exists $globalvars->{'logtypes'}->{'logrtt'}) {
	close(LOGRTT);
    }
    if (exists $globalvars->{'logtypes'}->{'logact'}) {
	close(LOGACT);
    }
}

sub globalvarinit {
    my $globalvars = shift @_;

    $globalvars->{'errors'} = {};
    for my $err (qw(ECONNABORTED ECONNREFUSED ECONNRESET EHOSTDOWN EHOSTUNREACH
                    ENETDOWN ENETRESET ENETUNREACH ENOBUFS ETIMEDOUT)) {
	$globalvars->{'errors'}->{$err} = 0;
    }
    $globalvars->{'active'} = 0;
    $globalvars->{'othererrs'} = 0;
#    $globalvars->{'conntimevals'} = ();
}

sub connerr {
    my $globalvars = shift @_;
    my $errno = shift @_;

    $! = $errno;
    $globalvars->{'errors'}->{'ECONNABORTED'}++ if $!{ECONNABORTED};
    $globalvars->{'errors'}->{'ECONNREFUSED'}++ if $!{ECONNREFUSED};
    $globalvars->{'errors'}->{'ECONNRESET'}++   if $!{ECONNRESET};
    $globalvars->{'errors'}->{'EHOSTDOWN'}++    if $!{EHOSTDOWN};
    $globalvars->{'errors'}->{'EHOSTUNREACH'}++ if $!{EHOSTUNREACH};
    $globalvars->{'errors'}->{'ENETDOWN'}++     if $!{ENETDOWN};
    $globalvars->{'errors'}->{'ENETRESET'}++    if $!{ENETRESET};
    $globalvars->{'errors'}->{'ENETUNREACH'}++  if $!{ENETUNREACH};
    $globalvars->{'errors'}->{'ENOBUFS'}++      if $!{ENOBUFS};
    $globalvars->{'errors'}->{'ETIMEDOUT'}++    if $!{ETIMEDOUT};

    $globalvars->{'connerrs'}++; #XXXold
}

sub clientvarinit {
    my $connvars = shift @_;
    my $fileno = shift @_;
    my $clientid = shift @_;
    my $connstart = shift @_;

    my $clientvars = {};

#    $clientvars->{'rttvals'} = [];
    $clientvars->{'wrotebytes'} = 0;
    $clientvars->{'readbytes'} = 0;
    $clientvars->{'fileno'} = $fileno;
    $clientvars->{'clientid'} = $clientid;
    $clientvars->{'connectstart'} = $connstart;

    die "$app: fileno $fileno already exists in connvars" if exists $connvars->{$fileno};
    $connvars->{$fileno} = $clientvars;
}

sub connclose {
    my $desc = shift @_;
    my $conns = shift @_;
    my $connvars = shift @_;
    my $globalvars = shift @_;

    die "$app: undefined descriptor" unless defined $desc;

    my $fileno = $desc->fileno;
    if (defined $fileno) {
	my $clientvars = $connvars->{$fileno};
	die "$app: no clientvars" unless defined $clientvars;
	if (defined $clientvars->{'state'} and
	    $clientvars->{'state'} eq 'active') {
	    $globalvars->{'active'}--;
	    my $now = time;
	    logvals($globalvars, undef, $now, "logact", "-");
	}
	delete $connvars->{$fileno};
	undef @{ $conns }[$fileno];
    } else {
	warn "$app: connclose: no fileno for desc\n";
    }
    $desc->close;

    if (exists $globalvars->{'connsecconns'}) {
	for (0 .. $#{ $globalvars->{'connsecconns'} }) {
	    if (${ ${ $globalvars->{'connsecconns'} }[$_] }[0] == $desc) {
		splice @{ $globalvars->{'connsecconns'} }, $_, 1;
		last;
	    }
	}
    }
}

sub selectfds {
    my $rfds = shift @_;
    my $wfds = shift @_;
    my $timeout = shift @_;

    my ($rin, $win, $ein);
    my ($rout, $wout, $eout);
    $rin = $win = $ein = '';
    my $fdh = {};
    my @efds;
    for my $desc (@{ $rfds }) {
	vec($rin, $desc->fileno, 1) = 1;
	push @efds, $desc unless exists $fdh->{$desc->fileno};
	$fdh->{$desc} = 1;
    }
    for my $desc (@{ $wfds }) {
	vec($win, $desc->fileno, 1) = 1;
	push @efds, $desc unless exists $fdh->{$desc->fileno};
	$fdh->{$desc->fileno} = 1;
    }
    $ein = $rin | $win;
    my (@rlist, @wlist, @elist);
    my ($n, $timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
    if ($n == -1) {
	warn "$app: select: $!\n" unless $! == EINTR;
	return -1;
    } elsif ($n == 0) {
	return 0;
    } else {
	for my $desc (@{ $rfds }) {
	    if (vec($rout, $desc->fileno, 1)) {
		push @rlist, $desc;
	    }
	}
	for my $desc (@{ $wfds }) {
	    if (vec($wout, $desc->fileno, 1)) {
		push @wlist, $desc;
	    }
	}
	for my $desc (@efds) {
	    if (vec($eout, $desc->fileno, 1)) {
		push @elist, $desc;
	    }
	}
    }
    return ($n, [@rlist], [@wlist], [@elist]);
}

#calculate median value of array
sub med {
    my @vals = sort { $a <=> $b } @{ shift @_ };

    die "$app: no values specified" if ($#vals == -1);
    return $vals[0] if ($#vals == 0);
    return ($vals[0] + $vals[1])/2 if $#vals == 1;
    my $mid = int $#vals/2;
    return $vals[$mid] if ($#vals % 2 == 0);
    return ($vals[$mid] + $vals[$mid + 1])/2;
}

#calculate average value of array
sub avg {
    my @vals = @{ shift @_ };

    die "$app: no values specified" if ($#vals == -1);

    my $sum = 0;
    for (@vals) {
	$sum += $_;
    }
    return $sum/($#vals + 1);
}

#calculate std. dev of values in array
sub stddev {
    my @vals = @{ shift @_ };

    my $avg = avg(\@vals);

    my @vals2;
    for (@vals) {
	push @vals2, ($_ - $avg) ** 2;
    }

    my $avg2 = avg(\@vals2);
    return sqrt $avg2;
}

#return lowest value
sub min {
    my @vals = @{ shift @_ };

    my @sort = sort { $a <=> $b } @vals;

    return $sort[0];
}

#return highest value
sub max {
    my @vals = @{ shift @_ };

    my @sort = sort { $a <=> $b } @vals;

    return $sort[$#sort];
}

sub socksreq {
    my $globalvars = shift @_;
    my $pnow = shift @_;
    my $sock = shift @_;
    my $clientvars = shift @_;
    my $hostval = shift @_;
    my $port = shift @_;

    if (!defined $clientvars->{'socksneg'}) {
	$clientvars->{'socksneg'} = {};
    }
    my $socksstate = $clientvars->{'socksneg'};
    my $state = $socksstate->{'state'};
    warn "$pnow: socks TCP connect request for $hostval:$port\n" if $VERBOSE and !defined $state;

    my ($user, $pass, $host);
    if ($hostval =~ /^([^;]+);([^\@]+)\@(.*)$/) {
	($user, $pass, $host) = ($1, $2, $3);
#	warn "$pnow: user: $user, pass: $pass\n";
    } else {
	$host = $hostval;
#	warn "$pnow: host: $host\n";
    }

    die "$app: socksreq: invalid socket" unless defined $sock;

    #first send method list
    if (!defined $state) {
#	warn "$pnow: socksreq to $host:$port";
	my $method;
	if (defined $user) {
	    $method = 2; #username/password
	} else {
	    $method = 0; #none
	}
	my ($res, $errval) = socks_v5_methodreq($sock,
						{ 'vn' => 5,
						  'nmethods' => 1,
						  'methods' => [$method]});
	if (!defined $res) {
	    connerr($globalvars, $errval);
	    $! = $errval;
	    warn "$pnow: socks 5 method request failed: $!\n" if $VERBOSE;
	    $socksstate->{'state'} = 'error';
	    return;
	} elsif ($res == 0) {
	    $globalvars->{'errors'}->{'SOCKS5METHODSENDFAIL'}++;
	    warn "$pnow: socks 5 method request failed: syswrite failure\n" if $VERBOSE;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	    return;
	} else {
	    $socksstate->{'state'} = 'methodrep';
	    $socksstate->{'wantop'} = 'read';
	    return;
	}
    } elsif ($state eq 'methodrep') {
	#get method reply
	my ($res, $errval, $rep) = socks_v5_methodrep($sock);
	if (!defined $res) {
	    connerr($globalvars, $errval);
	    $! = $errval;
	    warn "$pnow: socks 5 method request failed: $!\n" if $VERBOSE;
	    $socksstate->{'state'} = 'error';
	    return;
	} elsif ($res == 0) {
	    #connection closed during socks negotiation
	    $globalvars->{'errors'}->{'SOCKS5METHODREADFAIL'}++;
	    warn "$pnow: socks 5 method request failed: short read" if $VERBOSE;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	    return;
	}

	if ($rep->{'method'} == 0) {
	    if (defined $user) {
		die "$app: username authentication expected but not returned";
	    }

	    #proceed to command request
	    $socksstate->{'state'} = 'cmdreq';
	    $socksstate->{'wantop'} = 'write';
	    return;
	} elsif ($rep->{'method'} == 2) {
	    if (!defined $user) {
		die "$app: username authentication unexpected";
	    }

	    #proceed to command request
	    $socksstate->{'state'} = 'methodneg';
	    $socksstate->{'wantop'} = 'write';
	    return;
	} elsif ($rep->{'method'} == 0xff) {
	    #no provided method accepted
	    $globalvars->{'errors'}->{'SOCKS5BADMETHOD'}++;
	    warn "$pnow: socks 5 method request failed: no method accepted\n" if $VERBOSE;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	    return;
	} else {
	    die "$app: got unsupported method $rep->{'method'}";
	}
    } elsif ($state eq 'methodneg') {
	my ($res, $errval) = socks_v5_methodneg($sock,
						{ 'ver' => 1,
						  'ulen' => length($user),
						  'uname' => $user,
						  'plen' => length($pass),
						  'passwd' => $pass});
	if (!defined $res) {
	    connerr($globalvars, $errval);
	    $! = $errval;
	    warn "$pnow: socks 5 method request failed: $!\n" if $VERBOSE;
	    $socksstate->{'state'} = 'error';
	} elsif ($res == 0) {
	    $globalvars->{'errors'}->{'SOCKS5METHODNEGSENDFAIL'}++;
	    warn "$pnow: socks 5 method request failed: syswrite failure\n" if $VERBOSE;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	} else {
	    $socksstate->{'state'} = 'methodnegrep';
	    $socksstate->{'wantop'} = 'read';
	}
	return;
    } elsif ($state eq 'methodnegrep') {
	#get reply
	my ($res, $errval, $rep) = socks_v5_methodnegrep($sock);
	if (!defined $res) {
	    connerr($globalvars, $errval);
	    $! = $errval;
	    warn "$pnow: socks 5 method request failed: $!\n" if $VERBOSE;
	    $socksstate->{'state'} = 'error';
	} elsif ($res == 0) {
	    $globalvars->{'errors'}->{'SOCKS5REQNEGREADFAIL'}++;
	    warn "$pnow: socks 5 method request failed: short read" if $VERBOSE;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	}

	if ($rep->{'status'} != 0) {
	    warn "$pnow: socks 5 password authentication to $host:$port failed\n";
	    $globalvars->{'errors'}->{'SOCKS5METHODSTATUSFAIL'}++;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	}
	warn "$pnow: authentication successful for $hostval:$port";

	#proceed to command request
	$socksstate->{'state'} = 'cmdreq';
	$socksstate->{'wantop'} = 'write';
	return;
    } elsif ($state eq 'cmdreq') {
	#determine address type
	my $atyp;
	if ($host =~ /^\d+\.\d+\.\d+\.\d+$/) {
	    $atyp = 1;
	} elsif ($host =~ /\w/) {
	    $atyp = 3;
	} elsif ($host =~ /:/) {
	    $atyp = 4;
	} else {
	    die "$app: cannot guess address format: $host";
	}

	#send socks connect request
	my ($res, $errval) = socks_v5_cmdreq($sock,
					     { 'vn' => 5,
					       'cd' => 1,
					       'rsv' => 0,
					       'atyp' => $atyp,
					       'dstip' => $host,
					       'dstport' => $port});
	if (!defined $res) {
	    connerr($globalvars, $errval);
	    $! = $errval;
	    warn "$pnow: socks 5 method request failed: $!\n" if $VERBOSE;
	    $socksstate->{'state'} = 'error';
	} elsif ($res == 0) {
	    $globalvars->{'errors'}->{'SOCKS5CMDREQSENDFAIL'}++;
	    warn "$pnow: socks 5 method request failed: syswrite failure\n" if $VERBOSE;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	} else {
	    $socksstate->{'state'} = 'cmdrep';
	    $socksstate->{'wantop'} = 'read';
	}
	return;
    } elsif ($state eq 'cmdrep') {
	#read response
	my ($res, $errval, $rep) = socks_v5_cmdrep($sock);
	if (!defined $res) {
	    connerr($globalvars, $errval);
	    $! = $errval;
	    warn "$pnow: socks 5 method request failed: $!\n" if $VERBOSE;
	    $socksstate->{'state'} = 'error';
	} elsif ($res == 0) {
	    $globalvars->{'errors'}->{'SOCKS5CMDREADFAIL'}++;
	    warn "$pnow: socks 5 method request failed: short read" if $VERBOSE;
	    $globalvars->{'connerrs'}++;
	    $socksstate->{'state'} = 'error';
	} else {
	    if ($rep->{'rep'} != 0) {
		my $code = v5err2code($rep->{'rep'});
		warn "$pnow: socks 5 method request failed: $code\n" if $VERBOSE;
		$globalvars->{'errors'}->{$code}++;
		$globalvars->{'connerrs'}++;
		$socksstate->{'state'} = 'error';
	    } else {
		$socksstate->{'state'} = 'done';
		warn "$pnow: socks negotiation complete\n" if $VERBOSE;
	    }
	}
	return;
    } else {
	die "$app: unexpected state: $state";
    }
}

sub socks_v5_methodreq {
    my $sock = shift;
    my $vars = shift;

    for my $opt (qw(vn nmethods methods)) {
        defined $vars->{$opt} or die "$app: socks_v5_methodreq: $opt missing";
    }

    #VER | NMETHODS | METHODS
    my $header = "";
    $header .= pack("CC", $vars->{'vn'}, $vars->{'nmethods'});
    for my $method (@{ $vars->{'methods'} }) {
        $header .= pack("C", $method);
    }

#    print "Sending request: " . bin2txt($header) . "\n";
    my $r = syswrite($sock, $header);
    my $errval = $!;
    return ($r, $errval);
}

sub socks_v5_methodrep {
    my $sock = shift;

    my $rep;
    my $r = sysread($sock, $rep, 2);
    my $errval = $!;
    if (!defined $r or $r == 0) {
	return ($r, $errval);
    }

    my ($vn, $method) = unpack("CC", $rep);
    my $res = { 'vn' => $vn, 'method' => $method };
    return ($r, 0, $res);
}

sub socks_v5_methodneg {
    my $sock = shift;
    my $vars = shift;

    for my $opt (qw(ver ulen uname plen passwd)) {
        defined $vars->{$opt} or die "$app: socks_v5_methodneg: $opt missing";
    }

    #VER | ULEN | UNAME | PLEN | PASSWD
    my $header = "";
    $header .= pack("CC", $vars->{'ver'}, $vars->{'ulen'});
    $header .= $vars->{'uname'};
    $header .= pack("C", $vars->{'plen'});
    $header .= $vars->{'passwd'};

#    print "Sending request: " . bin2txt($header) . "\n";
    my $r = syswrite($sock, $header);
    my $errval = $!;
    return ($r, $errval);
}

sub socks_v5_methodnegrep {
    my $sock = shift;

    my $rep;
    my $r = sysread($sock, $rep, 2);
    my $errval = $!;
    if (!defined $r or $r == 0) {
	return ($r, $errval);
    }

    my ($ver, $status) = unpack("CC", $rep);
    my $res = { 'ver' => $ver, 'status' => $status };
    return ($r, 0, $res);
}

sub socks_v5_cmdreq {
    my $sock = shift;
    my $vars = shift;

    for my $opt (qw(vn cd rsv atyp dstip dstport)) {
        defined $vars->{$opt} or die "$app: req_rep_v5: $opt missing";
    }

    #VER | CMD |  RSV  | ATYP | DST.ADDR | DST.PORT
    my $header = "";
    $header .= pack("CCCC", $vars->{'vn'}, $vars->{'cd'}, $vars->{'rsv'}, $vars->{'atyp'});
    if ($vars->{'atyp'} == 1) {
	my $ip = $vars->{'dstip'};
	die "$app: invalid ipv4 address: $ip" unless $ip =~ /^\d+\.\d+\.\d+\.\d+$/;
        $header .= inet_aton($ip);
    } elsif ($vars->{'atyp'} == 3) {
	my $name = $vars->{'dstip'};;
	die "$app: invalid domain name: $name" unless $name =~ /\w/;
        my $len = length($name);
        die "$app: name too long: $name" if $len > 255;
        $header .= pack("C", $len);
        $header .= $name;
    } elsif ($vars->{'atyp'} == 4) {
	my $ip = $vars->{'dstip'};
	die "$app: invalid ipv6 address: $ip" unless $ip =~ /:/;
        die "$app: ipv6 not supported";
    } else {
        die "$app: can't guess address format";
    }

    $header .= pack("n", $vars->{'dstport'});

    my $r = syswrite $sock, $header;
    my $errval = $!;
    return ($r, $errval);
}

sub socks_v5_cmdrep {
    my $sock = shift;

    my $rep;
    my $r = sysread($sock, $rep, 4);
    my $errval = $!;
    if (!defined $r or $r == 0) {
	return ($r, $errval);
    }

    my ($vn, $servrep, $rsv, $atyp) = unpack("CCCC", $rep);

    #XXX multiple reads
    my $bndaddr;
    if ($atyp == 1) {
	$r = sysread($sock, $rep, 4);
	$errval = $!;
	if (!defined $r or $r == 0) {
	    return ($r, $errval);
	}
	$bndaddr = inet_ntoa($rep);
    } elsif ($atyp == 3) {
	#len in first octet
	die "$app: unsupported address type $atyp";
    } elsif ($atyp == 4) {
	die "$app: unsupported address type $atyp";
    } else { die "$app: unexpected address type $atyp"};

    $r = sysread($sock, $rep, 2);
    $errval = $!;
    if (!defined $r or $r == 0) {
	return ($r, $errval);
    }

    my ($bndport) = unpack("n", $rep);
    my $res = { 'vn' => $vn, 'rep' => $servrep, 'rsv' => $rsv, 'atyp' => $atyp,
		'dstip' => $bndaddr, 'dstport' => $bndport };
    return ($r, 0, $res);
}

sub bin2txt {
    my $bin = shift @_;
    my @bytes = unpack("C*", $bin);
    my $s = "";
    for (@bytes) {
        $s .= sprintf "%%%02X", $_;
    }
    return $s;
}

sub openlog {
    my $logname = shift @_;
    my $logspec = shift @_;
    my $meta = shift @_;

    my $filename = "log-${logname}.csv";

    my $logfh = new IO::File "$filename", "w" or die "$app: open: $filename: $!\n";

    #enumarate spec values
    my $logspec2 = {};
    my $cnt = 0;
    my @logvals;
    for my $ent (@{ $logspec }) {
	my ($key, $val) = @{ $ent };
	$logspec2->{$key} = [$cnt, $val];
	$cnt++;
	push @logvals, "$key($val)";
    }
    if (defined $meta) {
	my $mstr = ";meta:";
	for my $ent (@{ $meta }) {
	    my ($key, $type, $val) = @{ $ent };
	    $mstr .= " $key($type)=\'$val\'";
	}
	push @logvals, $mstr;
    }
    my $lh = {};
    $lh->{"_fh"} = $logfh;
    $lh->{"_spec"} = $logspec2;

    my $line = join ",", @logvals;
    print $logfh "#$line\n";

    return $lh;
}

sub logcsv {
    my $lh = shift @_;
    my $vals = shift @_;

    return if !defined $lh;

    my $logspec = $lh->{"_spec"};
    for my $key (keys %$vals) {
	die "$app: logvals value '$key' not in logspec\n" unless
	    exists $logspec->{$key};
    }

    my @logvals;
    for my $ent (sort { ${ $logspec->{$a} }[0] <=>
		        ${ $logspec->{$b} }[0] } keys %$logspec) {
	my ($cnt, $val) = @{ $logspec->{$ent} };
	die "$app: logvals argument missing '$ent'\n" unless exists $vals->{$ent};
	my $v = $vals->{$ent};
	$v = "\"$v\"" if ($v =~ /,/); #quote in case of commas in values
	push @logvals, $v;
    }

    my $logfh = $lh->{"_fh"};
    my $line = join ",", @logvals;
    print $logfh "$line\n";
}

sub closelog {
    my $lh = shift @_;

    return if !defined $lh;

    my $fh = $lh->{"_fh"};
    $fh->close;
    delete $lh->{"_fh"};
    delete $lh->{"_spec"};
}

#die unless value is set in hash
sub vset {
    my $hash = shift @_;
    my $key = shift @_;

    use Carp qw(confess);
    confess "$key not set" unless exists $hash->{$key};
}

#die unless if value is set in hash
sub vunset {
    my $hash = shift @_;
    my $key = shift @_;

    use Carp qw(confess);
    confess "$key set" if exists $hash->{$key};
}

sub sockname {
    my $sock = shift @_;

    my $sockaddr = getsockname($sock) or die "$app: getsockname: $!\n";
    my ($port0, $addr0) = sockaddr_in($sockaddr);
    die "$app: sockaddr_in failure" unless defined $addr0;
    $addr0 = inet_ntoa($addr0);
    die "$app: inet_ntoa failure" unless defined $addr0;
    return "${addr0}.${port0}";
}

sub tv2sec {
    return sprintf "%d.%06d", ${ $_[0] }[0] , ${ $_[0] }[1]
}

sub v5err2code {
    my $code = shift @_;

    my @msg = ('SOCKS5REQOK',
	       'SOCKS5REQGENFAIL',
	       'SOCKS5REQBLOCK',
	       'SOCKS5REQNETUNREACH',
	       'SOCKS5REQHOSTUNREACH',
	       'SOCKS5REQCONNREFUSED',
	       'SOCKS5REQTTLEXP',
	       'SOCKS5REQCMDNOTSUPP',
	       'SOCKS5REQADDRTYPENOTSUPP');
    return $msg[$code] if (defined $msg[$code]);
    return "Unassigned error $code";
}