#-----------------------------
use Socket;
$packed_ip = inet_aton("208.146.240.1");
$socket_name = sockaddr_in($port, $packed_ip);
#-----------------------------
use Socket;
$socket_name = sockaddr_un("/tmp/mysock");
#-----------------------------
($port, $packed_ip) = sockaddr_in($socket_name); # for PF_INET sockets
($filename) = sockaddr_un($socket_name); # for PF_UNIX sockets
#-----------------------------
$ip_address = inet_ntoa($packed_ip);
$packed_ip = inet_aton("204.148.40.9");
$packed_ip = inet_aton("www.oreilly.com");
#-----------------------------
|
#-----------------------------
use IO::Socket;
$socket = IO::Socket::INET->new(PeerAddr => $remote_host,
PeerPort => $remote_port,
Proto => "tcp",
Type => SOCK_STREAM)
or die "Couldn't connect to $remote_host:$remote_port : $@\n";
# ... do something with the socket
print $socket "Why don't you call me anymore?\n";
$answer = <$socket>;
# and terminate the connection when we're done
close($socket);
#-----------------------------
use Socket;
# create a socket
socket(TO_SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
# build the address of the remote machine
$internet_addr = inet_aton($remote_host)
or die "Couldn't convert $remote_host into an Internet address: $!\n";
$paddr = sockaddr_in($remote_port, $internet_addr);
# connect
connect(TO_SERVER, $paddr)
or die "Couldn't connect to $remote_host:$remote_port : $!\n";
# ... do something with the socket
print TO_SERVER "Why don't you call me anymore?\n";
# and terminate the connection when we're done
close(TO_SERVER);
#-----------------------------
$client = IO::Socket::INET->new("www.yahoo.com:80")
or die $@;
#-----------------------------
$s = IO::Socket::INET->new(PeerAddr => "Does not Exist",
Peerport => 80,
Type => SOCK_STREAM )
or die $@;
#-----------------------------
$s = IO::Socket::INET->new(PeerAddr => "bad.host.com",
PeerPort => 80,
Type => SOCK_STREAM,
Timeout => 5 )
or die $@;
#-----------------------------
$inet_addr = inet_aton("208.146.240.1");
$paddr = sockaddr_in($port, $inet_addr);
bind(SOCKET, $paddr) or die "bind: $!";
#-----------------------------
$inet_addr = gethostbyname("www.yahoo.com")
or die "Can't resolve www.yahoo.com: $!";
$paddr = sockaddr_in($port, $inet_addr);
bind(SOCKET, $paddr) or die "bind: $!";
#-----------------------------
|
#-----------------------------
use IO::Socket;
$server = IO::Socket::INET->new(LocalPort => $server_port,
Type => SOCK_STREAM,
Reuse => 1,
Listen => 10 ) # or SOMAXCONN
or die "Couldn't be a tcp server on port $server_port : $@\n";
while ($client = $server->accept()) {
# $client is the new connection
}
close($server);
#-----------------------------
use Socket;
# make the socket
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
# so we can restart our server quickly
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
# build up my socket address
$my_addr = sockaddr_in($server_port, INADDR_ANY);
bind(SERVER, $my_addr)
or die "Couldn't bind to port $server_port : $!\n";
# establish a queue for incoming connections
listen(SERVER, SOMAXCONN)
or die "Couldn't listen on port $server_port : $!\n";
# accept and process connections
while (accept(CLIENT, SERVER)) {
# do something with CLIENT
}
close(SERVER);
#-----------------------------
use Socket;
while ($client_address = accept(CLIENT, SERVER)) {
($port, $packed_ip) = sockaddr_in($client_address);
$dotted_quad = inet_ntoa($packed_ip);
# do as thou wilt
}
#-----------------------------
while ($client = $server->accept()) {
# ...
}
#-----------------------------
while (($client,$client_address) = $server->accept()) {
# ...
}
#-----------------------------
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
$flags = fcntl(SERVER, F_GETFL, 0)
or die "Can't get flags for the socket: $!\n";
$flags = fcntl(SERVER, F_SETFL, $flags | O_NONBLOCK)
or die "Can't set flags for the socket: $!\n";
#-----------------------------
|
#-----------------------------
print SERVER "What is your name?\n";
chomp ($response = <SERVER>);
#-----------------------------
defined (send(SERVER, $data_to_send, $flags))
or die "Can't send : $!\n";
recv(SERVER, $data_read, $maxlen, $flags)
or die "Can't receive: $!\n";
#-----------------------------
use IO::Socket;
$server->send($data_to_send, $flags)
or die "Can't send: $!\n";
$server->recv($data_read, $flags)
or die "Can't recv: $!\n";
#-----------------------------
use IO::Select;
$select = IO::Select->new();
$select->add(*FROM_SERVER);
$select->add($to_client);
@read_from = $select->can_read($timeout);
foreach $socket (@read_from) {
# read the pending data from $socket
}
#-----------------------------
use Socket;
require "sys/socket.ph"; # for &TCP_NODELAY
setsockopt(SERVER, SOL_SOCKET, &TCP_NODELAY, 1)
or die "Couldn't disable Nagle's algorithm: $!\n";
#-----------------------------
setsockopt(SERVER, SOL_SOCKET, &TCP_NODELAY, 0)
or die "Couldn't enable Nagle's algorithm: $!\n";
#-----------------------------
$rin = ''; # initialize bitmask
vec($rin, fileno(SOCKET), 1) = 1; # mark SOCKET in $rin
# repeat calls to vec() for each socket to check
$timeout = 10; # wait ten seconds
$nfound = select($rout = $rin, undef, undef, $timeout);
if (vec($rout, fileno(SOCKET),1)){
# data to be read on SOCKET
}
#-----------------------------
|
#-----------------------------
use Socket;
socket(SOCKET, PF_INET, SOCK_DGRAM, getprotobyname("udp"))
or die "socket: $!";
#-----------------------------
use IO::Socket;
$handle = IO::Socket::INET->new(Proto => 'udp')
or die "socket: $@"; # yes, it uses $@ here
#-----------------------------
$ipaddr = inet_aton($HOSTNAME);
$portaddr = sockaddr_in($PORTNO, $ipaddr);
send(SOCKET, $MSG, 0, $portaddr) == length($MSG)
or die "cannot send to $HOSTNAME($PORTNO): $!";
#-----------------------------
$portaddr = recv(SOCKET, $MSG, $MAXLEN, 0) or die "recv: $!";
($portno, $ipaddr) = sockaddr_in($portaddr);
$host = gethostbyaddr($ipaddr, AF_INET);
print "$host($portno) said $MSG\n";
#-----------------------------
send(MYSOCKET, $msg_buffer, $flags, $remote_addr)
or die "Can't send: $!\n";
#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# clockdrift - compare another system's clock with this one
use strict;
use Socket;
my ($host, $him, $src, $port, $ipaddr, $ptime, $delta);
my $SECS_of_70_YEARS = 2_208_988_800;
socket(MsgBox, PF_INET, SOCK_DGRAM, getprotobyname("udp"))
or die "socket: $!";
$him = sockaddr_in(scalar(getservbyname("time", "udp")),
inet_aton(shift || '127.1'));
defined(send(MsgBox, 0, 0, $him))
or die "send: $!";
defined($src = recv(MsgBox, $ptime, 4, 0))
or die "recv: $!";
($port, $ipaddr) = sockaddr_in($src);
$host = gethostbyaddr($ipaddr, AF_INET);
my $delta = (unpack("N", $ptime) - $SECS_of_70_YEARS) - time();
print "Clock on $host is $delta seconds ahead of this one.\n";
#-----------------------------
|
#-----------------------------
use IO::Socket;
$server = IO::Socket::INET->new(LocalPort => $server_port,
Proto => "udp")
or die "Couldn't be a udp server on port $server_port : $@\n";
#-----------------------------
while ($him = $server->recv($datagram, $MAX_TO_READ, $flags)) {
# do something
}
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# udpqotd - UDP message server
use strict;
use IO::Socket;
my($sock, $oldmsg, $newmsg, $hisaddr, $hishost, $MAXLEN, $PORTNO);
$MAXLEN = 1024;
$PORTNO = 5151;
$sock = IO::Socket::INET->new(LocalPort => $PORTNO, Proto => 'udp')
or die "socket: $@";
print "Awaiting UDP messages on port $PORTNO\n";
$oldmsg = "This is the starting message.";
while ($sock->recv($newmsg, $MAXLEN)) {
my($port, $ipaddr) = sockaddr_in($sock->peername);
$hishost = gethostbyaddr($ipaddr, AF_INET);
print "Client $hishost said ``$newmsg''\n";
$sock->send($oldmsg);
$oldmsg = "[$hishost] $newmsg";
}
die "recv: $!";
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# udpmsg - send a message to the udpquotd server
use IO::Socket;
use strict;
my($sock, $server_host, $msg, $port, $ipaddr, $hishost,
$MAXLEN, $PORTNO, $TIMEOUT);
$MAXLEN = 1024;
$PORTNO = 5151;
$TIMEOUT = 5;
$server_host = shift;
$msg = "@ARGV";
$sock = IO::Socket::INET->new(Proto => 'udp',
PeerPort => $PORTNO,
PeerAddr => $server_host)
or die "Creating socket: $!\n";
$sock->send($msg) or die "send: $!";
eval {
local $SIG{ALRM} = sub { die "alarm time out" };
alarm $TIMEOUT;
$sock->recv($msg, $MAXLEN) or die "recv: $!";
alarm 0;
1; # return value from eval on normalcy
} or die "recv from $server_host timed out after $TIMEOUT seconds.\n";
($port, $ipaddr) = sockaddr_in($sock->peername);
$hishost = gethostbyaddr($ipaddr, AF_INET);
print "Server $hishost responded ``$msg''\n";
#-----------------------------
|
#-----------------------------
use IO::Socket;
unlink "/tmp/mysock";
$server = IO::Socket::UNIX->new(Local => "/tmp/mysock",
Type => SOCK_DGRAM,
Listen => 5 )
or die $@;
$client = IO::Socket::UNIX->new(Peer => "/tmp/mysock",
Type => SOCK_DGRAM,
Timeout => 10 )
or die $@;
#-----------------------------
use Socket;
socket(SERVER, PF_UNIX, SOCK_STREAM, 0);
unlink "/tmp/mysock";
bind(SERVER, sockaddr_un("/tmp/mysock"))
or die "Can't create server: $!";
socket(CLIENT, PF_UNIX, SOCK_STREAM, 0);
connect(CLIENT, sockaddr_un("/tmp/mysock"))
or die "Can't connect to /tmp/mysock: $!";
#-----------------------------
|
#-----------------------------
use Socket;
$other_end = getpeername(SOCKET)
or die "Couldn't identify other end: $!\n";
($port, $iaddr) = unpack_sockaddr_in($other_end);
$ip_address = inet_ntoa($iaddr);
#-----------------------------
use Socket;
$other_end = getpeername(SOCKET)
or die "Couldn't identify other end: $!\n";
($port, $iaddr) = unpack_sockaddr_in($other_end);
$actual_ip = inet_ntoa($iaddr);
$claimed_hostname = gethostbyaddr($iaddr, AF_INET);
@name_lookup = gethostbyname($claimed_hostname)
or die "Could not look up $claimed_hostname : $!\n";
@resolved_ips = map { inet_ntoa($_) }
@name_lookup[ 4 .. $#ips_for_hostname ];
#-----------------------------
$packed_ip = gethostbyname($name) or die "Couldn't look up $name : $!\n";
$ip_address = inet_ntoa($packed_ip);
#-----------------------------
|
#-----------------------------
use Sys::Hostname;
$hostname = hostname();
#-----------------------------
use POSIX qw(uname);
($kernel, $hostname, $release, $version, $hardware) = uname();
$hostname = (uname)[1]; # or just one
#-----------------------------
use Socket; # for AF_INET
$address = gethostbyname($hostname)
or die "Couldn't resolve $hostname : $!";
$hostname = gethostbyaddr($address, AF_INET)
or die "Couldn't re-resolve $hostname : $!";
#-----------------------------
|
#----------------------------- shutdown(SOCKET, 0); # I/we have stopped reading data shutdown(SOCKET, 1); # I/we have stopped writing data shutdown(SOCKET, 2); # I/we have stopped using this socket #----------------------------- $socket->shutdown(0); # I/we have stopped reading data #----------------------------- print SERVER "my request\n"; # send some data shutdown(SERVER, 1); # send eof; no more writing $answer = <SERVER>; # but you can still read #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/perl -w # biclient - bidirectional forking client use strict; use IO::Socket; my ($host, $port, $kidpid, $handle, $line); unless (@ARGV == 2) { die "usage: $0 host port" } ($host, $port) = @ARGV; # create a tcp connection to the specified host and port $handle = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $host, PeerPort => $port) or die "can't connect to port $port on $host: $!"; $handle->autoflush(1); # so output gets there right away print STDERR "[Connected to $host:$port]\n"; # split the program into two processes, identical twins die "can't fork: $!" unless defined($kidpid = fork()); if ($kidpid) { # parent copies the socket to standard output while (defined ($line = <$handle>)) { print STDOUT $line; } kill("TERM" => $kidpid); # send SIGTERM to child } else { # child copies standard input to the socket while (defined ($line = <STDIN>)) { print $handle $line; } } exit; #----------------------------- my $byte; while (sysread($handle, $byte, 1) == 1) { print STDOUT $byte; } #----------------------------- |
#-----------------------------
# set up the socket SERVER, bind and listen ...
use POSIX qw(:sys_wait_h);
sub REAPER {
1 until (-1 == waitpid(-1, WNOHANG));
$SIG{CHLD} = \&REAPER; # unless $] >= 5.002
}
$SIG{CHLD} = \&REAPER;
while ($hisaddr = accept(CLIENT, SERVER)) {
next if $pid = fork; # parent
die "fork: $!" unless defined $pid; # failure
# otherwise child
close(SERVER); # no use to child
# ... do something
exit; # child leaves
} continue {
close(CLIENT); # no use to parent
}
#-----------------------------
|
#----------------------------- # download the following standalone program #!/usr/bin/perl # preforker - server who forks first use IO::Socket; use Symbol; use POSIX; # establish SERVER socket, bind and listen. $server = IO::Socket::INET->new(LocalPort => 6969, Type => SOCK_STREAM, Proto => 'tcp', Reuse => 1, Listen => 10 ) or die "making socket: $@\n"; # global variables $PREFORK = 5; # number of children to maintain $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process %children = (); # keys are current child process IDs $children = 0; # current number of children sub REAPER { # takes care of dead children $SIG{CHLD} = \&REAPER; my $pid = wait; $children --; delete $children{$pid}; } sub HUNTSMAN { # signal handler for SIGINT local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children kill 'INT' => keys %children; exit; # clean up with dignity } # Fork off our children. for (1 .. $PREFORK) { make_new_child(); } # Install signal handlers. $SIG{CHLD} = \&REAPER; $SIG{INT} = \&HUNTSMAN; # And maintain the population. while (1) { sleep; # wait for a signal (i.e., child's death) for ($i = $children; $i < $PREFORK; $i++) { make_new_child(); # top up the child pool } } sub make_new_child { my $pid; my $sigset; # block signal for fork $sigset = POSIX::SigSet->new(SIGINT); sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: $!\n"; die "fork: $!" unless defined ($pid = fork); if ($pid) { # Parent records the child's birth and returns. sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; $children{$pid} = 1; $children++; return; } else { # Child can *not* return from this subroutine. $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before # unblock signals sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: $!\n"; # handle connections until we've reached $MAX_CLIENTS_PER_CHILD for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { $client = $server->accept() or last; # do something with the connection } # tidy up gracefully and finish # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into # process death. exit; } } #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/perl -w # nonforker - server who multiplexes without forking use POSIX; use IO::Socket; use IO::Select; use Socket; use Fcntl; use Tie::RefHash; $port = 1685; # change this at will # Listen to port. $server = IO::Socket::INET->new(LocalPort => $port, Listen => 10 ) or die "Can't make server socket: $@\n"; # begin with empty buffers %inbuffer = (); %outbuffer = (); %ready = (); tie %ready, 'Tie::RefHash'; nonblock($server); $select = IO::Select->new($server); # Main loop: check reads/accepts, check writes, check ready to process while (1) { my $client; my $rv; my $data; # check for new information on the connections we have # anything to read or accept? foreach $client ($select->can_read(1)) { if ($client == $server) { # accept a new connection $client = $server->accept(); $select->add($client); nonblock($client); } else { # read data $data = ''; $rv = $client->recv($data, POSIX::BUFSIZ, 0); unless (defined($rv) && length $data) { # This would be the end of file, so close the client delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); close $client; next; } $inbuffer{$client} .= $data; # test whether the data in the buffer or the data we # just read means there is a complete request waiting # to be fulfilled. If there is, set $ready{$client} # to the requests waiting to be fulfilled. while ($inbuffer{$client} =~ s/(.*\n)//) { push( @{$ready{$client}}, $1 ); } } } # Any complete requests to process? foreach $client (keys %ready) { handle($client); } # Buffers to flush? foreach $client ($select->can_write(1)) { # Skip this client if we have nothing to say next unless exists $outbuffer{$client}; $rv = $client->send($outbuffer{$client}, 0); unless (defined $rv) { # Whine, but move on. warn "I was told I could write, but I can't.\n"; next; } if ($rv == length $outbuffer{$client} || {$! == POSIX::EWOULDBLOCK) { substr($outbuffer{$client}, 0, $rv) = ''; delete $outbuffer{$client} unless length $outbuffer{$client}; } else { # Couldn't write all the data, and it wasn't because # it would have blocked. Shutdown and move on. delete $inbuffer{$client}; delete $outbuffer{$client}; delete $ready{$client}; $select->remove($client); close($client); next; } } # Out of band data? foreach $client ($select->has_exception(0)) { # arg is timeout # Deal with out-of-band data here, if you want to. } } # handle($socket) deals with all pending requests for $client sub handle { # requests are in $ready{$client} # send output to $outbuffer{$client} my $client = shift; my $request; foreach $request (@{$ready{$client}}) { # $request is the text of the request # put text of reply into $outbuffer{$client} } delete $ready{$client}; } # nonblock($socket) puts socket into nonblocking mode sub nonblock { my $socket = shift; my $flags; $flags = fcntl($socket, F_GETFL, 0) or die "Can't get flags for socket: $!\n"; fcntl($socket, F_SETFL, $flags | O_NONBLOCK) or die "Can't make socket nonblocking: $!\n"; } #----------------------------- while ($inbuffer{$client} =~ s/(.*\n)//) { push( @{$ready{$client}}, $1 ); } #----------------------------- $outbuffer{$client} .= $request; #----------------------------- |
#-----------------------------
use Socket;
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
bind(SERVER, sockaddr_in($server_port, INADDR_ANY))
or die "Binding: $!\n";
# accept loop
while (accept(CLIENT, SERVER)) {
$my_socket_address = getsockname(CLIENT);
($port, $myaddr) = sockaddr_in($my_socket_address);
}
#-----------------------------
$server = IO::Socket::INET->new(LocalPort => $server_port,
Type => SOCK_STREAM,
Proto => 'tcp',
Listen => 10)
or die "Can't create server socket: $@\n";
while ($client = $server->accept()) {
$my_socket_address = $client->sockname();
($port, $myaddr) = sockaddr_in($my_socket_address);
# ...
}
#-----------------------------
use Socket;
$port = 4269; # port to bind to
$host = "specific.host.com"; # virtual host to listen on
socket(Server, PF_INET, SOCK_STREAM, getprotobyname("tcp"))
or die "socket: $!";
bind(Server, sockaddr_in($port, inet_aton($host)))
or die "bind: $!";
while ($client_address = accept(Client, Server)) {
# ...
}
#-----------------------------
|
#-----------------------------
chroot("/var/daemon")
or die "Couldn't chroot to /var/daemon: $!";
#-----------------------------
$pid = fork;
exit if $pid;
die "Couldn't fork: $!" unless defined($pid);
#-----------------------------
use POSIX;
POSIX::setsid()
or die "Can't start a new session: $!";
#-----------------------------
$time_to_die = 0;
sub signal_handler {
$time_to_die = 1;
}
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;
# trap or ignore $SIG{PIPE}
#-----------------------------
until ($time_to_die) {
# ...
}
#-----------------------------
|
#-----------------------------
$SELF = "/usr/local/libexec/myd"; # which program I am
@ARGS = qw(-l /var/log/myd -d); # program arguments
$SIG{HUP} = \&phoenix;
sub phoenix {
# close all your connections, kill your children, and
# generally prepare to be reincarnated with dignity.
exec($SELF, @ARGS) or die "Couldn't restart: $!\n";
}
#-----------------------------
$CONFIG_FILE = "/usr/local/etc/myprog/server_conf.pl";
$SIG{HUP} = \&read_config;
sub read_config {
do $CONFIG_FILE;
}
#-----------------------------
|
#----------------------------- May 25 15:50:22 coprolith sniffer: Connection from 207.46.131.141 to 207.46.130.164:echo #----------------------------- echo stream tcp nowait nobody /usr/scripts/snfsqrd sniffer #----------------------------- # download the following standalone program #!/usr/bin/perl -w # backsniff - log attempts to connect to particular ports use Sys::Syslog; use Socket; # identify my port and address $sockname = getsockname(STDIN) or die "Couldn't identify myself: $!\n"; ($port, $iaddr) = sockaddr_in($sockname); $my_address = inet_ntoa($iaddr); # get a name for the service $service = (getservbyport ($port, "tcp"))[0] || $port; # now identify remote address $sockname = getpeername(STDIN) or die "Couldn't identify other end: $!\n"; ($port, $iaddr) = sockaddr_in($sockname); $ex_address = inet_ntoa($iaddr); # and log the information openlog("sniffer", "ndelay", "daemon"); syslog("notice", "Connection from %s to %s:%s\n", $ex_address, $my_address, $service); closelog(); exit; #----------------------------- |
#----------------------------- #% fwdport -s nntp -l fw.oursite.com -r news.bigorg.com #----------------------------- #% fwdport -l myname:9191 -r news.bigorg.com:nntp #----------------------------- # download the following standalone program #!/usr/bin/perl -w # fwdport -- act as proxy forwarder for dedicated services use strict; # require declarations use Getopt::Long; # for option processing use Net::hostent; Example 17-8 # by-name interface for host info use IO::Socket; # for creating server and client sockets use POSIX ":sys_wait_h"; # for reaping our dead children my ( %Children, # hash of outstanding child processes $REMOTE, # whom we connect to on the outside $LOCAL, # where we listen to on the inside $SERVICE, # our service name or port number $proxy_server, # the socket we accept() from $ME, # basename of this program ); ($ME = $0) =~ s,.*/,,; # retain just basename of script name check_args(); # processing switches start_proxy(); # launch our own server service_clients(); # wait for incoming die "NOT REACHED"; # you can't get here from there # process command line switches using the extended # version of the getopts library. sub check_args { GetOptions( "remote=s" => \$REMOTE, "local=s" => \$LOCAL, "service=s" => \$SERVICE, ) or die <<EOUSAGE; usage: $0 [ --remote host ] [ --local interface ] [ --service service ] EOUSAGE die "Need remote" unless $REMOTE; die "Need local or service" unless $LOCAL || $SERVICE; } # begin our server sub start_proxy { my @proxy_server_config = ( Proto => 'tcp', Reuse => 1, Listen => SOMAXCONN, ); push @proxy_server_config, LocalPort => $SERVICE if $SERVICE; push @proxy_server_config, LocalAddr => $LOCAL if $LOCAL; $proxy_server = IO::Socket::INET->new(@proxy_server_config) or die "can't create proxy server: $@"; print "[Proxy server on ", ($LOCAL || $SERVICE), " initialized.]\n"; } sub service_clients { my ( $local_client, # someone internal wanting out $lc_info, # local client's name/port information $remote_server, # the socket for escaping out @rs_config, # temp array for remote socket options $rs_info, # remote server's name/port information $kidpid, # spawned child for each connection ); $SIG{CHLD} = \&REAPER; # harvest the moribund accepting(); # an accepted connection here means someone inside wants out while ($local_client = $proxy_server->accept()) { $lc_info = peerinfo($local_client); set_state("servicing local $lc_info"); printf "[Connect from $lc_info]\n"; @rs_config = ( Proto => 'tcp', PeerAddr => $REMOTE, ); push(@rs_config, PeerPort => $SERVICE) if $SERVICE; print "[Connecting to $REMOTE..."; set_state("connecting to $REMOTE"); # see below $remote_server = IO::Socket::INET->new(@rs_config) or die "remote server: $@"; print "done]\n"; $rs_info = peerinfo($remote_server); set_state("connected to $rs_info"); $kidpid = fork(); die "Cannot fork" unless defined $kidpid; if ($kidpid) { $Children{$kidpid} = time(); # remember his start time close $remote_server; # no use to master close $local_client; # likewise next; # go get another client } # at this point, we are the forked child process dedicated # to the incoming client. but we want a twin to make i/o # easier. close $proxy_server; # no use to slave $kidpid = fork(); die "Cannot fork" unless defined $kidpid; # now each twin sits around and ferries lines of data. # see how simple the algorithm is when you can have # multiple threads of control? # this is the fork's parent, the master's child if ($kidpid) { set_state("$rs_info --> $lc_info"); select($local_client); $| = 1; print while <$remote_server>; kill('TERM', $kidpid); # kill my twin cause we're done } # this is the fork's child, the master's grandchild else { set_state("$rs_info <-- $lc_info"); select($remote_server); $| = 1; print while <$local_client>; kill('TERM', getppid()); # kill my twin cause we're done } exit; # whoever's still alive bites it } continue { accepting(); } } # helper function to produce a nice string in the form HOST:PORT sub peerinfo { my $sock = shift; my $hostinfo = gethostbyaddr($sock->peeraddr); return sprintf("%s:%s", $hostinfo->name || $sock->peerhost, $sock->peerport); } # reset our $0, which on some systems make "ps" report # something interesting: the string we set $0 to! sub set_state { $0 = "$ME [@_]" } # helper function to call set_state sub accepting { set_state("accepting proxy for " . ($REMOTE || $SERVICE)); } # somebody just died. keep harvesting the dead until # we run out of them. check how long they ran. sub REAPER { my $child; my $start; while (($child = waitpid(-1,WNOHANG)) > 0) { if ($start = $Children{$child}) { my $runtime = time() - $start; printf "Child $child ran %dm%ss\n", $runtime / 60, $runtime % 60; delete $Children{$child}; } else { print "Bizarre kid $child exited $?\n"; } } # If I had to choose between System V and 4.2, I'd resign. --Peter Honeyman $SIG{CHLD} = \&REAPER; }; #----------------------------- |