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