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