# @author Donnie Cameron (macnod) # @url https://github.com/macnod/DcServer # @readme http://donnieknows.com/blog/perl-sockets-swimming-thread-pool package SocketsSwimmingThreadPoolClient; use IO::Socket; use Carp; use strict; use warnings; my $retry_time = 30; sub new { # Params: host, port my ($proto, %param)= @_; my $class= ref($proto) || $proto; bless +{%param} => $class; } sub stop_server { shift->query('$self->stop') } sub open_socket { my $self = shift @_; # There is, unfortunately, a complication when using TCP sockets - that being # the amount of time sockets linger after being closed. This TIME_WAIT period # is required to ensure the terminating ACKs (kernel level) are recieved (in # a graceful disconnect) and to allow time for 'wandering duplicates' to # finally arrive. While there are (platform/OS/hardware) methods for getting # rid of / shortening this grace period they aren't recommended (for both # stability and security reasons). # Thus you have the issue that, very occasionally and somewhat based upon the # current turnover rate of TCP connections, you may exhaust the available # pool of TCP sockets (as the rest are stuck waiting on TIME_WAIT timeouts). # While the 'reuse' flag might lead you to expect the ability to 'reuse' the # socket - there is one glaring caveat: you can't reuse the port from the # same origin address as this would be a major security flaw. So in reality # the reuse flag does nothing for us (which is why I removed it). # Instead I am forced to put the socket connection in a loop and, if the # first attempt to create the socket fails, wait around for SO_LINGER time # in the hope that the TCP socket pool will have finally purged a number of # the stranded TIME_WAIT connections. # One last kick in the daddy-bags - the *default* SO_LINGER is set to 2*MSL # (Maximum Segment Lifetime - the 'Time To Live of TCP' packets). This means # (according to RFC793) we may be waiting up to 4 minutes for TIME_WAITs to # be reaped. Sigh. Still - ever an optimist - I'll retry the socket # connection every 30 seconds. # References: # http://www.perlmonks.org/?node_id=771242 # http://hea-www.harvard.edu/~fine/Tech/addrinuse.html # http://blog.port80software.com/2004/12/07/hurry-up-and-time_wait/ # http://www.isi.edu/touch/pubs/infocomm99/infocomm99-web/ # http://www.faqs.org/rfcs/rfc793.html while(1) { my $socket= new IO::Socket::INET(PeerAddr => $self->{host} || 'localhost', PeerPort => $self->{port} || 8190, Proto => 'tcp'); if ($socket) { return $socket; } print "Failed to create client socket: $!\n"; print "=> Most likely cause - TCP ephemeral ports exhausted (stuck in TIME_WAITs)\n"; print "=> Retry in " . $retry_time . " seconds.\n"; } } sub query { my ($self, $query)= @_; my $socket = $self->open_socket(); croak "Fatal Error! $!\nDetails: " . $self->{'host'} . ":" . $self->{'port'} . "\n" unless $socket; binmode($socket, ":utf8"); print $socket $query . "\n.\n"; my $buffer = ''; my $reply = ''; while($buffer = <$socket>) { $reply.= $buffer; last if $reply =~ s/\n\.\n$//; } close($socket); return $reply; } 1;