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