Battle namespace pollution.
[p5sagit/p5-mst-13.2.git] / pod / perlipc.pod
CommitLineData
a0d0e21e 1=head1 NAME
2
184e9718 3perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores)
a0d0e21e 4
5=head1 DESCRIPTION
6
4633a7c4 7The basic IPC facilities of Perl are built out of the good old Unix
8signals, named pipes, pipe opens, the Berkeley socket routines, and SysV
9IPC calls. Each is used in slightly different situations.
10
11=head1 Signals
12
13Perl uses a simple signal handling model: the %SIG hash contains names or
14references of user-installed signal handlers. These handlers will be called
15with an argument which is the name of the signal that triggered it. A
16signal may be generated intentionally from a particular keyboard sequence like
a2eb9003 17control-C or control-Z, sent to you from another process, or
4633a7c4 18triggered automatically by the kernel when special events transpire, like
54310121 19a child process exiting, your process running out of stack space, or
4633a7c4 20hitting file size limit.
21
22For example, to trap an interrupt signal, set up a handler like this.
7b05b7e3 23Do as little as you possibly can in your handler; notice how all we do is
24set a global variable and then raise an exception. That's because on most
25systems, libraries are not re-entrant; particularly, memory allocation and
26I/O routines are not. That means that doing nearly I<anything> in your
27handler could in theory trigger a memory fault and subsequent core dump.
4633a7c4 28
29 sub catch_zap {
30 my $signame = shift;
31 $shucks++;
32 die "Somebody sent me a SIG$signame";
54310121 33 }
4633a7c4 34 $SIG{INT} = 'catch_zap'; # could fail in modules
35 $SIG{INT} = \&catch_zap; # best strategy
36
37The names of the signals are the ones listed out by C<kill -l> on your
38system, or you can retrieve them from the Config module. Set up an
39@signame list indexed by number to get the name and a %signo table
40indexed by name to get the number:
41
42 use Config;
43 defined $Config{sig_name} || die "No sigs?";
44 foreach $name (split(' ', $Config{sig_name})) {
45 $signo{$name} = $i;
46 $signame[$i] = $name;
47 $i++;
54310121 48 }
4633a7c4 49
6a3992aa 50So to check whether signal 17 and SIGALRM were the same, do just this:
4633a7c4 51
52 print "signal #17 = $signame[17]\n";
54310121 53 if ($signo{ALRM}) {
4633a7c4 54 print "SIGALRM is $signo{ALRM}\n";
54310121 55 }
4633a7c4 56
57You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
58the handler, in which case Perl will try to discard the signal or do the
f648820c 59default thing.
60
19799a22 61On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
f648820c 62has special behavior with respect to a value of C<'IGNORE'>.
63Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
64not creating zombie processes when the parent process fails to C<wait()>
65on its child processes (i.e. child processes are automatically reaped).
66Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
67C<-1> on such platforms.
68
69Some signals can be neither trapped nor ignored, such as
4633a7c4 70the KILL and STOP (but not the TSTP) signals. One strategy for
71temporarily ignoring signals is to use a local() statement, which will be
72automatically restored once your block is exited. (Remember that local()
73values are "inherited" by functions called from within that block.)
74
75 sub precious {
76 local $SIG{INT} = 'IGNORE';
77 &more_functions;
54310121 78 }
4633a7c4 79 sub more_functions {
80 # interrupts still ignored, for now...
54310121 81 }
4633a7c4 82
83Sending a signal to a negative process ID means that you send the signal
fb73857a 84to the entire Unix process-group. This code sends a hang-up signal to all
85processes in the current process group (and sets $SIG{HUP} to IGNORE so
86it doesn't kill itself):
4633a7c4 87
88 {
89 local $SIG{HUP} = 'IGNORE';
90 kill HUP => -$$;
91 # snazzy writing of: kill('HUP', -$$)
92 }
a0d0e21e 93
4633a7c4 94Another interesting signal to send is signal number zero. This doesn't
95actually affect another process, but instead checks whether it's alive
54310121 96or has changed its UID.
a0d0e21e 97
4633a7c4 98 unless (kill 0 => $kid_pid) {
99 warn "something wicked happened to $kid_pid";
54310121 100 }
a0d0e21e 101
4633a7c4 102You might also want to employ anonymous functions for simple signal
103handlers:
a0d0e21e 104
4633a7c4 105 $SIG{INT} = sub { die "\nOutta here!\n" };
a0d0e21e 106
4633a7c4 107But that will be problematic for the more complicated handlers that need
54310121 108to reinstall themselves. Because Perl's signal mechanism is currently
184e9718 109based on the signal(3) function from the C library, you may sometimes be so
4633a7c4 110misfortunate as to run on systems where that function is "broken", that
111is, it behaves in the old unreliable SysV way rather than the newer, more
112reasonable BSD and POSIX fashion. So you'll see defensive people writing
113signal handlers like this:
a0d0e21e 114
54310121 115 sub REAPER {
4633a7c4 116 $waitedpid = wait;
6a3992aa 117 # loathe sysV: it makes us not only reinstate
118 # the handler, but place it after the wait
54310121 119 $SIG{CHLD} = \&REAPER;
4633a7c4 120 }
121 $SIG{CHLD} = \&REAPER;
122 # now do something that forks...
123
124or even the more elaborate:
125
6a3992aa 126 use POSIX ":sys_wait_h";
54310121 127 sub REAPER {
4633a7c4 128 my $child;
4633a7c4 129 while ($child = waitpid(-1,WNOHANG)) {
130 $Kid_Status{$child} = $?;
54310121 131 }
6a3992aa 132 $SIG{CHLD} = \&REAPER; # still loathe sysV
4633a7c4 133 }
134 $SIG{CHLD} = \&REAPER;
135 # do something that forks...
136
137Signal handling is also used for timeouts in Unix, While safely
138protected within an C<eval{}> block, you set a signal handler to trap
139alarm signals and then schedule to have one delivered to you in some
140number of seconds. Then try your blocking operation, clearing the alarm
141when it's done but not before you've exited your C<eval{}> block. If it
142goes off, you'll use die() to jump out of the block, much as you might
143using longjmp() or throw() in other languages.
144
145Here's an example:
146
54310121 147 eval {
4633a7c4 148 local $SIG{ALRM} = sub { die "alarm clock restart" };
54310121 149 alarm 10;
4633a7c4 150 flock(FH, 2); # blocking write lock
54310121 151 alarm 0;
4633a7c4 152 };
153 if ($@ and $@ !~ /alarm clock restart/) { die }
154
155For more complex signal handling, you might see the standard POSIX
156module. Lamentably, this is almost entirely undocumented, but
157the F<t/lib/posix.t> file from the Perl source distribution has some
158examples in it.
159
160=head1 Named Pipes
161
162A named pipe (often referred to as a FIFO) is an old Unix IPC
163mechanism for processes communicating on the same machine. It works
54310121 164just like a regular, connected anonymous pipes, except that the
4633a7c4 165processes rendezvous using a filename and don't have to be related.
166
167To create a named pipe, use the Unix command mknod(1) or on some
168systems, mkfifo(1). These may not be in your normal path.
169
170 # system return val is backwards, so && not ||
171 #
172 $ENV{PATH} .= ":/etc:/usr/etc";
54310121 173 if ( system('mknod', $path, 'p')
4633a7c4 174 && system('mkfifo', $path) )
175 {
5a964f20 176 die "mk{nod,fifo} $path failed";
54310121 177 }
4633a7c4 178
179
180A fifo is convenient when you want to connect a process to an unrelated
181one. When you open a fifo, the program will block until there's something
54310121 182on the other end.
4633a7c4 183
184For example, let's say you'd like to have your F<.signature> file be a
185named pipe that has a Perl program on the other end. Now every time any
6a3992aa 186program (like a mailer, news reader, finger program, etc.) tries to read
4633a7c4 187from that file, the reading program will block and your program will
6a3992aa 188supply the new signature. We'll use the pipe-checking file test B<-p>
4633a7c4 189to find out whether anyone (or anything) has accidentally removed our fifo.
190
191 chdir; # go home
192 $FIFO = '.signature';
193 $ENV{PATH} .= ":/etc:/usr/games";
194
195 while (1) {
196 unless (-p $FIFO) {
197 unlink $FIFO;
54310121 198 system('mknod', $FIFO, 'p')
4633a7c4 199 && die "can't mknod $FIFO: $!";
54310121 200 }
4633a7c4 201
202 # next line blocks until there's a reader
203 open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
204 print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
205 close FIFO;
6a3992aa 206 sleep 2; # to avoid dup signals
4633a7c4 207 }
a0d0e21e 208
5a964f20 209=head2 WARNING
210
211By installing Perl code to deal with signals, you're exposing yourself
212to danger from two things. First, few system library functions are
213re-entrant. If the signal interrupts while Perl is executing one function
214(like malloc(3) or printf(3)), and your signal handler then calls the
215same function again, you could get unpredictable behavior--often, a
216core dump. Second, Perl isn't itself re-entrant at the lowest levels.
217If the signal interrupts Perl while Perl is changing its own internal
218data structures, similarly unpredictable behaviour may result.
219
220There are two things you can do, knowing this: be paranoid or be
221pragmatic. The paranoid approach is to do as little as possible in your
222signal handler. Set an existing integer variable that already has a
223value, and return. This doesn't help you if you're in a slow system call,
224which will just restart. That means you have to C<die> to longjump(3) out
225of the handler. Even this is a little cavalier for the true paranoiac,
226who avoids C<die> in a handler because the system I<is> out to get you.
227The pragmatic approach is to say ``I know the risks, but prefer the
228convenience'', and to do anything you want in your signal handler,
229prepared to clean up core dumps now and again.
230
231To forbid signal handlers altogether would bars you from
232many interesting programs, including virtually everything in this manpage,
233since you could no longer even write SIGCHLD handlers. Their dodginess
234is expected to be addresses in the 5.005 release.
235
a0d0e21e 236
4633a7c4 237=head1 Using open() for IPC
238
239Perl's basic open() statement can also be used for unidirectional interprocess
240communication by either appending or prepending a pipe symbol to the second
a2eb9003 241argument to open(). Here's how to start something up in a child process you
4633a7c4 242intend to write to:
243
54310121 244 open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
4633a7c4 245 || die "can't fork: $!";
246 local $SIG{PIPE} = sub { die "spooler pipe broke" };
247 print SPOOLER "stuff\n";
248 close SPOOLER || die "bad spool: $! $?";
249
250And here's how to start up a child process you intend to read from:
251
252 open(STATUS, "netstat -an 2>&1 |")
253 || die "can't fork: $!";
254 while (<STATUS>) {
255 next if /^(tcp|udp)/;
256 print;
54310121 257 }
a2eb9003 258 close STATUS || die "bad netstat: $! $?";
4633a7c4 259
260If one can be sure that a particular program is a Perl script that is
261expecting filenames in @ARGV, the clever programmer can write something
262like this:
263
5a964f20 264 % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
4633a7c4 265
266and irrespective of which shell it's called from, the Perl program will
267read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
268in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
269file. Pretty nifty, eh?
270
54310121 271You might notice that you could use backticks for much the
4633a7c4 272same effect as opening a pipe for reading:
273
274 print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
275 die "bad netstat" if $?;
276
277While this is true on the surface, it's much more efficient to process the
278file one line or record at a time because then you don't have to read the
19799a22 279whole thing into memory at once. It also gives you finer control of the
4633a7c4 280whole process, letting you to kill off the child process early if you'd
281like.
282
283Be careful to check both the open() and the close() return values. If
284you're I<writing> to a pipe, you should also trap SIGPIPE. Otherwise,
285think of what happens when you start up a pipe to a command that doesn't
286exist: the open() will in all likelihood succeed (it only reflects the
287fork()'s success), but then your output will fail--spectacularly. Perl
288can't know whether the command worked because your command is actually
289running in a separate process whose exec() might have failed. Therefore,
6a3992aa 290while readers of bogus commands return just a quick end of file, writers
4633a7c4 291to bogus command will trigger a signal they'd better be prepared to
292handle. Consider:
293
5a964f20 294 open(FH, "|bogus") or die "can't fork: $!";
295 print FH "bang\n" or die "can't write: $!";
296 close FH or die "can't close: $!";
297
298That won't blow up until the close, and it will blow up with a SIGPIPE.
299To catch it, you could use this:
300
301 $SIG{PIPE} = 'IGNORE';
302 open(FH, "|bogus") or die "can't fork: $!";
303 print FH "bang\n" or die "can't write: $!";
304 close FH or die "can't close: status=$?";
4633a7c4 305
68dc0745 306=head2 Filehandles
307
5a964f20 308Both the main process and any child processes it forks share the same
309STDIN, STDOUT, and STDERR filehandles. If both processes try to access
45bc9206 310them at once, strange things can happen. You may also want to close
5a964f20 311or reopen the filehandles for the child. You can get around this by
312opening your pipe with open(), but on some systems this means that the
313child process cannot outlive the parent.
68dc0745 314
315=head2 Background Processes
316
317You can run a command in the background with:
318
7b05b7e3 319 system("cmd &");
68dc0745 320
321The command's STDOUT and STDERR (and possibly STDIN, depending on your
322shell) will be the same as the parent's. You won't need to catch
323SIGCHLD because of the double-fork taking place (see below for more
324details).
325
326=head2 Complete Dissociation of Child from Parent
327
328In some cases (starting server processes, for instance) you'll want to
893af57a 329completely dissociate the child process from the parent. This is
330often called daemonization. A well behaved daemon will also chdir()
331to the root directory (so it doesn't prevent unmounting the filesystem
332containing the directory from which it was launched) and redirect its
333standard file descriptors from and to F</dev/null> (so that random
334output doesn't wind up on the user's terminal).
335
336 use POSIX 'setsid';
337
338 sub daemonize {
339 chdir '/' or die "Can't chdir to /: $!";
340 open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
341 open STDOUT, '>/dev/null'
342 or die "Can't write to /dev/null: $!";
343 defined(my $pid = fork) or die "Can't fork: $!";
344 exit if $pid;
345 setsid or die "Can't start a new session: $!";
346 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
347 }
5a964f20 348
893af57a 349The fork() has to come before the setsid() to ensure that you aren't a
350process group leader (the setsid() will fail if you are). If your
351system doesn't have the setsid() function, open F</dev/tty> and use the
352C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
5a964f20 353
893af57a 354Non-Unix users should check their Your_OS::Process module for other
355solutions.
68dc0745 356
4633a7c4 357=head2 Safe Pipe Opens
358
359Another interesting approach to IPC is making your single program go
360multiprocess and communicate between (or even amongst) yourselves. The
361open() function will accept a file argument of either C<"-|"> or C<"|-">
362to do a very interesting thing: it forks a child connected to the
363filehandle you've opened. The child is running the same program as the
364parent. This is useful for safely opening a file when running under an
365assumed UID or GID, for example. If you open a pipe I<to> minus, you can
366write to the filehandle you opened and your kid will find it in his
367STDIN. If you open a pipe I<from> minus, you can read from the filehandle
368you opened whatever your kid writes to his STDOUT.
369
370 use English;
371 my $sleep_count = 0;
372
54310121 373 do {
c07a80fd 374 $pid = open(KID_TO_WRITE, "|-");
4633a7c4 375 unless (defined $pid) {
376 warn "cannot fork: $!";
377 die "bailing out" if $sleep_count++ > 6;
378 sleep 10;
54310121 379 }
4633a7c4 380 } until defined $pid;
381
382 if ($pid) { # parent
c07a80fd 383 print KID_TO_WRITE @some_data;
384 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4 385 } else { # child
386 ($EUID, $EGID) = ($UID, $GID); # suid progs only
54310121 387 open (FILE, "> /safe/file")
4633a7c4 388 || die "can't open /safe/file: $!";
389 while (<STDIN>) {
390 print FILE; # child's STDIN is parent's KID
54310121 391 }
4633a7c4 392 exit; # don't forget this
54310121 393 }
4633a7c4 394
395Another common use for this construct is when you need to execute
396something without the shell's interference. With system(), it's
54310121 397straightforward, but you can't use a pipe open or backticks safely.
4633a7c4 398That's because there's no way to stop the shell from getting its hands on
399your arguments. Instead, use lower-level control to call exec() directly.
400
54310121 401Here's a safe backtick or pipe open for read:
4633a7c4 402
403 # add error processing as above
c07a80fd 404 $pid = open(KID_TO_READ, "-|");
4633a7c4 405
406 if ($pid) { # parent
c07a80fd 407 while (<KID_TO_READ>) {
4633a7c4 408 # do something interesting
54310121 409 }
c07a80fd 410 close(KID_TO_READ) || warn "kid exited $?";
4633a7c4 411
412 } else { # child
413 ($EUID, $EGID) = ($UID, $GID); # suid only
414 exec($program, @options, @args)
415 || die "can't exec program: $!";
416 # NOTREACHED
54310121 417 }
4633a7c4 418
419
420And here's a safe pipe open for writing:
421
422 # add error processing as above
c07a80fd 423 $pid = open(KID_TO_WRITE, "|-");
4633a7c4 424 $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
425
426 if ($pid) { # parent
427 for (@data) {
c07a80fd 428 print KID_TO_WRITE;
54310121 429 }
c07a80fd 430 close(KID_TO_WRITE) || warn "kid exited $?";
4633a7c4 431
432 } else { # child
433 ($EUID, $EGID) = ($UID, $GID);
434 exec($program, @options, @args)
435 || die "can't exec program: $!";
436 # NOTREACHED
54310121 437 }
4633a7c4 438
439Note that these operations are full Unix forks, which means they may not be
440correctly implemented on alien systems. Additionally, these are not true
54310121 441multithreading. If you'd like to learn more about threading, see the
184e9718 442F<modules> file mentioned below in the SEE ALSO section.
4633a7c4 443
7b05b7e3 444=head2 Bidirectional Communication with Another Process
4633a7c4 445
446While this works reasonably well for unidirectional communication, what
447about bidirectional communication? The obvious thing you'd like to do
448doesn't actually work:
449
c07a80fd 450 open(PROG_FOR_READING_AND_WRITING, "| some program |")
4633a7c4 451
54310121 452and if you forget to use the B<-w> flag, then you'll miss out
4633a7c4 453entirely on the diagnostic message:
454
455 Can't do bidirectional pipe at -e line 1.
456
457If you really want to, you can use the standard open2() library function
7b05b7e3 458to catch both ends. There's also an open3() for tridirectional I/O so you
4633a7c4 459can also catch your child's STDERR, but doing so would then require an
460awkward select() loop and wouldn't allow you to use normal Perl input
461operations.
462
463If you look at its source, you'll see that open2() uses low-level
5a964f20 464primitives like Unix pipe() and exec() calls to create all the connections.
4633a7c4 465While it might have been slightly more efficient by using socketpair(), it
466would have then been even less portable than it already is. The open2()
467and open3() functions are unlikely to work anywhere except on a Unix
468system or some other one purporting to be POSIX compliant.
469
470Here's an example of using open2():
471
472 use FileHandle;
473 use IPC::Open2;
5a964f20 474 $pid = open2(*Reader, *Writer, "cat -u -n" );
4633a7c4 475 print Writer "stuff\n";
476 $got = <Reader>;
477
6a3992aa 478The problem with this is that Unix buffering is really going to
479ruin your day. Even though your C<Writer> filehandle is auto-flushed,
4633a7c4 480and the process on the other end will get your data in a timely manner,
6a3992aa 481you can't usually do anything to force it to give it back to you
54310121 482in a similarly quick fashion. In this case, we could, because we
4633a7c4 483gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix
484commands are designed to operate over pipes, so this seldom works
54310121 485unless you yourself wrote the program on the other end of the
4633a7c4 486double-ended pipe.
487
54310121 488A solution to this is the nonstandard F<Comm.pl> library. It uses
4633a7c4 489pseudo-ttys to make your program behave more reasonably:
490
491 require 'Comm.pl';
492 $ph = open_proc('cat -n');
493 for (1..10) {
494 print $ph "a line\n";
495 print "got back ", scalar <$ph>;
496 }
a0d0e21e 497
4633a7c4 498This way you don't have to have control over the source code of the
54310121 499program you're using. The F<Comm> library also has expect()
500and interact() functions. Find the library (and we hope its
4633a7c4 501successor F<IPC::Chat>) at your nearest CPAN archive as detailed
184e9718 502in the SEE ALSO section below.
a0d0e21e 503
c8db1d39 504The newer Expect.pm module from CPAN also addresses this kind of thing.
505This module requires two other modules from CPAN: IO::Pty and IO::Stty.
506It sets up a pseudo-terminal to interact with programs that insist on
507using talking to the terminal device driver. If your system is
508amongst those supported, this may be your best bet.
509
5a964f20 510=head2 Bidirectional Communication with Yourself
511
512If you want, you may make low-level pipe() and fork()
513to stitch this together by hand. This example only
514talks to itself, but you could reopen the appropriate
515handles to STDIN and STDOUT and call other processes.
516
517 #!/usr/bin/perl -w
518 # pipe1 - bidirectional communication using two pipe pairs
519 # designed for the socketpair-challenged
520 use IO::Handle; # thousands of lines just for autoflush :-(
521 pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
522 pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
523 CHILD_WTR->autoflush(1);
524 PARENT_WTR->autoflush(1);
525
526 if ($pid = fork) {
527 close PARENT_RDR; close PARENT_WTR;
528 print CHILD_WTR "Parent Pid $$ is sending this\n";
529 chomp($line = <CHILD_RDR>);
530 print "Parent Pid $$ just read this: `$line'\n";
531 close CHILD_RDR; close CHILD_WTR;
532 waitpid($pid,0);
533 } else {
534 die "cannot fork: $!" unless defined $pid;
535 close CHILD_RDR; close CHILD_WTR;
536 chomp($line = <PARENT_RDR>);
537 print "Child Pid $$ just read this: `$line'\n";
538 print PARENT_WTR "Child Pid $$ is sending this\n";
539 close PARENT_RDR; close PARENT_WTR;
540 exit;
541 }
542
543But you don't actually have to make two pipe calls. If you
544have the socketpair() system call, it will do this all for you.
545
546 #!/usr/bin/perl -w
547 # pipe2 - bidirectional communication using socketpair
548 # "the best ones always go both ways"
549
550 use Socket;
551 use IO::Handle; # thousands of lines just for autoflush :-(
552 # We say AF_UNIX because although *_LOCAL is the
553 # POSIX 1003.1g form of the constant, many machines
554 # still don't have it.
555 socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
556 or die "socketpair: $!";
557
558 CHILD->autoflush(1);
559 PARENT->autoflush(1);
560
561 if ($pid = fork) {
562 close PARENT;
563 print CHILD "Parent Pid $$ is sending this\n";
564 chomp($line = <CHILD>);
565 print "Parent Pid $$ just read this: `$line'\n";
566 close CHILD;
567 waitpid($pid,0);
568 } else {
569 die "cannot fork: $!" unless defined $pid;
570 close CHILD;
571 chomp($line = <PARENT>);
572 print "Child Pid $$ just read this: `$line'\n";
573 print PARENT "Child Pid $$ is sending this\n";
574 close PARENT;
575 exit;
576 }
577
4633a7c4 578=head1 Sockets: Client/Server Communication
a0d0e21e 579
6a3992aa 580While not limited to Unix-derived operating systems (e.g., WinSock on PCs
4633a7c4 581provides socket support, as do some VMS libraries), you may not have
184e9718 582sockets on your system, in which case this section probably isn't going to do
6a3992aa 583you much good. With sockets, you can do both virtual circuits (i.e., TCP
584streams) and datagrams (i.e., UDP packets). You may be able to do even more
4633a7c4 585depending on your system.
586
587The Perl function calls for dealing with sockets have the same names as
588the corresponding system calls in C, but their arguments tend to differ
589for two reasons: first, Perl filehandles work differently than C file
590descriptors. Second, Perl already knows the length of its strings, so you
591don't need to pass that information.
a0d0e21e 592
4633a7c4 593One of the major problems with old socket code in Perl was that it used
594hard-coded values for some of the constants, which severely hurt
595portability. If you ever see code that does anything like explicitly
596setting C<$AF_INET = 2>, you know you're in for big trouble: An
597immeasurably superior approach is to use the C<Socket> module, which more
598reliably grants access to various constants and functions you'll need.
a0d0e21e 599
68dc0745 600If you're not writing a server/client for an existing protocol like
601NNTP or SMTP, you should give some thought to how your server will
602know when the client has finished talking, and vice-versa. Most
603protocols are based on one-line messages and responses (so one party
4a6725af 604knows the other has finished when a "\n" is received) or multi-line
68dc0745 605messages and responses that end with a period on an empty line
606("\n.\n" terminates a message/response).
607
5a964f20 608=head2 Internet Line Terminators
609
610The Internet line terminator is "\015\012". Under ASCII variants of
611Unix, that could usually be written as "\r\n", but under other systems,
612"\r\n" might at times be "\015\015\012", "\012\012\015", or something
613completely different. The standards specify writing "\015\012" to be
614conformant (be strict in what you provide), but they also recommend
615accepting a lone "\012" on input (but be lenient in what you require).
616We haven't always been very good about that in the code in this manpage,
617but unless you're on a Mac, you'll probably be ok.
618
4633a7c4 619=head2 Internet TCP Clients and Servers
a0d0e21e 620
4633a7c4 621Use Internet-domain sockets when you want to do client-server
622communication that might extend to machines outside of your own system.
623
624Here's a sample TCP client using Internet-domain sockets:
625
626 #!/usr/bin/perl -w
4633a7c4 627 use strict;
628 use Socket;
629 my ($remote,$port, $iaddr, $paddr, $proto, $line);
630
631 $remote = shift || 'localhost';
632 $port = shift || 2345; # random port
633 if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
634 die "No port" unless $port;
635 $iaddr = inet_aton($remote) || die "no host: $remote";
636 $paddr = sockaddr_in($port, $iaddr);
637
638 $proto = getprotobyname('tcp');
639 socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
640 connect(SOCK, $paddr) || die "connect: $!";
54310121 641 while (defined($line = <SOCK>)) {
4633a7c4 642 print $line;
54310121 643 }
4633a7c4 644
645 close (SOCK) || die "close: $!";
646 exit;
647
648And here's a corresponding server to go along with it. We'll
649leave the address as INADDR_ANY so that the kernel can choose
54310121 650the appropriate interface on multihomed hosts. If you want sit
c07a80fd 651on a particular interface (like the external side of a gateway
652or firewall machine), you should fill this in with your real address
653instead.
654
655 #!/usr/bin/perl -Tw
c07a80fd 656 use strict;
657 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
658 use Socket;
659 use Carp;
5a964f20 660 $EOL = "\015\012";
c07a80fd 661
54310121 662 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
c07a80fd 663
664 my $port = shift || 2345;
665 my $proto = getprotobyname('tcp');
6a3992aa 666 $port = $1 if $port =~ /(\d+)/; # untaint port number
667
c07a80fd 668 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 669 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd 670 pack("l", 1)) || die "setsockopt: $!";
671 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
672 listen(Server,SOMAXCONN) || die "listen: $!";
673
674 logmsg "server started on port $port";
675
676 my $paddr;
677
678 $SIG{CHLD} = \&REAPER;
679
680 for ( ; $paddr = accept(Client,Server); close Client) {
681 my($port,$iaddr) = sockaddr_in($paddr);
682 my $name = gethostbyaddr($iaddr,AF_INET);
683
54310121 684 logmsg "connection from $name [",
685 inet_ntoa($iaddr), "]
c07a80fd 686 at port $port";
687
54310121 688 print Client "Hello there, $name, it's now ",
5a964f20 689 scalar localtime, $EOL;
54310121 690 }
c07a80fd 691
54310121 692And here's a multithreaded version. It's multithreaded in that
693like most typical servers, it spawns (forks) a slave server to
c07a80fd 694handle the client request so that the master server can quickly
695go back to service a new client.
4633a7c4 696
697 #!/usr/bin/perl -Tw
4633a7c4 698 use strict;
699 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
a0d0e21e 700 use Socket;
4633a7c4 701 use Carp;
5a964f20 702 $EOL = "\015\012";
a0d0e21e 703
4633a7c4 704 sub spawn; # forward declaration
54310121 705 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
a0d0e21e 706
4633a7c4 707 my $port = shift || 2345;
708 my $proto = getprotobyname('tcp');
80aa6872 709 $port = $1 if $port =~ /(\d+)/; # untaint port number
54310121 710
c07a80fd 711 socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
54310121 712 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
c07a80fd 713 pack("l", 1)) || die "setsockopt: $!";
714 bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
715 listen(Server,SOMAXCONN) || die "listen: $!";
a0d0e21e 716
4633a7c4 717 logmsg "server started on port $port";
a0d0e21e 718
4633a7c4 719 my $waitedpid = 0;
720 my $paddr;
a0d0e21e 721
54310121 722 sub REAPER {
4633a7c4 723 $waitedpid = wait;
6a3992aa 724 $SIG{CHLD} = \&REAPER; # loathe sysV
4633a7c4 725 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
726 }
727
728 $SIG{CHLD} = \&REAPER;
729
54310121 730 for ( $waitedpid = 0;
731 ($paddr = accept(Client,Server)) || $waitedpid;
732 $waitedpid = 0, close Client)
4633a7c4 733 {
6a3992aa 734 next if $waitedpid and not $paddr;
4633a7c4 735 my($port,$iaddr) = sockaddr_in($paddr);
736 my $name = gethostbyaddr($iaddr,AF_INET);
737
54310121 738 logmsg "connection from $name [",
739 inet_ntoa($iaddr), "]
4633a7c4 740 at port $port";
a0d0e21e 741
54310121 742 spawn sub {
5a964f20 743 print "Hello there, $name, it's now ", scalar localtime, $EOL;
744 exec '/usr/games/fortune' # XXX: `wrong' line terminators
4633a7c4 745 or confess "can't exec fortune: $!";
746 };
a0d0e21e 747
54310121 748 }
a0d0e21e 749
4633a7c4 750 sub spawn {
751 my $coderef = shift;
a0d0e21e 752
54310121 753 unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
4633a7c4 754 confess "usage: spawn CODEREF";
a0d0e21e 755 }
4633a7c4 756
757 my $pid;
758 if (!defined($pid = fork)) {
759 logmsg "cannot fork: $!";
760 return;
761 } elsif ($pid) {
762 logmsg "begat $pid";
6a3992aa 763 return; # I'm the parent
4633a7c4 764 }
6a3992aa 765 # else I'm the child -- go spawn
4633a7c4 766
c07a80fd 767 open(STDIN, "<&Client") || die "can't dup client to stdin";
768 open(STDOUT, ">&Client") || die "can't dup client to stdout";
4633a7c4 769 ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
770 exit &$coderef();
54310121 771 }
4633a7c4 772
773This server takes the trouble to clone off a child version via fork() for
774each incoming request. That way it can handle many requests at once,
775which you might not always want. Even if you don't fork(), the listen()
776will allow that many pending connections. Forking servers have to be
777particularly careful about cleaning up their dead children (called
778"zombies" in Unix parlance), because otherwise you'll quickly fill up your
779process table.
780
781We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
782even if we aren't running setuid or setgid. This is always a good idea
783for servers and other programs run on behalf of someone else (like CGI
784scripts), because it lessens the chances that people from the outside will
785be able to compromise your system.
786
787Let's look at another TCP client. This one connects to the TCP "time"
788service on a number of different machines and shows how far their clocks
789differ from the system on which it's being run:
790
791 #!/usr/bin/perl -w
4633a7c4 792 use strict;
793 use Socket;
794
795 my $SECS_of_70_YEARS = 2208988800;
54310121 796 sub ctime { scalar localtime(shift) }
4633a7c4 797
54310121 798 my $iaddr = gethostbyname('localhost');
799 my $proto = getprotobyname('tcp');
800 my $port = getservbyname('time', 'tcp');
4633a7c4 801 my $paddr = sockaddr_in(0, $iaddr);
802 my($host);
803
804 $| = 1;
805 printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
806
807 foreach $host (@ARGV) {
808 printf "%-24s ", $host;
809 my $hisiaddr = inet_aton($host) || die "unknown host";
810 my $hispaddr = sockaddr_in($port, $hisiaddr);
811 socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
812 connect(SOCKET, $hispaddr) || die "bind: $!";
813 my $rtime = ' ';
814 read(SOCKET, $rtime, 4);
815 close(SOCKET);
816 my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
817 printf "%8d %s\n", $histime - time, ctime($histime);
a0d0e21e 818 }
819
4633a7c4 820=head2 Unix-Domain TCP Clients and Servers
821
a2eb9003 822That's fine for Internet-domain clients and servers, but what about local
4633a7c4 823communications? While you can use the same setup, sometimes you don't
824want to. Unix-domain sockets are local to the current host, and are often
54310121 825used internally to implement pipes. Unlike Internet domain sockets, Unix
4633a7c4 826domain sockets can show up in the file system with an ls(1) listing.
827
5a964f20 828 % ls -l /dev/log
4633a7c4 829 srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
a0d0e21e 830
4633a7c4 831You can test for these with Perl's B<-S> file test:
832
833 unless ( -S '/dev/log' ) {
834 die "something's wicked with the print system";
54310121 835 }
4633a7c4 836
837Here's a sample Unix-domain client:
838
839 #!/usr/bin/perl -w
4633a7c4 840 use Socket;
841 use strict;
842 my ($rendezvous, $line);
843
844 $rendezvous = shift || '/tmp/catsock';
845 socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
9607fc9c 846 connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
54310121 847 while (defined($line = <SOCK>)) {
4633a7c4 848 print $line;
54310121 849 }
4633a7c4 850 exit;
851
5a964f20 852And here's a corresponding server. You don't have to worry about silly
853network terminators here because Unix domain sockets are guaranteed
854to be on the localhost, and thus everything works right.
4633a7c4 855
856 #!/usr/bin/perl -Tw
4633a7c4 857 use strict;
858 use Socket;
859 use Carp;
860
861 BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
5a964f20 862 sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
4633a7c4 863
864 my $NAME = '/tmp/catsock';
865 my $uaddr = sockaddr_un($NAME);
866 my $proto = getprotobyname('tcp');
867
c07a80fd 868 socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
4633a7c4 869 unlink($NAME);
c07a80fd 870 bind (Server, $uaddr) || die "bind: $!";
871 listen(Server,SOMAXCONN) || die "listen: $!";
4633a7c4 872
873 logmsg "server started on $NAME";
874
5a964f20 875 my $waitedpid;
876
877 sub REAPER {
878 $waitedpid = wait;
879 $SIG{CHLD} = \&REAPER; # loathe sysV
880 logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
881 }
882
4633a7c4 883 $SIG{CHLD} = \&REAPER;
884
5a964f20 885
54310121 886 for ( $waitedpid = 0;
887 accept(Client,Server) || $waitedpid;
888 $waitedpid = 0, close Client)
4633a7c4 889 {
890 next if $waitedpid;
891 logmsg "connection on $NAME";
54310121 892 spawn sub {
4633a7c4 893 print "Hello there, it's now ", scalar localtime, "\n";
894 exec '/usr/games/fortune' or die "can't exec fortune: $!";
895 };
54310121 896 }
4633a7c4 897
898As you see, it's remarkably similar to the Internet domain TCP server, so
899much so, in fact, that we've omitted several duplicate functions--spawn(),
900logmsg(), ctime(), and REAPER()--which are exactly the same as in the
901other server.
902
903So why would you ever want to use a Unix domain socket instead of a
904simpler named pipe? Because a named pipe doesn't give you sessions. You
905can't tell one process's data from another's. With socket programming,
906you get a separate session for each client: that's why accept() takes two
907arguments.
908
909For example, let's say that you have a long running database server daemon
910that you want folks from the World Wide Web to be able to access, but only
911if they go through a CGI interface. You'd have a small, simple CGI
912program that does whatever checks and logging you feel like, and then acts
913as a Unix-domain client and connects to your private server.
914
7b05b7e3 915=head1 TCP Clients with IO::Socket
916
917For those preferring a higher-level interface to socket programming, the
918IO::Socket module provides an object-oriented approach. IO::Socket is
919included as part of the standard Perl distribution as of the 5.004
920release. If you're running an earlier version of Perl, just fetch
921IO::Socket from CPAN, where you'll also find find modules providing easy
922interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
923NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
924to name a few.
925
926=head2 A Simple Client
927
928Here's a client that creates a TCP connection to the "daytime"
929service at port 13 of the host name "localhost" and prints out everything
930that the server there cares to provide.
931
932 #!/usr/bin/perl -w
933 use IO::Socket;
934 $remote = IO::Socket::INET->new(
935 Proto => "tcp",
936 PeerAddr => "localhost",
937 PeerPort => "daytime(13)",
938 )
939 or die "cannot connect to daytime port at localhost";
940 while ( <$remote> ) { print }
941
942When you run this program, you should get something back that
943looks like this:
944
945 Wed May 14 08:40:46 MDT 1997
946
947Here are what those parameters to the C<new> constructor mean:
948
949=over
950
951=item C<Proto>
952
953This is which protocol to use. In this case, the socket handle returned
954will be connected to a TCP socket, because we want a stream-oriented
955connection, that is, one that acts pretty much like a plain old file.
956Not all sockets are this of this type. For example, the UDP protocol
957can be used to make a datagram socket, used for message-passing.
958
959=item C<PeerAddr>
960
961This is the name or Internet address of the remote host the server is
962running on. We could have specified a longer name like C<"www.perl.com">,
963or an address like C<"204.148.40.9">. For demonstration purposes, we've
964used the special hostname C<"localhost">, which should always mean the
965current machine you're running on. The corresponding Internet address
966for localhost is C<"127.1">, if you'd rather use that.
967
968=item C<PeerPort>
969
970This is the service name or port number we'd like to connect to.
971We could have gotten away with using just C<"daytime"> on systems with a
972well-configured system services file,[FOOTNOTE: The system services file
973is in I</etc/services> under Unix] but just in case, we've specified the
974port number (13) in parentheses. Using just the number would also have
975worked, but constant numbers make careful programmers nervous.
976
977=back
978
979Notice how the return value from the C<new> constructor is used as
980a filehandle in the C<while> loop? That's what's called an indirect
981filehandle, a scalar variable containing a filehandle. You can use
982it the same way you would a normal filehandle. For example, you
983can read one line from it this way:
984
985 $line = <$handle>;
986
987all remaining lines from is this way:
988
989 @lines = <$handle>;
990
991and send a line of data to it this way:
992
993 print $handle "some data\n";
994
995=head2 A Webget Client
996
997Here's a simple client that takes a remote host to fetch a document
998from, and then a list of documents to get from that host. This is a
999more interesting client than the previous one because it first sends
1000something to the server before fetching the server's response.
1001
1002 #!/usr/bin/perl -w
1003 use IO::Socket;
1004 unless (@ARGV > 1) { die "usage: $0 host document ..." }
1005 $host = shift(@ARGV);
5a964f20 1006 $EOL = "\015\012";
1007 $BLANK = $EOL x 2;
7b05b7e3 1008 foreach $document ( @ARGV ) {
1009 $remote = IO::Socket::INET->new( Proto => "tcp",
1010 PeerAddr => $host,
1011 PeerPort => "http(80)",
1012 );
1013 unless ($remote) { die "cannot connect to http daemon on $host" }
1014 $remote->autoflush(1);
5a964f20 1015 print $remote "GET $document HTTP/1.0" . $BLANK;
7b05b7e3 1016 while ( <$remote> ) { print }
1017 close $remote;
1018 }
1019
1020The web server handing the "http" service, which is assumed to be at
1021its standard port, number 80. If your the web server you're trying to
1022connect to is at a different port (like 1080 or 8080), you should specify
1023as the named-parameter pair, C<PeerPort =E<gt> 8080>. The C<autoflush>
1024method is used on the socket because otherwise the system would buffer
1025up the output we sent it. (If you're on a Mac, you'll also need to
1026change every C<"\n"> in your code that sends data over the network to
1027be a C<"\015\012"> instead.)
1028
1029Connecting to the server is only the first part of the process: once you
1030have the connection, you have to use the server's language. Each server
1031on the network has its own little command language that it expects as
1032input. The string that we send to the server starting with "GET" is in
1033HTTP syntax. In this case, we simply request each specified document.
1034Yes, we really are making a new connection for each document, even though
1035it's the same host. That's the way you always used to have to speak HTTP.
1036Recent versions of web browsers may request that the remote server leave
1037the connection open a little while, but the server doesn't have to honor
1038such a request.
1039
1040Here's an example of running that program, which we'll call I<webget>:
1041
5a964f20 1042 % webget www.perl.com /guanaco.html
7b05b7e3 1043 HTTP/1.1 404 File Not Found
1044 Date: Thu, 08 May 1997 18:02:32 GMT
1045 Server: Apache/1.2b6
1046 Connection: close
1047 Content-type: text/html
1048
1049 <HEAD><TITLE>404 File Not Found</TITLE></HEAD>
1050 <BODY><H1>File Not Found</H1>
1051 The requested URL /guanaco.html was not found on this server.<P>
1052 </BODY>
1053
1054Ok, so that's not very interesting, because it didn't find that
1055particular document. But a long response wouldn't have fit on this page.
1056
1057For a more fully-featured version of this program, you should look to
1058the I<lwp-request> program included with the LWP modules from CPAN.
1059
1060=head2 Interactive Client with IO::Socket
1061
1062Well, that's all fine if you want to send one command and get one answer,
1063but what about setting up something fully interactive, somewhat like
1064the way I<telnet> works? That way you can type a line, get the answer,
1065type a line, get the answer, etc.
1066
1067This client is more complicated than the two we've done so far, but if
1068you're on a system that supports the powerful C<fork> call, the solution
1069isn't that rough. Once you've made the connection to whatever service
1070you'd like to chat with, call C<fork> to clone your process. Each of
1071these two identical process has a very simple job to do: the parent
1072copies everything from the socket to standard output, while the child
1073simultaneously copies everything from standard input to the socket.
1074To accomplish the same thing using just one process would be I<much>
1075harder, because it's easier to code two processes to do one thing than it
1076is to code one process to do two things. (This keep-it-simple principle
5a964f20 1077a cornerstones of the Unix philosophy, and good software engineering as
1078well, which is probably why it's spread to other systems.)
7b05b7e3 1079
1080Here's the code:
1081
1082 #!/usr/bin/perl -w
1083 use strict;
1084 use IO::Socket;
1085 my ($host, $port, $kidpid, $handle, $line);
1086
1087 unless (@ARGV == 2) { die "usage: $0 host port" }
1088 ($host, $port) = @ARGV;
1089
1090 # create a tcp connection to the specified host and port
1091 $handle = IO::Socket::INET->new(Proto => "tcp",
1092 PeerAddr => $host,
1093 PeerPort => $port)
1094 or die "can't connect to port $port on $host: $!";
1095
1096 $handle->autoflush(1); # so output gets there right away
1097 print STDERR "[Connected to $host:$port]\n";
1098
1099 # split the program into two processes, identical twins
1100 die "can't fork: $!" unless defined($kidpid = fork());
1101
1102 # the if{} block runs only in the parent process
1103 if ($kidpid) {
1104 # copy the socket to standard output
1105 while (defined ($line = <$handle>)) {
1106 print STDOUT $line;
1107 }
1108 kill("TERM", $kidpid); # send SIGTERM to child
1109 }
1110 # the else{} block runs only in the child process
1111 else {
1112 # copy standard input to the socket
1113 while (defined ($line = <STDIN>)) {
1114 print $handle $line;
1115 }
1116 }
1117
1118The C<kill> function in the parent's C<if> block is there to send a
1119signal to our child process (current running in the C<else> block)
1120as soon as the remote server has closed its end of the connection.
1121
7b05b7e3 1122If the remote server sends data a byte at time, and you need that
1123data immediately without waiting for a newline (which might not happen),
1124you may wish to replace the C<while> loop in the parent with the
1125following:
1126
1127 my $byte;
1128 while (sysread($handle, $byte, 1) == 1) {
1129 print STDOUT $byte;
1130 }
1131
1132Making a system call for each byte you want to read is not very efficient
1133(to put it mildly) but is the simplest to explain and works reasonably
1134well.
1135
1136=head1 TCP Servers with IO::Socket
1137
5a964f20 1138As always, setting up a server is little bit more involved than running a client.
7b05b7e3 1139The model is that the server creates a special kind of socket that
1140does nothing but listen on a particular port for incoming connections.
1141It does this by calling the C<IO::Socket::INET-E<gt>new()> method with
1142slightly different arguments than the client did.
1143
1144=over
1145
1146=item Proto
1147
1148This is which protocol to use. Like our clients, we'll
1149still specify C<"tcp"> here.
1150
1151=item LocalPort
1152
1153We specify a local
1154port in the C<LocalPort> argument, which we didn't do for the client.
1155This is service name or port number for which you want to be the
1156server. (Under Unix, ports under 1024 are restricted to the
1157superuser.) In our sample, we'll use port 9000, but you can use
1158any port that's not currently in use on your system. If you try
1159to use one already in used, you'll get an "Address already in use"
19799a22 1160message. Under Unix, the C<netstat -a> command will show
7b05b7e3 1161which services current have servers.
1162
1163=item Listen
1164
1165The C<Listen> parameter is set to the maximum number of
1166pending connections we can accept until we turn away incoming clients.
1167Think of it as a call-waiting queue for your telephone.
1168The low-level Socket module has a special symbol for the system maximum, which
1169is SOMAXCONN.
1170
1171=item Reuse
1172
1173The C<Reuse> parameter is needed so that we restart our server
1174manually without waiting a few minutes to allow system buffers to
1175clear out.
1176
1177=back
1178
1179Once the generic server socket has been created using the parameters
1180listed above, the server then waits for a new client to connect
1181to it. The server blocks in the C<accept> method, which eventually an
1182bidirectional connection to the remote client. (Make sure to autoflush
1183this handle to circumvent buffering.)
1184
1185To add to user-friendliness, our server prompts the user for commands.
1186Most servers don't do this. Because of the prompt without a newline,
1187you'll have to use the C<sysread> variant of the interactive client above.
1188
1189This server accepts one of five different commands, sending output
1190back to the client. Note that unlike most network servers, this one
1191only handles one incoming client at a time. Multithreaded servers are
f83494b9 1192covered in Chapter 6 of the Camel.
7b05b7e3 1193
1194Here's the code. We'll
1195
1196 #!/usr/bin/perl -w
1197 use IO::Socket;
1198 use Net::hostent; # for OO version of gethostbyaddr
1199
1200 $PORT = 9000; # pick something not in use
1201
1202 $server = IO::Socket::INET->new( Proto => 'tcp',
1203 LocalPort => $PORT,
1204 Listen => SOMAXCONN,
1205 Reuse => 1);
1206
1207 die "can't setup server" unless $server;
1208 print "[Server $0 accepting clients]\n";
1209
1210 while ($client = $server->accept()) {
1211 $client->autoflush(1);
1212 print $client "Welcome to $0; type help for command list.\n";
1213 $hostinfo = gethostbyaddr($client->peeraddr);
1214 printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
1215 print $client "Command? ";
1216 while ( <$client>) {
1217 next unless /\S/; # blank line
1218 if (/quit|exit/i) { last; }
1219 elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
1220 elsif (/who/i ) { print $client `who 2>&1`; }
1221 elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
1222 elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
1223 else {
1224 print $client "Commands: quit date who cookie motd\n";
1225 }
1226 } continue {
1227 print $client "Command? ";
1228 }
1229 close $client;
1230 }
1231
1232=head1 UDP: Message Passing
4633a7c4 1233
1234Another kind of client-server setup is one that uses not connections, but
1235messages. UDP communications involve much lower overhead but also provide
1236less reliability, as there are no promises that messages will arrive at
1237all, let alone in order and unmangled. Still, UDP offers some advantages
1238over TCP, including being able to "broadcast" or "multicast" to a whole
1239bunch of destination hosts at once (usually on your local subnet). If you
1240find yourself overly concerned about reliability and start building checks
6a3992aa 1241into your message system, then you probably should use just TCP to start
4633a7c4 1242with.
1243
1244Here's a UDP program similar to the sample Internet TCP client given
7b05b7e3 1245earlier. However, instead of checking one host at a time, the UDP version
4633a7c4 1246will check many of them asynchronously by simulating a multicast and then
1247using select() to do a timed-out wait for I/O. To do something similar
1248with TCP, you'd have to use a different socket handle for each host.
1249
1250 #!/usr/bin/perl -w
1251 use strict;
4633a7c4 1252 use Socket;
1253 use Sys::Hostname;
1254
54310121 1255 my ( $count, $hisiaddr, $hispaddr, $histime,
1256 $host, $iaddr, $paddr, $port, $proto,
4633a7c4 1257 $rin, $rout, $rtime, $SECS_of_70_YEARS);
1258
1259 $SECS_of_70_YEARS = 2208988800;
1260
1261 $iaddr = gethostbyname(hostname());
1262 $proto = getprotobyname('udp');
1263 $port = getservbyname('time', 'udp');
1264 $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
1265
1266 socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
1267 bind(SOCKET, $paddr) || die "bind: $!";
1268
1269 $| = 1;
1270 printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
1271 $count = 0;
1272 for $host (@ARGV) {
1273 $count++;
1274 $hisiaddr = inet_aton($host) || die "unknown host";
1275 $hispaddr = sockaddr_in($port, $hisiaddr);
1276 defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
1277 }
1278
1279 $rin = '';
1280 vec($rin, fileno(SOCKET), 1) = 1;
1281
1282 # timeout after 10.0 seconds
1283 while ($count && select($rout = $rin, undef, undef, 10.0)) {
1284 $rtime = '';
1285 ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
1286 ($port, $hisiaddr) = sockaddr_in($hispaddr);
1287 $host = gethostbyaddr($hisiaddr, AF_INET);
1288 $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
1289 printf "%-12s ", $host;
1290 printf "%8d %s\n", $histime - time, scalar localtime($histime);
1291 $count--;
1292 }
1293
1294=head1 SysV IPC
1295
1296While System V IPC isn't so widely used as sockets, it still has some
1297interesting uses. You can't, however, effectively use SysV IPC or
1298Berkeley mmap() to have shared memory so as to share a variable amongst
1299several processes. That's because Perl would reallocate your string when
1300you weren't wanting it to.
1301
54310121 1302Here's a small example showing shared memory usage.
a0d0e21e 1303
0ade1984 1304 use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU S_IRWXG S_IRWXO);
1305
a0d0e21e 1306 $size = 2000;
0ade1984 1307 $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!";
1308 print "shm key $key\n";
a0d0e21e 1309
1310 $message = "Message #1";
0ade1984 1311 shmwrite($key, $message, 0, 60) || die "$!";
1312 print "wrote: '$message'\n";
1313 shmread($key, $buff, 0, 60) || die "$!";
1314 print "read : '$buff'\n";
a0d0e21e 1315
0ade1984 1316 # the buffer of shmread is zero-character end-padded.
1317 substr($buff, index($buff, "\0")) = '';
1318 print "un" unless $buff eq $message;
1319 print "swell\n";
a0d0e21e 1320
0ade1984 1321 print "deleting shm $key\n";
1322 shmctl($key, IPC_RMID, 0) || die "$!";
a0d0e21e 1323
1324Here's an example of a semaphore:
1325
0ade1984 1326 use IPC::SysV qw(IPC_CREAT);
1327
a0d0e21e 1328 $IPC_KEY = 1234;
0ade1984 1329 $key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
1330 print "shm key $key\n";
a0d0e21e 1331
a2eb9003 1332Put this code in a separate file to be run in more than one process.
a0d0e21e 1333Call the file F<take>:
1334
1335 # create a semaphore
1336
1337 $IPC_KEY = 1234;
1338 $key = semget($IPC_KEY, 0 , 0 );
1339 die if !defined($key);
1340
1341 $semnum = 0;
1342 $semflag = 0;
1343
1344 # 'take' semaphore
1345 # wait for semaphore to be zero
1346 $semop = 0;
1347 $opstring1 = pack("sss", $semnum, $semop, $semflag);
1348
1349 # Increment the semaphore count
1350 $semop = 1;
1351 $opstring2 = pack("sss", $semnum, $semop, $semflag);
1352 $opstring = $opstring1 . $opstring2;
1353
1354 semop($key,$opstring) || die "$!";
1355
a2eb9003 1356Put this code in a separate file to be run in more than one process.
a0d0e21e 1357Call this file F<give>:
1358
4633a7c4 1359 # 'give' the semaphore
a0d0e21e 1360 # run this in the original process and you will see
1361 # that the second process continues
1362
1363 $IPC_KEY = 1234;
1364 $key = semget($IPC_KEY, 0, 0);
1365 die if !defined($key);
1366
1367 $semnum = 0;
1368 $semflag = 0;
1369
1370 # Decrement the semaphore count
1371 $semop = -1;
1372 $opstring = pack("sss", $semnum, $semop, $semflag);
1373
1374 semop($key,$opstring) || die "$!";
1375
7b05b7e3 1376The SysV IPC code above was written long ago, and it's definitely
0ade1984 1377clunky looking. For a more modern look, see the IPC::SysV module
1378which is included with Perl starting from Perl 5.005.
4633a7c4 1379
1380=head1 NOTES
1381
5a964f20 1382Most of these routines quietly but politely return C<undef> when they
1383fail instead of causing your program to die right then and there due to
1384an uncaught exception. (Actually, some of the new I<Socket> conversion
1385functions croak() on bad arguments.) It is therefore essential to
1386check return values from these functions. Always begin your socket
1387programs this way for optimal success, and don't forget to add B<-T>
1388taint checking flag to the #! line for servers:
4633a7c4 1389
5a964f20 1390 #!/usr/bin/perl -Tw
4633a7c4 1391 use strict;
1392 use sigtrap;
1393 use Socket;
1394
1395=head1 BUGS
1396
1397All these routines create system-specific portability problems. As noted
1398elsewhere, Perl is at the mercy of your C libraries for much of its system
1399behaviour. It's probably safest to assume broken SysV semantics for
6a3992aa 1400signals and to stick with simple TCP and UDP socket operations; e.g., don't
a2eb9003 1401try to pass open file descriptors over a local UDP datagram socket if you
4633a7c4 1402want your code to stand a chance of being portable.
1403
5a964f20 1404As mentioned in the signals section, because few vendors provide C
1405libraries that are safely re-entrant, the prudent programmer will do
1406little else within a handler beyond setting a numeric variable that
1407already exists; or, if locked into a slow (restarting) system call,
1408using die() to raise an exception and longjmp(3) out. In fact, even
1409these may in some cases cause a core dump. It's probably best to avoid
1410signals except where they are absolutely inevitable. This
1411will be addressed in a future release of Perl.
4633a7c4 1412
1413=head1 AUTHOR
1414
1415Tom Christiansen, with occasional vestiges of Larry Wall's original
7b05b7e3 1416version and suggestions from the Perl Porters.
4633a7c4 1417
1418=head1 SEE ALSO
1419
7b05b7e3 1420There's a lot more to networking than this, but this should get you
1421started.
1422
5a964f20 1423For intrepid programmers, the indispensable textbook is I<Unix Network
1424Programming> by W. Richard Stevens (published by Addison-Wesley). Note
1425that most books on networking address networking from the perspective of
1426a C programmer; translation to Perl is left as an exercise for the reader.
7b05b7e3 1427
1428The IO::Socket(3) manpage describes the object library, and the Socket(3)
1429manpage describes the low-level interface to sockets. Besides the obvious
1430functions in L<perlfunc>, you should also check out the F<modules> file
1431at your nearest CPAN site. (See L<perlmodlib> or best yet, the F<Perl
1432FAQ> for a description of what CPAN is and where to get it.)
1433
4633a7c4 1434Section 5 of the F<modules> file is devoted to "Networking, Device Control
6a3992aa 1435(modems), and Interprocess Communication", and contains numerous unbundled
4633a7c4 1436modules numerous networking modules, Chat and Expect operations, CGI
1437programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
1438Threads, and ToolTalk--just to name a few.