[Resend] Patch to Get Rid of \t in perlipc.pod [was Re: [PATCH] Start revamping perlipc.pod]
[email protected] (Shlomi Fish) Sat, 23 Oct 2010 11:44:46 +0200
| Newsgroups | perl.perl5.porters,perl.documentation |
|---|---|
| Message-ID | <[email protected]> |
I'm resending this patch because it was not applied yet. Please apply it,=20
because I'd like to further patch perlipc.pod.
More details below.
Regards,
Shlomi Fish
On Sunday 05 September 2010 08:13:02 Jesse Vincent wrote:
> On Sun, Sep 05, 2010 at 08:03:41AM +0300, Shlomi Fish wrote:
> > Hi all,
> >=20
> > Inspired by a message ot the perl documentation proejct, I started
> > working on revamping perlipc.pod here:
> >=20
> > http://github.com/shlomif/perl/tree/perlipc-revamp
> >=20
> > What I did so far is convert all tabs to spaces (as the indentation was
> > very erratic) and started modernising the code
>=20
> Shlomi,
>=20
> Thanks for starting to look at perlipc. Is there a chance you could send
> your patch as a series that splits out the whitespace changes from the
> code/prose changes? Heavy whitespace changes tend to make it much
> harder to review "contentful" changes in a patch, since there are
> so many lines of diff that aren't actually semantically meaningful.
>=20
> Thanks,
> Jesse
Thanks to the git history, I can. Here is the tabs->spaces patch and the ne=
xt=20
reply will contain the code/prose changes. I've marked the transition in th=
e=20
repository using the =ABperlipc_pod_after_changing_tabs_to_spaces=BB tag.
Regards,
Shlomi Fish
diff --git a/pod/perlipc.pod b/pod/perlipc.pod
index 8d9ea97..9c556d0 100644
=2D-- a/pod/perlipc.pod
+++ b/pod/perlipc.pod
@@ -21,11 +21,16 @@ running out of stack space, or hitting file size limit.
=20
For example, to trap an interrupt signal, set up a handler like this:
=20
+ our $shucks =3D 0;
+
sub catch_zap {
=2D my $signame =3D shift;
=2D $shucks++;
=2D die "Somebody sent me a SIG$signame";
+ my $signame =3D shift;
+
+ $shucks++;
+
+ die "Somebody sent me a SIG$signame";
}
+
$SIG{INT} =3D 'catch_zap'; # could fail in modules
$SIG{INT} =3D \&catch_zap; # best strategy
=20
@@ -45,16 +50,16 @@ indexed by name to get the number:
use Config;
defined $Config{sig_name} || die "No sigs?";
foreach $name (split(' ', $Config{sig_name})) {
=2D $signo{$name} =3D $i;
=2D $signame[$i] =3D $name;
=2D $i++;
+ $signo{$name} =3D $i;
+ $signame[$i] =3D $name;
+ $i++;
}
=20
So to check whether signal 17 and SIGALRM were the same, do just this:
=20
print "signal #17 =3D $signame[17]\n";
if ($signo{ALRM}) {
=2D print "SIGALRM is $signo{ALRM}\n";
+ print "SIGALRM is $signo{ALRM}\n";
}
=20
You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
@@ -76,11 +81,11 @@ automatically restored once your block is exited. =20
(Remember that local()
values are "inherited" by functions called from within that block.)
=20
sub precious {
=2D local $SIG{INT} =3D 'IGNORE';
=2D &more_functions;
+ local $SIG{INT} =3D 'IGNORE';
+ &more_functions;
}
sub more_functions {
=2D # interrupts still ignored, for now...
+ # interrupts still ignored, for now...
}
=20
Sending a signal to a negative process ID means that you send the signal
@@ -89,9 +94,9 @@ processes in the current process group (and sets $SIG{HUP=
}=20
to IGNORE so
it doesn't kill itself):
=20
{
=2D local $SIG{HUP} =3D 'IGNORE';
=2D kill HUP =3D> -$$;
=2D # snazzy writing of: kill('HUP', -$$)
+ local $SIG{HUP} =3D 'IGNORE';
+ kill HUP =3D> -$$;
+ # snazzy writing of: kill('HUP', -$$)
}
=20
Another interesting signal to send is signal number zero. This doesn't
@@ -99,7 +104,7 @@ actually affect a child process, but instead checks whet=
her=20
it's alive
or has changed its UID.
=20
unless (kill 0 =3D> $kid_pid) {
=2D warn "something wicked happened to $kid_pid";
+ warn "something wicked happened to $kid_pid";
}
=20
When directed at a process whose UID is not identical to that
@@ -108,7 +113,7 @@ you lack permission to send the signal, even though the=
=20
process is alive.
You may be able to determine the cause of failure using C<%!>.
=20
unless (kill 0 =3D> $pid or $!{EPERM}) {
=2D warn "$pid looks dead";
+ warn "$pid looks dead";
}
=20
You might also want to employ anonymous functions for simple signal
@@ -125,10 +130,10 @@ reasonable BSD and POSIX fashion. So you'll see=20
defensive people writing
signal handlers like this:
=20
sub REAPER {
=2D $waitedpid =3D wait;
=2D # loathe SysV: it makes us not only reinstate
=2D # the handler, but place it after the wait
=2D $SIG{CHLD} =3D \&REAPER;
+ $waitedpid =3D wait;
+ # loathe SysV: it makes us not only reinstate
+ # the handler, but place it after the wait
+ $SIG{CHLD} =3D \&REAPER;
}
$SIG{CHLD} =3D \&REAPER;
# now do something that forks...
@@ -137,15 +142,15 @@ or better still:
=20
use POSIX ":sys_wait_h";
sub REAPER {
=2D my $child;
=2D # If a second child dies while in the signal handler caused by the
=2D # first death, we won't get another signal. So must loop here else
=2D # we will leave the unreaped child as a zombie. And the next time
=2D # two children die we get another zombie. And so on.
+ my $child;
+ # If a second child dies while in the signal handler caused by the
+ # first death, we won't get another signal. So must loop here else
+ # we will leave the unreaped child as a zombie. And the next time
+ # two children die we get another zombie. And so on.
while (($child =3D waitpid(-1,WNOHANG)) > 0) {
=2D $Kid_Status{$child} =3D $?;
=2D }
=2D $SIG{CHLD} =3D \&REAPER; # still loathe SysV
+ $Kid_Status{$child} =3D $?;
+ }
+ $SIG{CHLD} =3D \&REAPER; # still loathe SysV
}
$SIG{CHLD} =3D \&REAPER;
# do something that forks...
@@ -294,9 +299,9 @@ systems, mkfifo(1). These may not be in your normal pa=
th.
#
$ENV{PATH} .=3D ":/etc:/usr/etc";
if ( system('mknod', $path, 'p')
=2D && system('mkfifo', $path) )
+ && system('mkfifo', $path) )
{
=2D die "mk{nod,fifo} $path failed";
+ die "mk{nod,fifo} $path failed";
}
=20
=20
@@ -315,18 +320,18 @@ to find out whether anyone (or anything) has=20
accidentally removed our fifo.
$FIFO =3D '.signature';
=20
while (1) {
=2D unless (-p $FIFO) {
=2D unlink $FIFO;
=2D require POSIX;
=2D POSIX::mkfifo($FIFO, 0700)
=2D or die "can't mkfifo $FIFO: $!";
=2D }
=2D
=2D # next line blocks until there's a reader
=2D open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
=2D print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
=2D close FIFO;
=2D sleep 2; # to avoid dup signals
+ unless (-p $FIFO) {
+ unlink $FIFO;
+ require POSIX;
+ POSIX::mkfifo($FIFO, 0700)
+ or die "can't mkfifo $FIFO: $!";
+ }
+
+ # next line blocks until there's a reader
+ open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
+ print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
+ close FIFO;
+ sleep 2; # to avoid dup signals
}
=20
=3Dhead2 Deferred Signals (Safe Signals)
@@ -472,7 +477,7 @@ symbol to the second argument to open(). Here's how to=
=20
start
something up in a child process you intend to write to:
=20
open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
=2D || die "can't fork: $!";
+ || die "can't fork: $!";
local $SIG{PIPE} =3D sub { die "spooler pipe broke" };
print SPOOLER "stuff\n";
close SPOOLER || die "bad spool: $! $?";
@@ -480,10 +485,10 @@ something up in a child process you intend to write t=
o:
And here's how to start up a child process you intend to read from:
=20
open(STATUS, "netstat -an 2>&1 |")
=2D || die "can't fork: $!";
+ || die "can't fork: $!";
while (<STATUS>) {
=2D next if /^(tcp|udp)/;
=2D print;
+ next if /^(tcp|udp)/;
+ print;
}
close STATUS || die "bad netstat: $! $?";
=20
@@ -521,9 +526,9 @@ while readers of bogus commands return just a quick end=
of=20
file, writers
to bogus command will trigger a signal they'd better be prepared to
handle. Consider:
=20
=2D open(FH, "|bogus") or die "can't fork: $!";
=2D print FH "bang\n" or die "can't write: $!";
=2D close FH or die "can't close: $!";
+ open(FH, "|bogus") or die "can't fork: $!";
+ print FH "bang\n" or die "can't write: $!";
+ close FH or die "can't close: $!";
=20
That won't blow up until the close, and it will blow up with a SIGPIPE.
To catch it, you could use this:
@@ -566,14 +571,14 @@ output doesn't wind up on the user's terminal).
use POSIX 'setsid';
=20
sub daemonize {
=2D chdir '/' or die "Can't chdir to /: $!";
=2D open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
=2D open STDOUT, '>/dev/null'
=2D or die "Can't write to /dev/null: $!";
=2D defined(my $pid =3D fork) or die "Can't fork: $!";
=2D exit if $pid;
=2D die "Can't start a new session: $!" if setsid =3D=3D -1;
=2D open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
+ chdir '/' or die "Can't chdir to /: $!";
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ open STDOUT, '>/dev/null'
+ or die "Can't write to /dev/null: $=
!";
+ defined(my $pid =3D fork) or die "Can't fork: $!";
+ exit if $pid;
+ die "Can't start a new session: $!" if setsid =3D=3D -1;
+ open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}
=20
The fork() has to come before the setsid() to ensure that you aren't a
@@ -601,25 +606,25 @@ you opened whatever your kid writes to his STDOUT.
my $sleep_count =3D 0;
=20
do {
=2D $pid =3D open(KID_TO_WRITE, "|-");
=2D unless (defined $pid) {
=2D warn "cannot fork: $!";
=2D die "bailing out" if $sleep_count++ > 6;
=2D sleep 10;
=2D }
+ $pid =3D open(KID_TO_WRITE, "|-");
+ unless (defined $pid) {
+ warn "cannot fork: $!";
+ die "bailing out" if $sleep_count++ > 6;
+ sleep 10;
+ }
} until defined $pid;
=20
if ($pid) { # parent
=2D print KID_TO_WRITE @some_data;
=2D close(KID_TO_WRITE) || warn "kid exited $?";
+ print KID_TO_WRITE @some_data;
+ close(KID_TO_WRITE) || warn "kid exited $?";
} else { # child
=2D ($EUID, $EGID) =3D ($UID, $GID); # suid progs only
=2D open (FILE, "> /safe/file")
=2D || die "can't open /safe/file: $!";
=2D while (<STDIN>) {
=2D print FILE; # child's STDIN is parent's KID_TO_WRITE
=2D }
=2D exit; # don't forget this
+ ($EUID, $EGID) =3D ($UID, $GID); # suid progs only
+ open (FILE, "> /safe/file")
+ || die "can't open /safe/file: $!";
+ while (<STDIN>) {
+ print FILE; # child's STDIN is parent's KID_TO_WRITE
+ }
+ exit; # don't forget this
}
=20
Another common use for this construct is when you need to execute
@@ -634,16 +639,16 @@ Here's a safe backtick or pipe open for read:
$pid =3D open(KID_TO_READ, "-|");
=20
if ($pid) { # parent
=2D while (<KID_TO_READ>) {
=2D # do something interesting
=2D }
=2D close(KID_TO_READ) || warn "kid exited $?";
+ while (<KID_TO_READ>) {
+ # do something interesting
+ }
+ close(KID_TO_READ) || warn "kid exited $?";
=20
} else { # child
=2D ($EUID, $EGID) =3D ($UID, $GID); # suid only
=2D exec($program, @options, @args)
=2D || die "can't exec program: $!";
=2D # NOTREACHED
+ ($EUID, $EGID) =3D ($UID, $GID); # suid only
+ exec($program, @options, @args)
+ || die "can't exec program: $!";
+ # NOTREACHED
}
=20
=20
@@ -654,16 +659,16 @@ And here's a safe pipe open for writing:
$SIG{PIPE} =3D sub { die "whoops, $program pipe broke" };
=20
if ($pid) { # parent
=2D for (@data) {
=2D print KID_TO_WRITE;
=2D }
=2D close(KID_TO_WRITE) || warn "kid exited $?";
+ for (@data) {
+ print KID_TO_WRITE;
+ }
+ close(KID_TO_WRITE) || warn "kid exited $?";
=20
} else { # child
=2D ($EUID, $EGID) =3D ($UID, $GID);
=2D exec($program, @options, @args)
=2D || die "can't exec program: $!";
=2D # NOTREACHED
+ ($EUID, $EGID) =3D ($UID, $GID);
+ exec($program, @options, @args)
+ || die "can't exec program: $!";
+ # NOTREACHED
}
=20
It is very easy to dead-lock a process using this form of open(), or
@@ -685,12 +690,12 @@ writer. Consider this code:
}
else {
# write to WRITER...
=2D exit;
+ exit;
}
}
else {
# do something with STDIN...
=2D exit;
+ exit;
}
=20
In the above, the true parent does not want to write to the WRITER
@@ -711,13 +716,13 @@ open() which sets one file descriptor to another, as=
=20
below:
$pid =3D fork();
defined $pid or die "fork failed; $!";
if ($pid) {
=2D close READER;
+ close READER;
if (my $sub_pid =3D fork()) {
close WRITER;
}
else {
# write to WRITER...
=2D exit;
+ exit;
}
# write to WRITER...
}
@@ -817,8 +822,8 @@ pseudo-ttys to make your program behave more reasonably:
require 'Comm.pl';
$ph =3D open_proc('cat -n');
for (1..10) {
=2D print $ph "a line\n";
=2D print "got back ", scalar <$ph>;
+ print $ph "a line\n";
+ print "got back ", scalar <$ph>;
}
=20
This way you don't have to have control over the source code of the
@@ -843,27 +848,27 @@ handles to STDIN and STDOUT and call other processes.
#!/usr/bin/perl -w
# pipe1 - bidirectional communication using two pipe pairs
# designed for the socketpair-challenged
=2D use IO::Handle; # thousands of lines just for autoflush :-(
=2D pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
=2D pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
+ use IO::Handle; # thousands of lines just for autoflush =
:-(
+ pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
+ pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
CHILD_WTR->autoflush(1);
PARENT_WTR->autoflush(1);
=20
if ($pid =3D fork) {
=2D close PARENT_RDR; close PARENT_WTR;
=2D print CHILD_WTR "Parent Pid $$ is sending this\n";
=2D chomp($line =3D <CHILD_RDR>);
=2D print "Parent Pid $$ just read this: `$line'\n";
=2D close CHILD_RDR; close CHILD_WTR;
=2D waitpid($pid,0);
+ close PARENT_RDR; close PARENT_WTR;
+ print CHILD_WTR "Parent Pid $$ is sending this\n";
+ chomp($line =3D <CHILD_RDR>);
+ print "Parent Pid $$ just read this: `$line'\n";
+ close CHILD_RDR; close CHILD_WTR;
+ waitpid($pid,0);
} else {
=2D die "cannot fork: $!" unless defined $pid;
=2D close CHILD_RDR; close CHILD_WTR;
=2D chomp($line =3D <PARENT_RDR>);
=2D print "Child Pid $$ just read this: `$line'\n";
=2D print PARENT_WTR "Child Pid $$ is sending this\n";
=2D close PARENT_RDR; close PARENT_WTR;
=2D exit;
+ die "cannot fork: $!" unless defined $pid;
+ close CHILD_RDR; close CHILD_WTR;
+ chomp($line =3D <PARENT_RDR>);
+ print "Child Pid $$ just read this: `$line'\n";
+ print PARENT_WTR "Child Pid $$ is sending this\n";
+ close PARENT_RDR; close PARENT_WTR;
+ exit;
}
=20
But you don't actually have to make two pipe calls. If you
@@ -874,31 +879,31 @@ have the socketpair() system call, it will do this al=
l=20
for you.
# "the best ones always go both ways"
=20
use Socket;
=2D use IO::Handle; # thousands of lines just for autoflush :-(
+ use IO::Handle; # thousands of lines just for autoflush :-(
# We say AF_UNIX because although *_LOCAL is the
# POSIX 1003.1g form of the constant, many machines
# still don't have it.
socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
=2D or die "socketpair: $!";
+ or die "socketpair: $!";
=20
CHILD->autoflush(1);
PARENT->autoflush(1);
=20
if ($pid =3D fork) {
=2D close PARENT;
=2D print CHILD "Parent Pid $$ is sending this\n";
=2D chomp($line =3D <CHILD>);
=2D print "Parent Pid $$ just read this: `$line'\n";
=2D close CHILD;
=2D waitpid($pid,0);
+ close PARENT;
+ print CHILD "Parent Pid $$ is sending this\n";
+ chomp($line =3D <CHILD>);
+ print "Parent Pid $$ just read this: `$line'\n";
+ close CHILD;
+ waitpid($pid,0);
} else {
=2D die "cannot fork: $!" unless defined $pid;
=2D close CHILD;
=2D chomp($line =3D <PARENT>);
=2D print "Child Pid $$ just read this: `$line'\n";
=2D print PARENT "Child Pid $$ is sending this\n";
=2D close PARENT;
=2D exit;
+ die "cannot fork: $!" unless defined $pid;
+ close CHILD;
+ chomp($line =3D <PARENT>);
+ print "Child Pid $$ just read this: `$line'\n";
+ print PARENT "Child Pid $$ is sending this\n";
+ close PARENT;
+ exit;
}
=20
=3Dhead1 Sockets: Client/Server Communication
@@ -958,17 +963,17 @@ Here's a sample TCP client using Internet-domain=20
sockets:
$port =3D shift || 2345; # random port
if ($port =3D~ /\D/) { $port =3D getservbyname($port, 'tcp') }
die "No port" unless $port;
=2D $iaddr =3D inet_aton($remote) || die "no host: $remote";
+ $iaddr =3D inet_aton($remote) || die "no host: $remote";
$paddr =3D sockaddr_in($port, $iaddr);
=20
$proto =3D getprotobyname('tcp');
=2D socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
+ socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";
while (defined($line =3D <SOCK>)) {
=2D print $line;
+ print $line;
}
=20
=2D close (SOCK) || die "close: $!";
+ close (SOCK) || die "close: $!";
exit;
=20
And here's a corresponding server to go along with it. We'll
@@ -992,11 +997,11 @@ instead.
=20
($port) =3D $port =3D~ /^(\d+)$/ or die "invali=
d=20
port";
=20
=2D socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
+ socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
=2D pack("l", 1)) || die "setsockopt:=20
$!";
=2D bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
=2D listen(Server,SOMAXCONN) || die "listen: $!";
+ pack("l", 1)) || die "setsockopt: $!";
+ bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
+ listen(Server,SOMAXCONN) || die "listen: $!";
=20
logmsg "server started on port $port";
=20
@@ -1005,15 +1010,15 @@ instead.
$SIG{CHLD} =3D \&REAPER;
=20
for ( ; $paddr =3D accept(Client,Server); close Client) {
=2D my($port,$iaddr) =3D sockaddr_in($paddr);
=2D my $name =3D gethostbyaddr($iaddr,AF_INET);
+ my($port,$iaddr) =3D sockaddr_in($paddr);
+ my $name =3D gethostbyaddr($iaddr,AF_INET);
=20
=2D logmsg "connection from $name [",
=2D inet_ntoa($iaddr), "]
=2D at port $port";
+ logmsg "connection from $name [",
+ inet_ntoa($iaddr), "]
+ at port $port";
=20
=2D print Client "Hello there, $name, it's now ",
=2D scalar localtime, $EOL;
+ print Client "Hello there, $name, it's now ",
+ scalar localtime, $EOL;
}
=20
And here's a multithreaded version. It's multithreaded in that
@@ -1036,11 +1041,11 @@ go back to service a new client.
=20
($port) =3D $port =3D~ /^(\d+)$/ or die "invali=
d=20
port";
=20
=2D socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
+ socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
=2D pack("l", 1)) || die "setsockopt:=20
$!";
=2D bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
=2D listen(Server,SOMAXCONN) || die "listen: $!";
+ pack("l", 1)) || die "setsockopt: $!";
+ bind(Server, sockaddr_in($port, INADDR_ANY))|| die "bind: $!";
+ listen(Server,SOMAXCONN) || die "listen: $!";
=20
logmsg "server started on port $port";
=20
@@ -1161,16 +1166,16 @@ differ from the system on which it's being run:
printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
=20
foreach $host (@ARGV) {
=2D printf "%-24s ", $host;
=2D my $hisiaddr =3D inet_aton($host) || die "unknown host";
=2D my $hispaddr =3D sockaddr_in($port, $hisiaddr);
=2D socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
=2D connect(SOCKET, $hispaddr) || die "connect: $!";
=2D my $rtime =3D ' ';
=2D read(SOCKET, $rtime, 4);
=2D close(SOCKET);
=2D my $histime =3D unpack("N", $rtime) - $SECS_of_70_YEARS;
=2D printf "%8d %s\n", $histime - time, ctime($histime);
+ printf "%-24s ", $host;
+ my $hisiaddr =3D inet_aton($host) || die "unknown host";
+ my $hispaddr =3D sockaddr_in($port, $hisiaddr);
+ socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
+ connect(SOCKET, $hispaddr) || die "connect: $!";
+ my $rtime =3D ' ';
+ read(SOCKET, $rtime, 4);
+ close(SOCKET);
+ my $histime =3D unpack("N", $rtime) - $SECS_of_70_YEARS;
+ printf "%8d %s\n", $histime - time, ctime($histime);
}
=20
=3Dhead2 Unix-Domain TCP Clients and Servers
@@ -1187,7 +1192,7 @@ domain sockets can show up in the file system with an=
=20
ls(1) listing.
You can test for these with Perl's B<-S> file test:
=20
unless ( -S '/dev/log' ) {
=2D die "something's wicked with the log system";
+ die "something's wicked with the log system";
}
=20
Here's a sample Unix-domain client:
@@ -1198,10 +1203,10 @@ Here's a sample Unix-domain client:
my ($rendezvous, $line);
=20
$rendezvous =3D shift || 'catsock';
=2D socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
=2D connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
+ socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
+ connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
while (defined($line =3D <SOCK>)) {
=2D print $line;
+ print $line;
}
exit;
=20
@@ -1222,10 +1227,10 @@ to be on the localhost, and thus everything works=20
right.
my $uaddr =3D sockaddr_un($NAME);
my $proto =3D getprotobyname('tcp');
=20
=2D socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
+ socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
unlink($NAME);
=2D bind (Server, $uaddr) || die "bind: $!";
=2D listen(Server,SOMAXCONN) || die "listen: $!";
+ bind (Server, $uaddr) || die "bind: $!";
+ listen(Server,SOMAXCONN) || die "listen: $!";
=20
logmsg "server started on $NAME";
=20
@@ -1233,49 +1238,49 @@ to be on the localhost, and thus everything works=20
right.
=20
use POSIX ":sys_wait_h";
sub REAPER {
=2D my $child;
+ my $child;
while (($waitedpid =3D waitpid(-1,WNOHANG)) > 0) {
=2D logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
=2D }
=2D $SIG{CHLD} =3D \&REAPER; # loathe SysV
+ logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
+ }
+ $SIG{CHLD} =3D \&REAPER; # loathe SysV
}
=20
$SIG{CHLD} =3D \&REAPER;
=20
=20
for ( $waitedpid =3D 0;
=2D accept(Client,Server) || $waitedpid;
=2D $waitedpid =3D 0, close Client)
+ accept(Client,Server) || $waitedpid;
+ $waitedpid =3D 0, close Client)
{
=2D next if $waitedpid;
=2D logmsg "connection on $NAME";
=2D spawn sub {
=2D print "Hello there, it's now ", scalar localtime, "\n";
=2D exec '/usr/games/fortune' or die "can't exec fortune: $!";
=2D };
+ next if $waitedpid;
+ logmsg "connection on $NAME";
+ spawn sub {
+ print "Hello there, it's now ", scalar localtime, "\n";
+ exec '/usr/games/fortune' or die "can't exec fortune: $!";
+ };
}
=20
sub spawn {
=2D my $coderef =3D shift;
=2D
=2D unless (@_ =3D=3D 0 && $coderef && ref($coderef) eq 'CODE') {
=2D confess "usage: spawn CODEREF";
=2D }
=2D
=2D my $pid;
=2D if (!defined($pid =3D fork)) {
=2D logmsg "cannot fork: $!";
=2D return;
=2D } elsif ($pid) {
=2D logmsg "begat $pid";
=2D return; # I'm the parent
=2D }
=2D # else I'm the child -- go spawn
=2D
=2D open(STDIN, "<&Client") || die "can't dup client to stdin";
=2D open(STDOUT, ">&Client") || die "can't dup client to stdout";
=2D ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
=2D exit &$coderef();
+ my $coderef =3D shift;
+
+ unless (@_ =3D=3D 0 && $coderef && ref($coderef) eq 'CODE') {
+ confess "usage: spawn CODEREF";
+ }
+
+ my $pid;
+ if (!defined($pid =3D fork)) {
+ logmsg "cannot fork: $!";
+ return;
+ } elsif ($pid) {
+ logmsg "begat $pid";
+ return; # I'm the parent
+ }
+ # else I'm the child -- go spawn
+
+ open(STDIN, "<&Client") || die "can't dup client to stdin";
+ open(STDOUT, ">&Client") || die "can't dup client to stdout";
+ ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
+ exit &$coderef();
}
=20
As you see, it's remarkably similar to the Internet domain TCP server, so
@@ -1315,11 +1320,11 @@ that the server there cares to provide.
#!/usr/bin/perl -w
use IO::Socket;
$remote =3D IO::Socket::INET->new(
=2D Proto =3D> "tcp",
=2D PeerAddr =3D> "localhost",
=2D PeerPort =3D> "daytime(13)",
=2D )
=2D or die "cannot connect to daytime port at localhost";
+ Proto =3D> "tcp",
+ PeerAddr =3D> "localhost",
+ PeerPort =3D> "daytime(13)",
+ )
+ or die "cannot connect to daytime port at localhost";
while ( <$remote> ) { print }
=20
When you run this program, you should get something back that
@@ -1389,15 +1394,15 @@ something to the server before fetching the server'=
s=20
response.
$EOL =3D "\015\012";
$BLANK =3D $EOL x 2;
foreach $document ( @ARGV ) {
=2D $remote =3D IO::Socket::INET->new( Proto =3D> "tcp",
=2D PeerAddr =3D> $host,
=2D PeerPort =3D> "http(80)",
=2D );
=2D unless ($remote) { die "cannot connect to http daemon on $host" }
=2D $remote->autoflush(1);
=2D print $remote "GET $document HTTP/1.0" . $BLANK;
=2D while ( <$remote> ) { print }
=2D close $remote;
+ $remote =3D IO::Socket::INET->new( Proto =3D> "tcp",
+ PeerAddr =3D> $host,
+ PeerPort =3D> "http(80)",
+ );
+ unless ($remote) { die "cannot connect to http daemon on $host" }
+ $remote->autoflush(1);
+ print $remote "GET $document HTTP/1.0" . $BLANK;
+ while ( <$remote> ) { print }
+ close $remote;
}
=20
The web server handing the "http" service, which is assumed to be at
@@ -1472,11 +1477,11 @@ Here's the code:
=20
# create a tcp connection to the specified host and port
$handle =3D IO::Socket::INET->new(Proto =3D> "tcp",
=2D PeerAddr =3D> $host,
=2D PeerPort =3D> $port)
=2D or die "can't connect to port $port on $host: $!";
+ PeerAddr =3D> $host,
+ PeerPort =3D> $port)
+ or die "can't connect to port $port on $host: $!";
=20
=2D $handle->autoflush(1); # so output gets there right away
+ $handle->autoflush(1); # so output gets there right away
print STDERR "[Connected to $host:$port]\n";
=20
# split the program into two processes, identical twins
@@ -1484,18 +1489,18 @@ Here's the code:
=20
# the if{} block runs only in the parent process
if ($kidpid) {
=2D # copy the socket to standard output
=2D while (defined ($line =3D <$handle>)) {
=2D print STDOUT $line;
=2D }
=2D kill("TERM", $kidpid); # send SIGTERM to child
+ # copy the socket to standard output
+ while (defined ($line =3D <$handle>)) {
+ print STDOUT $line;
+ }
+ kill("TERM", $kidpid); # send SIGTERM to child
}
# the else{} block runs only in the child process
else {
=2D # copy standard input to the socket
=2D while (defined ($line =3D <STDIN>)) {
=2D print $handle $line;
=2D }
+ # copy standard input to the socket
+ while (defined ($line =3D <STDIN>)) {
+ print $handle $line;
+ }
}
=20
The C<kill> function in the parent's C<if> block is there to send a
@@ -1509,7 +1514,7 @@ following:
=20
my $byte;
while (sysread($handle, $byte, 1) =3D=3D 1) {
=2D print STDOUT $byte;
+ print STDOUT $byte;
}
=20
Making a system call for each byte you want to read is not very efficient
@@ -1578,9 +1583,9 @@ Here's the code. We'll
=20
#!/usr/bin/perl -w
use IO::Socket;
=2D use Net::hostent; # for OO version of gethostbyaddr
+ use Net::hostent; # for OO version of gethostbyaddr
=20
=2D $PORT =3D 9000; # pick something not in use
+ $PORT =3D 9000; # pick something not in use
=20
$server =3D IO::Socket::INET->new( Proto =3D> 'tcp',
LocalPort =3D> $PORT,
@@ -1597,7 +1602,7 @@ Here's the code. We'll
printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client-
>peerhost;
print $client "Command? ";
while ( <$client>) {
=2D next unless /\S/; # blank line
+ next unless /\S/; # blank line
if (/quit|exit/i) { last; }
elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
elsif (/who/i ) { print $client `who 2>&1`; }
@@ -1641,8 +1646,8 @@ with TCP, you'd have to use a different socket handle=
=20
for each host.
use Sys::Hostname;
=20
my ( $count, $hisiaddr, $hispaddr, $histime,
=2D $host, $iaddr, $paddr, $port, $proto,
=2D $rin, $rout, $rtime, $SECS_of_70_YEARS);
+ $host, $iaddr, $paddr, $port, $proto,
+ $rin, $rout, $rtime, $SECS_of_70_YEARS);
=20
$SECS_of_70_YEARS =3D 2208988800;
=20
@@ -1658,10 +1663,10 @@ with TCP, you'd have to use a different socket hand=
le=20
for each host.
printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
$count =3D 0;
for $host (@ARGV) {
=2D $count++;
=2D $hisiaddr =3D inet_aton($host) || die "unknown host";
=2D $hispaddr =3D sockaddr_in($port, $hisiaddr);
=2D defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
+ $count++;
+ $hisiaddr =3D inet_aton($host) || die "unknown host";
+ $hispaddr =3D sockaddr_in($port, $hisiaddr);
+ defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
}
=20
$rin =3D '';
@@ -1669,14 +1674,14 @@ with TCP, you'd have to use a different socket hand=
le=20
for each host.
=20
# timeout after 10.0 seconds
while ($count && select($rout =3D $rin, undef, undef, 10.0)) {
=2D $rtime =3D '';
=2D ($hispaddr =3D recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
=2D ($port, $hisiaddr) =3D sockaddr_in($hispaddr);
=2D $host =3D gethostbyaddr($hisiaddr, AF_INET);
=2D $histime =3D unpack("N", $rtime) - $SECS_of_70_YEARS;
=2D printf "%-12s ", $host;
=2D printf "%8d %s\n", $histime - time, scalar localtime($histime);
=2D $count--;
+ $rtime =3D '';
+ ($hispaddr =3D recv(SOCKET, $rtime, 4, 0)) || die "recv: =
$!";
+ ($port, $hisiaddr) =3D sockaddr_in($hispaddr);
+ $host =3D gethostbyaddr($hisiaddr, AF_INET);
+ $histime =3D unpack("N", $rtime) - $SECS_of_70_YEARS;
+ printf "%-12s ", $host;
+ printf "%8d %s\n", $histime - time, scalar localtime($histime);
+ $count--;
}
=20
Note that this example does not include any retries and may consequently
=2D-=20
=2D----------------------------------------------------------------
Shlomi Fish http://www.shlomifish.org/
http://www.shlomifish.org/humour/ways_to_do_it.html
God considered inflicting XSLT as the tenth plague of Egypt, but then
decided against it because he thought it would be too evil.
Please reply to list if it's a mailing list post - http://shlom.in/reply .