forking perl

forking perl network server that does nothing more than echo back a text string that you feed it. check it at www.fif3.com/code

#!/usr/bin/perl
### by skp ###

use strict;
use IO::Socket;
use IO::Select;
use Getopt::Std;
use POSIX qw(:sys_wait_h);

my (%args);
getopts("p:t:", \%args);
if (!$args{p} || !$args{t}) {
print "\nusage: $0 -p port -t text\n";
print " note: i will append \\r\\n to your text\n";
print " 200OK.pl by skp\n\n";
exit;
}

sub REAP {
1 until (-1 == waitpid(-1, WNOHANG));
$SIG{CHLD} = \&REAP;
}

$SIG{CHLD} = \&REAP;
my $port = $args{p};
my $text = $args{t};
my $sock = new IO::Socket::INET(
LocalPort => $port,
Proto => 'tcp',
Listen => SOMAXCONN,
Reuse => 1);
$sock or die "no socket :$!";
STDOUT->autoflush(1);

my($new_sock, $buf, $stinky);
while ($new_sock = $sock->accept()) {
# run fork. if parent then done.
# go to continue.
next if $stinky = fork;
die "fork: $!" unless defined $stinky;
# child process.
# done with server.
close $sock;

while (defined($buf = <$new_sock>)) {
chop $buf;
print($new_sock "$text\r\n");
}
exit;
} continue {

# close client.
close $new_sock;
}

Posted by skp at dezembro 12, 2002 02:36 PM | TrackBack