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