home *** CD-ROM | disk | FTP | other *** search
Text File | 2000-03-21 | 53.9 KB | 1,474 lines |
- =head1 NAME
-
- perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocesses, sockets, and semaphores)
-
- =head1 DESCRIPTION
-
- The basic IPC facilities of Perl are built out of the good old Unix
- signals, named pipes, pipe opens, the Berkeley socket routines, and SysV
- IPC calls. Each is used in slightly different situations.
-
- =head1 Signals
-
- Perl uses a simple signal handling model: the %SIG hash contains names or
- references of user-installed signal handlers. These handlers will be called
- with an argument which is the name of the signal that triggered it. A
- signal may be generated intentionally from a particular keyboard sequence like
- control-C or control-Z, sent to you from another process, or
- triggered automatically by the kernel when special events transpire, like
- a child process exiting, your process running out of stack space, or
- hitting file size limit.
-
- For example, to trap an interrupt signal, set up a handler like this.
- Do as little as you possibly can in your handler; notice how all we do is
- set a global variable and then raise an exception. That's because on most
- systems, libraries are not re-entrant; particularly, memory allocation and
- I/O routines are not. That means that doing nearly I<anything> in your
- handler could in theory trigger a memory fault and subsequent core dump.
-
- sub catch_zap {
- my $signame = shift;
- $shucks++;
- die "Somebody sent me a SIG$signame";
- }
- $SIG{INT} = 'catch_zap'; # could fail in modules
- $SIG{INT} = \&catch_zap; # best strategy
-
- The names of the signals are the ones listed out by C<kill -l> on your
- system, or you can retrieve them from the Config module. Set up an
- @signame list indexed by number to get the name and a %signo table
- indexed by name to get the number:
-
- use Config;
- defined $Config{sig_name} || die "No sigs?";
- foreach $name (split(' ', $Config{sig_name})) {
- $signo{$name} = $i;
- $signame[$i] = $name;
- $i++;
- }
-
- So to check whether signal 17 and SIGALRM were the same, do just this:
-
- print "signal #17 = $signame[17]\n";
- if ($signo{ALRM}) {
- print "SIGALRM is $signo{ALRM}\n";
- }
-
- You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
- the handler, in which case Perl will try to discard the signal or do the
- default thing.
-
- On most Unix platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
- has special behavior with respect to a value of C<'IGNORE'>.
- Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
- not creating zombie processes when the parent process fails to C<wait()>
- on its child processes (i.e. child processes are automatically reaped).
- Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
- C<-1> on such platforms.
-
- Some signals can be neither trapped nor ignored, such as
- the KILL and STOP (but not the TSTP) signals. One strategy for
- temporarily ignoring signals is to use a local() statement, which will be
- automatically restored once your block is exited. (Remember that local()
- values are "inherited" by functions called from within that block.)
-
- sub precious {
- local $SIG{INT} = 'IGNORE';
- &more_functions;
- }
- sub more_functions {
- # interrupts still ignored, for now...
- }
-
- Sending a signal to a negative process ID means that you send the signal
- to the entire Unix process-group. This code sends a hang-up signal to all
- processes in the current process group (and sets $SIG{HUP} to IGNORE so
- it doesn't kill itself):
-
- {
- local $SIG{HUP} = 'IGNORE';
- kill HUP => -$$;
- # snazzy writing of: kill('HUP', -$$)
- }
-
- Another interesting signal to send is signal number zero. This doesn't
- actually affect another process, but instead checks whether it's alive
- or has changed its UID.
-
- unless (kill 0 => $kid_pid) {
- warn "something wicked happened to $kid_pid";
- }
-
- You might also want to employ anonymous functions for simple signal
- handlers:
-
- $SIG{INT} = sub { die "\nOutta here!\n" };
-
- But that will be problematic for the more complicated handlers that need
- to reinstall themselves. Because Perl's signal mechanism is currently
- based on the signal(3) function from the C library, you may sometimes be so
- misfortunate as to run on systems where that function is "broken", that
- is, it behaves in the old unreliable SysV way rather than the newer, more
- reasonable BSD and POSIX fashion. So you'll see defensive people writing
- signal handlers like this:
-
- sub REAPER {
- $waitedpid = wait;
- # loathe sysV: it makes us not only reinstate
- # the handler, but place it after the wait
- $SIG{CHLD} = \&REAPER;
- }
- $SIG{CHLD} = \&REAPER;
- # now do something that forks...
-
- or even the more elaborate:
-
- use POSIX ":sys_wait_h";
- sub REAPER {
- my $child;
- while (($child = waitpid(-1,WNOHANG)) > 0) {
- $Kid_Status{$child} = $?;
- }
- $SIG{CHLD} = \&REAPER; # still loathe sysV
- }
- $SIG{CHLD} = \&REAPER;
- # do something that forks...
-
- Signal handling is also used for timeouts in Unix, While safely
- protected within an C<eval{}> block, you set a signal handler to trap
- alarm signals and then schedule to have one delivered to you in some
- number of seconds. Then try your blocking operation, clearing the alarm
- when it's done but not before you've exited your C<eval{}> block. If it
- goes off, you'll use die() to jump out of the block, much as you might
- using longjmp() or throw() in other languages.
-
- Here's an example:
-
- eval {
- local $SIG{ALRM} = sub { die "alarm clock restart" };
- alarm 10;
- flock(FH, 2); # blocking write lock
- alarm 0;
- };
- if ($@ and $@ !~ /alarm clock restart/) { die }
-
- If the operation being timed out is system() or qx(), this technique
- is liable to generate zombies. If this matters to you, you'll
- need to do your own fork() and exec(), and kill the errant child process.
-
- For more complex signal handling, you might see the standard POSIX
- module. Lamentably, this is almost entirely undocumented, but
- the F<t/lib/posix.t> file from the Perl source distribution has some
- examples in it.
-
- =head1 Named Pipes
-
- A named pipe (often referred to as a FIFO) is an old Unix IPC
- mechanism for processes communicating on the same machine. It works
- just like a regular, connected anonymous pipes, except that the
- processes rendezvous using a filename and don't have to be related.
-
- To create a named pipe, use the Unix command mknod(1) or on some
- systems, mkfifo(1). These may not be in your normal path.
-
- # system return val is backwards, so && not ||
- #
- $ENV{PATH} .= ":/etc:/usr/etc";
- if ( system('mknod', $path, 'p')
- && system('mkfifo', $path) )
- {
- die "mk{nod,fifo} $path failed";
- }
-
-
- A fifo is convenient when you want to connect a process to an unrelated
- one. When you open a fifo, the program will block until there's something
- on the other end.
-
- For example, let's say you'd like to have your F<.signature> file be a
- named pipe that has a Perl program on the other end. Now every time any
- program (like a mailer, news reader, finger program, etc.) tries to read
- from that file, the reading program will block and your program will
- supply the new signature. We'll use the pipe-checking file test B<-p>
- to find out whether anyone (or anything) has accidentally removed our fifo.
-
- chdir; # go home
- $FIFO = '.signature';
- $ENV{PATH} .= ":/etc:/usr/games";
-
- while (1) {
- unless (-p $FIFO) {
- unlink $FIFO;
- system('mknod', $FIFO, 'p')
- && die "can't mknod $FIFO: $!";
- }
-
- # next line blocks until there's a reader
- open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
- print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
- close FIFO;
- sleep 2; # to avoid dup signals
- }
-
- =head2 WARNING
-
- By installing Perl code to deal with signals, you're exposing yourself
- to danger from two things. First, few system library functions are
- re-entrant. If the signal interrupts while Perl is executing one function
- (like malloc(3) or printf(3)), and your signal handler then calls the
- same function again, you could get unpredictable behavior--often, a
- core dump. Second, Perl isn't itself re-entrant at the lowest levels.
- If the signal interrupts Perl while Perl is changing its own internal
- data structures, similarly unpredictable behaviour may result.
-
- There are two things you can do, knowing this: be paranoid or be
- pragmatic. The paranoid approach is to do as little as possible in your
- signal handler. Set an existing integer variable that already has a
- value, and return. This doesn't help you if you're in a slow system call,
- which will just restart. That means you have to C<die> to longjump(3) out
- of the handler. Even this is a little cavalier for the true paranoiac,
- who avoids C<die> in a handler because the system I<is> out to get you.
- The pragmatic approach is to say ``I know the risks, but prefer the
- convenience'', and to do anything you want in your signal handler,
- prepared to clean up core dumps now and again.
-
- To forbid signal handlers altogether would bars you from
- many interesting programs, including virtually everything in this manpage,
- since you could no longer even write SIGCHLD handlers. Their dodginess
- is expected to be addresses in the 5.005 release.
-
-
- =head1 Using open() for IPC
-
- Perl's basic open() statement can also be used for unidirectional interprocess
- communication by either appending or prepending a pipe symbol to the second
- argument to open(). Here's how to start something up in a child process you
- intend to write to:
-
- open(SPOOLER, "| cat -v | lpr -h 2>/dev/null")
- || die "can't fork: $!";
- local $SIG{PIPE} = sub { die "spooler pipe broke" };
- print SPOOLER "stuff\n";
- close SPOOLER || die "bad spool: $! $?";
-
- And here's how to start up a child process you intend to read from:
-
- open(STATUS, "netstat -an 2>&1 |")
- || die "can't fork: $!";
- while (<STATUS>) {
- next if /^(tcp|udp)/;
- print;
- }
- close STATUS || die "bad netstat: $! $?";
-
- If one can be sure that a particular program is a Perl script that is
- expecting filenames in @ARGV, the clever programmer can write something
- like this:
-
- % program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
-
- and irrespective of which shell it's called from, the Perl program will
- read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
- in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
- file. Pretty nifty, eh?
-
- You might notice that you could use backticks for much the
- same effect as opening a pipe for reading:
-
- print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
- die "bad netstat" if $?;
-
- While this is true on the surface, it's much more efficient to process the
- file one line or record at a time because then you don't have to read the
- whole thing into memory at once. It also gives you finer control of the
- whole process, letting you to kill off the child process early if you'd
- like.
-
- Be careful to check both the open() and the close() return values. If
- you're I<writing> to a pipe, you should also trap SIGPIPE. Otherwise,
- think of what happens when you start up a pipe to a command that doesn't
- exist: the open() will in all likelihood succeed (it only reflects the
- fork()'s success), but then your output will fail--spectacularly. Perl
- can't know whether the command worked because your command is actually
- running in a separate process whose exec() might have failed. Therefore,
- while readers of bogus commands return just a quick end of file, writers
- to bogus command will trigger a signal they'd better be prepared to
- handle. Consider:
-
- open(FH, "|bogus") or die "can't fork: $!";
- print FH "bang\n" or die "can't write: $!";
- close FH or die "can't close: $!";
-
- That won't blow up until the close, and it will blow up with a SIGPIPE.
- To catch it, you could use this:
-
- $SIG{PIPE} = 'IGNORE';
- open(FH, "|bogus") or die "can't fork: $!";
- print FH "bang\n" or die "can't write: $!";
- close FH or die "can't close: status=$?";
-
- =head2 Filehandles
-
- Both the main process and any child processes it forks share the same
- STDIN, STDOUT, and STDERR filehandles. If both processes try to access
- them at once, strange things can happen. You may also want to close
- or reopen the filehandles for the child. You can get around this by
- opening your pipe with open(), but on some systems this means that the
- child process cannot outlive the parent.
-
- =head2 Background Processes
-
- You can run a command in the background with:
-
- system("cmd &");
-
- The command's STDOUT and STDERR (and possibly STDIN, depending on your
- shell) will be the same as the parent's. You won't need to catch
- SIGCHLD because of the double-fork taking place (see below for more
- details).
-
- =head2 Complete Dissociation of Child from Parent
-
- In some cases (starting server processes, for instance) you'll want to
- completely dissociate the child process from the parent. This is
- often called daemonization. A well behaved daemon will also chdir()
- to the root directory (so it doesn't prevent unmounting the filesystem
- containing the directory from which it was launched) and redirect its
- standard file descriptors from and to F</dev/null> (so that random
- output doesn't wind up on the user's terminal).
-
- use POSIX 'setsid';
-
- sub daemonize {
- chdir '/' or die "Can't chdir to /: $!";
- open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
- open STDOUT, '>/dev/null'
- or die "Can't write to /dev/null: $!";
- defined(my $pid = fork) or die "Can't fork: $!";
- exit if $pid;
- setsid or die "Can't start a new session: $!";
- open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
- }
-
- The fork() has to come before the setsid() to ensure that you aren't a
- process group leader (the setsid() will fail if you are). If your
- system doesn't have the setsid() function, open F</dev/tty> and use the
- C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
-
- Non-Unix users should check their Your_OS::Process module for other
- solutions.
-
- =head2 Safe Pipe Opens
-
- Another interesting approach to IPC is making your single program go
- multiprocess and communicate between (or even amongst) yourselves. The
- open() function will accept a file argument of either C<"-|"> or C<"|-">
- to do a very interesting thing: it forks a child connected to the
- filehandle you've opened. The child is running the same program as the
- parent. This is useful for safely opening a file when running under an
- assumed UID or GID, for example. If you open a pipe I<to> minus, you can
- write to the filehandle you opened and your kid will find it in his
- STDIN. If you open a pipe I<from> minus, you can read from the filehandle
- you opened whatever your kid writes to his STDOUT.
-
- use English;
- my $sleep_count = 0;
-
- do {
- $pid = open(KID_TO_WRITE, "|-");
- unless (defined $pid) {
- warn "cannot fork: $!";
- die "bailing out" if $sleep_count++ > 6;
- sleep 10;
- }
- } until defined $pid;
-
- if ($pid) { # parent
- print KID_TO_WRITE @some_data;
- close(KID_TO_WRITE) || warn "kid exited $?";
- } else { # child
- ($EUID, $EGID) = ($UID, $GID); # suid progs only
- open (FILE, "> /safe/file")
- || die "can't open /safe/file: $!";
- while (<STDIN>) {
- print FILE; # child's STDIN is parent's KID
- }
- exit; # don't forget this
- }
-
- Another common use for this construct is when you need to execute
- something without the shell's interference. With system(), it's
- straightforward, but you can't use a pipe open or backticks safely.
- That's because there's no way to stop the shell from getting its hands on
- your arguments. Instead, use lower-level control to call exec() directly.
-
- Here's a safe backtick or pipe open for read:
-
- # add error processing as above
- $pid = open(KID_TO_READ, "-|");
-
- if ($pid) { # parent
- while (<KID_TO_READ>) {
- # do something interesting
- }
- close(KID_TO_READ) || warn "kid exited $?";
-
- } else { # child
- ($EUID, $EGID) = ($UID, $GID); # suid only
- exec($program, @options, @args)
- || die "can't exec program: $!";
- # NOTREACHED
- }
-
-
- And here's a safe pipe open for writing:
-
- # add error processing as above
- $pid = open(KID_TO_WRITE, "|-");
- $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
-
- if ($pid) { # parent
- for (@data) {
- print KID_TO_WRITE;
- }
- close(KID_TO_WRITE) || warn "kid exited $?";
-
- } else { # child
- ($EUID, $EGID) = ($UID, $GID);
- exec($program, @options, @args)
- || die "can't exec program: $!";
- # NOTREACHED
- }
-
- Note that these operations are full Unix forks, which means they may not be
- correctly implemented on alien systems. Additionally, these are not true
- multithreading. If you'd like to learn more about threading, see the
- F<modules> file mentioned below in the SEE ALSO section.
-
- =head2 Bidirectional Communication with Another Process
-
- While this works reasonably well for unidirectional communication, what
- about bidirectional communication? The obvious thing you'd like to do
- doesn't actually work:
-
- open(PROG_FOR_READING_AND_WRITING, "| some program |")
-
- and if you forget to use the C<use warnings> pragma or the B<-w> flag,
- then you'll miss out entirely on the diagnostic message:
-
- Can't do bidirectional pipe at -e line 1.
-
- If you really want to, you can use the standard open2() library function
- to catch both ends. There's also an open3() for tridirectional I/O so you
- can also catch your child's STDERR, but doing so would then require an
- awkward select() loop and wouldn't allow you to use normal Perl input
- operations.
-
- If you look at its source, you'll see that open2() uses low-level
- primitives like Unix pipe() and exec() calls to create all the connections.
- While it might have been slightly more efficient by using socketpair(), it
- would have then been even less portable than it already is. The open2()
- and open3() functions are unlikely to work anywhere except on a Unix
- system or some other one purporting to be POSIX compliant.
-
- Here's an example of using open2():
-
- use FileHandle;
- use IPC::Open2;
- $pid = open2(*Reader, *Writer, "cat -u -n" );
- print Writer "stuff\n";
- $got = <Reader>;
-
- The problem with this is that Unix buffering is really going to
- ruin your day. Even though your C<Writer> filehandle is auto-flushed,
- and the process on the other end will get your data in a timely manner,
- you can't usually do anything to force it to give it back to you
- in a similarly quick fashion. In this case, we could, because we
- gave I<cat> a B<-u> flag to make it unbuffered. But very few Unix
- commands are designed to operate over pipes, so this seldom works
- unless you yourself wrote the program on the other end of the
- double-ended pipe.
-
- A solution to this is the nonstandard F<Comm.pl> library. It uses
- pseudo-ttys to make your program behave more reasonably:
-
- require 'Comm.pl';
- $ph = open_proc('cat -n');
- for (1..10) {
- print $ph "a line\n";
- print "got back ", scalar <$ph>;
- }
-
- This way you don't have to have control over the source code of the
- program you're using. The F<Comm> library also has expect()
- and interact() functions. Find the library (and we hope its
- successor F<IPC::Chat>) at your nearest CPAN archive as detailed
- in the SEE ALSO section below.
-
- The newer Expect.pm module from CPAN also addresses this kind of thing.
- This module requires two other modules from CPAN: IO::Pty and IO::Stty.
- It sets up a pseudo-terminal to interact with programs that insist on
- using talking to the terminal device driver. If your system is
- amongst those supported, this may be your best bet.
-
- =head2 Bidirectional Communication with Yourself
-
- If you want, you may make low-level pipe() and fork()
- to stitch this together by hand. This example only
- talks to itself, but you could reopen the appropriate
- handles to STDIN and STDOUT and call other processes.
-
- #!/usr/bin/perl -w
- # pipe1 - bidirectional communication using two pipe pairs
- # designed for the socketpair-challenged
- use IO::Handle; # thousands of lines just for autoflush :-(
- pipe(PARENT_RDR, CHILD_WTR); # XXX: failure?
- pipe(CHILD_RDR, PARENT_WTR); # XXX: failure?
- CHILD_WTR->autoflush(1);
- PARENT_WTR->autoflush(1);
-
- if ($pid = fork) {
- close PARENT_RDR; close PARENT_WTR;
- print CHILD_WTR "Parent Pid $$ is sending this\n";
- chomp($line = <CHILD_RDR>);
- print "Parent Pid $$ just read this: `$line'\n";
- close CHILD_RDR; close CHILD_WTR;
- waitpid($pid,0);
- } else {
- die "cannot fork: $!" unless defined $pid;
- close CHILD_RDR; close CHILD_WTR;
- chomp($line = <PARENT_RDR>);
- print "Child Pid $$ just read this: `$line'\n";
- print PARENT_WTR "Child Pid $$ is sending this\n";
- close PARENT_RDR; close PARENT_WTR;
- exit;
- }
-
- But you don't actually have to make two pipe calls. If you
- have the socketpair() system call, it will do this all for you.
-
- #!/usr/bin/perl -w
- # pipe2 - bidirectional communication using socketpair
- # "the best ones always go both ways"
-
- use Socket;
- use IO::Handle; # thousands of lines just for autoflush :-(
- # We say AF_UNIX because although *_LOCAL is the
- # POSIX 1003.1g form of the constant, many machines
- # still don't have it.
- socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
- or die "socketpair: $!";
-
- CHILD->autoflush(1);
- PARENT->autoflush(1);
-
- if ($pid = fork) {
- close PARENT;
- print CHILD "Parent Pid $$ is sending this\n";
- chomp($line = <CHILD>);
- print "Parent Pid $$ just read this: `$line'\n";
- close CHILD;
- waitpid($pid,0);
- } else {
- die "cannot fork: $!" unless defined $pid;
- close CHILD;
- chomp($line = <PARENT>);
- print "Child Pid $$ just read this: `$line'\n";
- print PARENT "Child Pid $$ is sending this\n";
- close PARENT;
- exit;
- }
-
- =head1 Sockets: Client/Server Communication
-
- While not limited to Unix-derived operating systems (e.g., WinSock on PCs
- provides socket support, as do some VMS libraries), you may not have
- sockets on your system, in which case this section probably isn't going to do
- you much good. With sockets, you can do both virtual circuits (i.e., TCP
- streams) and datagrams (i.e., UDP packets). You may be able to do even more
- depending on your system.
-
- The Perl function calls for dealing with sockets have the same names as
- the corresponding system calls in C, but their arguments tend to differ
- for two reasons: first, Perl filehandles work differently than C file
- descriptors. Second, Perl already knows the length of its strings, so you
- don't need to pass that information.
-
- One of the major problems with old socket code in Perl was that it used
- hard-coded values for some of the constants, which severely hurt
- portability. If you ever see code that does anything like explicitly
- setting C<$AF_INET = 2>, you know you're in for big trouble: An
- immeasurably superior approach is to use the C<Socket> module, which more
- reliably grants access to various constants and functions you'll need.
-
- If you're not writing a server/client for an existing protocol like
- NNTP or SMTP, you should give some thought to how your server will
- know when the client has finished talking, and vice-versa. Most
- protocols are based on one-line messages and responses (so one party
- knows the other has finished when a "\n" is received) or multi-line
- messages and responses that end with a period on an empty line
- ("\n.\n" terminates a message/response).
-
- =head2 Internet Line Terminators
-
- The Internet line terminator is "\015\012". Under ASCII variants of
- Unix, that could usually be written as "\r\n", but under other systems,
- "\r\n" might at times be "\015\015\012", "\012\012\015", or something
- completely different. The standards specify writing "\015\012" to be
- conformant (be strict in what you provide), but they also recommend
- accepting a lone "\012" on input (but be lenient in what you require).
- We haven't always been very good about that in the code in this manpage,
- but unless you're on a Mac, you'll probably be ok.
-
- =head2 Internet TCP Clients and Servers
-
- Use Internet-domain sockets when you want to do client-server
- communication that might extend to machines outside of your own system.
-
- Here's a sample TCP client using Internet-domain sockets:
-
- #!/usr/bin/perl -w
- use strict;
- use Socket;
- my ($remote,$port, $iaddr, $paddr, $proto, $line);
-
- $remote = shift || 'localhost';
- $port = shift || 2345; # random port
- if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
- die "No port" unless $port;
- $iaddr = inet_aton($remote) || die "no host: $remote";
- $paddr = sockaddr_in($port, $iaddr);
-
- $proto = getprotobyname('tcp');
- socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
- connect(SOCK, $paddr) || die "connect: $!";
- while (defined($line = <SOCK>)) {
- print $line;
- }
-
- close (SOCK) || die "close: $!";
- exit;
-
- And here's a corresponding server to go along with it. We'll
- leave the address as INADDR_ANY so that the kernel can choose
- the appropriate interface on multihomed hosts. If you want sit
- on a particular interface (like the external side of a gateway
- or firewall machine), you should fill this in with your real address
- instead.
-
- #!/usr/bin/perl -Tw
- use strict;
- BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
- use Socket;
- use Carp;
- $EOL = "\015\012";
-
- sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
-
- my $port = shift || 2345;
- my $proto = getprotobyname('tcp');
- $port = $1 if $port =~ /(\d+)/; # untaint port number
-
- socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
- setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
- pack("l", 1)) || die "setsockopt: $!";
- bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
- listen(Server,SOMAXCONN) || die "listen: $!";
-
- logmsg "server started on port $port";
-
- my $paddr;
-
- $SIG{CHLD} = \&REAPER;
-
- for ( ; $paddr = accept(Client,Server); close Client) {
- my($port,$iaddr) = sockaddr_in($paddr);
- my $name = gethostbyaddr($iaddr,AF_INET);
-
- logmsg "connection from $name [",
- inet_ntoa($iaddr), "]
- at port $port";
-
- print Client "Hello there, $name, it's now ",
- scalar localtime, $EOL;
- }
-
- And here's a multithreaded version. It's multithreaded in that
- like most typical servers, it spawns (forks) a slave server to
- handle the client request so that the master server can quickly
- go back to service a new client.
-
- #!/usr/bin/perl -Tw
- use strict;
- BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
- use Socket;
- use Carp;
- $EOL = "\015\012";
-
- sub spawn; # forward declaration
- sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
-
- my $port = shift || 2345;
- my $proto = getprotobyname('tcp');
- $port = $1 if $port =~ /(\d+)/; # untaint port number
-
- socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
- setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
- pack("l", 1)) || die "setsockopt: $!";
- bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
- listen(Server,SOMAXCONN) || die "listen: $!";
-
- logmsg "server started on port $port";
-
- my $waitedpid = 0;
- my $paddr;
-
- sub REAPER {
- $waitedpid = wait;
- $SIG{CHLD} = \&REAPER; # loathe sysV
- logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
- }
-
- $SIG{CHLD} = \&REAPER;
-
- for ( $waitedpid = 0;
- ($paddr = accept(Client,Server)) || $waitedpid;
- $waitedpid = 0, close Client)
- {
- next if $waitedpid and not $paddr;
- my($port,$iaddr) = sockaddr_in($paddr);
- my $name = gethostbyaddr($iaddr,AF_INET);
-
- logmsg "connection from $name [",
- inet_ntoa($iaddr), "]
- at port $port";
-
- spawn sub {
- print "Hello there, $name, it's now ", scalar localtime, $EOL;
- exec '/usr/games/fortune' # XXX: `wrong' line terminators
- or confess "can't exec fortune: $!";
- };
-
- }
-
- sub spawn {
- my $coderef = shift;
-
- unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
- confess "usage: spawn CODEREF";
- }
-
- my $pid;
- if (!defined($pid = fork)) {
- logmsg "cannot fork: $!";
- return;
- } elsif ($pid) {
- logmsg "begat $pid";
- return; # I'm the parent
- }
- # else I'm the child -- go spawn
-
- open(STDIN, "<&Client") || die "can't dup client to stdin";
- open(STDOUT, ">&Client") || die "can't dup client to stdout";
- ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
- exit &$coderef();
- }
-
- This server takes the trouble to clone off a child version via fork() for
- each incoming request. That way it can handle many requests at once,
- which you might not always want. Even if you don't fork(), the listen()
- will allow that many pending connections. Forking servers have to be
- particularly careful about cleaning up their dead children (called
- "zombies" in Unix parlance), because otherwise you'll quickly fill up your
- process table.
-
- We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
- even if we aren't running setuid or setgid. This is always a good idea
- for servers and other programs run on behalf of someone else (like CGI
- scripts), because it lessens the chances that people from the outside will
- be able to compromise your system.
-
- Let's look at another TCP client. This one connects to the TCP "time"
- service on a number of different machines and shows how far their clocks
- differ from the system on which it's being run:
-
- #!/usr/bin/perl -w
- use strict;
- use Socket;
-
- my $SECS_of_70_YEARS = 2208988800;
- sub ctime { scalar localtime(shift) }
-
- my $iaddr = gethostbyname('localhost');
- my $proto = getprotobyname('tcp');
- my $port = getservbyname('time', 'tcp');
- my $paddr = sockaddr_in(0, $iaddr);
- my($host);
-
- $| = 1;
- printf "%-24s %8s %s\n", "localhost", 0, ctime(time());
-
- foreach $host (@ARGV) {
- printf "%-24s ", $host;
- my $hisiaddr = inet_aton($host) || die "unknown host";
- my $hispaddr = sockaddr_in($port, $hisiaddr);
- socket(SOCKET, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
- connect(SOCKET, $hispaddr) || die "bind: $!";
- my $rtime = ' ';
- read(SOCKET, $rtime, 4);
- close(SOCKET);
- my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
- printf "%8d %s\n", $histime - time, ctime($histime);
- }
-
- =head2 Unix-Domain TCP Clients and Servers
-
- That's fine for Internet-domain clients and servers, but what about local
- communications? While you can use the same setup, sometimes you don't
- want to. Unix-domain sockets are local to the current host, and are often
- used internally to implement pipes. Unlike Internet domain sockets, Unix
- domain sockets can show up in the file system with an ls(1) listing.
-
- % ls -l /dev/log
- srw-rw-rw- 1 root 0 Oct 31 07:23 /dev/log
-
- You can test for these with Perl's B<-S> file test:
-
- unless ( -S '/dev/log' ) {
- die "something's wicked with the print system";
- }
-
- Here's a sample Unix-domain client:
-
- #!/usr/bin/perl -w
- use Socket;
- use strict;
- my ($rendezvous, $line);
-
- $rendezvous = shift || '/tmp/catsock';
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) || die "socket: $!";
- connect(SOCK, sockaddr_un($rendezvous)) || die "connect: $!";
- while (defined($line = <SOCK>)) {
- print $line;
- }
- exit;
-
- And here's a corresponding server. You don't have to worry about silly
- network terminators here because Unix domain sockets are guaranteed
- to be on the localhost, and thus everything works right.
-
- #!/usr/bin/perl -Tw
- use strict;
- use Socket;
- use Carp;
-
- BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
- sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
-
- my $NAME = '/tmp/catsock';
- my $uaddr = sockaddr_un($NAME);
- my $proto = getprotobyname('tcp');
-
- socket(Server,PF_UNIX,SOCK_STREAM,0) || die "socket: $!";
- unlink($NAME);
- bind (Server, $uaddr) || die "bind: $!";
- listen(Server,SOMAXCONN) || die "listen: $!";
-
- logmsg "server started on $NAME";
-
- my $waitedpid;
-
- sub REAPER {
- $waitedpid = wait;
- $SIG{CHLD} = \&REAPER; # loathe sysV
- logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
- }
-
- $SIG{CHLD} = \&REAPER;
-
-
- for ( $waitedpid = 0;
- accept(Client,Server) || $waitedpid;
- $waitedpid = 0, close Client)
- {
- next if $waitedpid;
- logmsg "connection on $NAME";
- spawn sub {
- print "Hello there, it's now ", scalar localtime, "\n";
- exec '/usr/games/fortune' or die "can't exec fortune: $!";
- };
- }
-
- As you see, it's remarkably similar to the Internet domain TCP server, so
- much so, in fact, that we've omitted several duplicate functions--spawn(),
- logmsg(), ctime(), and REAPER()--which are exactly the same as in the
- other server.
-
- So why would you ever want to use a Unix domain socket instead of a
- simpler named pipe? Because a named pipe doesn't give you sessions. You
- can't tell one process's data from another's. With socket programming,
- you get a separate session for each client: that's why accept() takes two
- arguments.
-
- For example, let's say that you have a long running database server daemon
- that you want folks from the World Wide Web to be able to access, but only
- if they go through a CGI interface. You'd have a small, simple CGI
- program that does whatever checks and logging you feel like, and then acts
- as a Unix-domain client and connects to your private server.
-
- =head1 TCP Clients with IO::Socket
-
- For those preferring a higher-level interface to socket programming, the
- IO::Socket module provides an object-oriented approach. IO::Socket is
- included as part of the standard Perl distribution as of the 5.004
- release. If you're running an earlier version of Perl, just fetch
- IO::Socket from CPAN, where you'll also find find modules providing easy
- interfaces to the following systems: DNS, FTP, Ident (RFC 931), NIS and
- NISPlus, NNTP, Ping, POP3, SMTP, SNMP, SSLeay, Telnet, and Time--just
- to name a few.
-
- =head2 A Simple Client
-
- Here's a client that creates a TCP connection to the "daytime"
- service at port 13 of the host name "localhost" and prints out everything
- that the server there cares to provide.
-
- #!/usr/bin/perl -w
- use IO::Socket;
- $remote = IO::Socket::INET->new(
- Proto => "tcp",
- PeerAddr => "localhost",
- PeerPort => "daytime(13)",
- )
- or die "cannot connect to daytime port at localhost";
- while ( <$remote> ) { print }
-
- When you run this program, you should get something back that
- looks like this:
-
- Wed May 14 08:40:46 MDT 1997
-
- Here are what those parameters to the C<new> constructor mean:
-
- =over
-
- =item C<Proto>
-
- This is which protocol to use. In this case, the socket handle returned
- will be connected to a TCP socket, because we want a stream-oriented
- connection, that is, one that acts pretty much like a plain old file.
- Not all sockets are this of this type. For example, the UDP protocol
- can be used to make a datagram socket, used for message-passing.
-
- =item C<PeerAddr>
-
- This is the name or Internet address of the remote host the server is
- running on. We could have specified a longer name like C<"www.perl.com">,
- or an address like C<"204.148.40.9">. For demonstration purposes, we've
- used the special hostname C<"localhost">, which should always mean the
- current machine you're running on. The corresponding Internet address
- for localhost is C<"127.1">, if you'd rather use that.
-
- =item C<PeerPort>
-
- This is the service name or port number we'd like to connect to.
- We could have gotten away with using just C<"daytime"> on systems with a
- well-configured system services file,[FOOTNOTE: The system services file
- is in I</etc/services> under Unix] but just in case, we've specified the
- port number (13) in parentheses. Using just the number would also have
- worked, but constant numbers make careful programmers nervous.
-
- =back
-
- Notice how the return value from the C<new> constructor is used as
- a filehandle in the C<while> loop? That's what's called an indirect
- filehandle, a scalar variable containing a filehandle. You can use
- it the same way you would a normal filehandle. For example, you
- can read one line from it this way:
-
- $line = <$handle>;
-
- all remaining lines from is this way:
-
- @lines = <$handle>;
-
- and send a line of data to it this way:
-
- print $handle "some data\n";
-
- =head2 A Webget Client
-
- Here's a simple client that takes a remote host to fetch a document
- from, and then a list of documents to get from that host. This is a
- more interesting client than the previous one because it first sends
- something to the server before fetching the server's response.
-
- #!/usr/bin/perl -w
- use IO::Socket;
- unless (@ARGV > 1) { die "usage: $0 host document ..." }
- $host = shift(@ARGV);
- $EOL = "\015\012";
- $BLANK = $EOL x 2;
- foreach $document ( @ARGV ) {
- $remote = IO::Socket::INET->new( Proto => "tcp",
- PeerAddr => $host,
- PeerPort => "http(80)",
- );
- unless ($remote) { die "cannot connect to http daemon on $host" }
- $remote->autoflush(1);
- print $remote "GET $document HTTP/1.0" . $BLANK;
- while ( <$remote> ) { print }
- close $remote;
- }
-
- The web server handing the "http" service, which is assumed to be at
- its standard port, number 80. If your the web server you're trying to
- connect to is at a different port (like 1080 or 8080), you should specify
- as the named-parameter pair, C<< PeerPort => 8080 >>. The C<autoflush>
- method is used on the socket because otherwise the system would buffer
- up the output we sent it. (If you're on a Mac, you'll also need to
- change every C<"\n"> in your code that sends data over the network to
- be a C<"\015\012"> instead.)
-
- Connecting to the server is only the first part of the process: once you
- have the connection, you have to use the server's language. Each server
- on the network has its own little command language that it expects as
- input. The string that we send to the server starting with "GET" is in
- HTTP syntax. In this case, we simply request each specified document.
- Yes, we really are making a new connection for each document, even though
- it's the same host. That's the way you always used to have to speak HTTP.
- Recent versions of web browsers may request that the remote server leave
- the connection open a little while, but the server doesn't have to honor
- such a request.
-
- Here's an example of running that program, which we'll call I<webget>:
-
- % webget www.perl.com /guanaco.html
- HTTP/1.1 404 File Not Found
- Date: Thu, 08 May 1997 18:02:32 GMT
- Server: Apache/1.2b6
- Connection: close
- Content-type: text/html
-
- <HEAD><TITLE>404 File Not Found</TITLE></HEAD>
- <BODY><H1>File Not Found</H1>
- The requested URL /guanaco.html was not found on this server.<P>
- </BODY>
-
- Ok, so that's not very interesting, because it didn't find that
- particular document. But a long response wouldn't have fit on this page.
-
- For a more fully-featured version of this program, you should look to
- the I<lwp-request> program included with the LWP modules from CPAN.
-
- =head2 Interactive Client with IO::Socket
-
- Well, that's all fine if you want to send one command and get one answer,
- but what about setting up something fully interactive, somewhat like
- the way I<telnet> works? That way you can type a line, get the answer,
- type a line, get the answer, etc.
-
- This client is more complicated than the two we've done so far, but if
- you're on a system that supports the powerful C<fork> call, the solution
- isn't that rough. Once you've made the connection to whatever service
- you'd like to chat with, call C<fork> to clone your process. Each of
- these two identical process has a very simple job to do: the parent
- copies everything from the socket to standard output, while the child
- simultaneously copies everything from standard input to the socket.
- To accomplish the same thing using just one process would be I<much>
- harder, because it's easier to code two processes to do one thing than it
- is to code one process to do two things. (This keep-it-simple principle
- a cornerstones of the Unix philosophy, and good software engineering as
- well, which is probably why it's spread to other systems.)
-
- Here's the code:
-
- #!/usr/bin/perl -w
- use strict;
- use IO::Socket;
- my ($host, $port, $kidpid, $handle, $line);
-
- unless (@ARGV == 2) { die "usage: $0 host port" }
- ($host, $port) = @ARGV;
-
- # create a tcp connection to the specified host and port
- $handle = IO::Socket::INET->new(Proto => "tcp",
- PeerAddr => $host,
- PeerPort => $port)
- or die "can't connect to port $port on $host: $!";
-
- $handle->autoflush(1); # so output gets there right away
- print STDERR "[Connected to $host:$port]\n";
-
- # split the program into two processes, identical twins
- die "can't fork: $!" unless defined($kidpid = fork());
-
- # the if{} block runs only in the parent process
- if ($kidpid) {
- # copy the socket to standard output
- while (defined ($line = <$handle>)) {
- print STDOUT $line;
- }
- kill("TERM", $kidpid); # send SIGTERM to child
- }
- # the else{} block runs only in the child process
- else {
- # copy standard input to the socket
- while (defined ($line = <STDIN>)) {
- print $handle $line;
- }
- }
-
- The C<kill> function in the parent's C<if> block is there to send a
- signal to our child process (current running in the C<else> block)
- as soon as the remote server has closed its end of the connection.
-
- If the remote server sends data a byte at time, and you need that
- data immediately without waiting for a newline (which might not happen),
- you may wish to replace the C<while> loop in the parent with the
- following:
-
- my $byte;
- while (sysread($handle, $byte, 1) == 1) {
- print STDOUT $byte;
- }
-
- Making a system call for each byte you want to read is not very efficient
- (to put it mildly) but is the simplest to explain and works reasonably
- well.
-
- =head1 TCP Servers with IO::Socket
-
- As always, setting up a server is little bit more involved than running a client.
- The model is that the server creates a special kind of socket that
- does nothing but listen on a particular port for incoming connections.
- It does this by calling the C<< IO::Socket::INET->new() >> method with
- slightly different arguments than the client did.
-
- =over
-
- =item Proto
-
- This is which protocol to use. Like our clients, we'll
- still specify C<"tcp"> here.
-
- =item LocalPort
-
- We specify a local
- port in the C<LocalPort> argument, which we didn't do for the client.
- This is service name or port number for which you want to be the
- server. (Under Unix, ports under 1024 are restricted to the
- superuser.) In our sample, we'll use port 9000, but you can use
- any port that's not currently in use on your system. If you try
- to use one already in used, you'll get an "Address already in use"
- message. Under Unix, the C<netstat -a> command will show
- which services current have servers.
-
- =item Listen
-
- The C<Listen> parameter is set to the maximum number of
- pending connections we can accept until we turn away incoming clients.
- Think of it as a call-waiting queue for your telephone.
- The low-level Socket module has a special symbol for the system maximum, which
- is SOMAXCONN.
-
- =item Reuse
-
- The C<Reuse> parameter is needed so that we restart our server
- manually without waiting a few minutes to allow system buffers to
- clear out.
-
- =back
-
- Once the generic server socket has been created using the parameters
- listed above, the server then waits for a new client to connect
- to it. The server blocks in the C<accept> method, which eventually an
- bidirectional connection to the remote client. (Make sure to autoflush
- this handle to circumvent buffering.)
-
- To add to user-friendliness, our server prompts the user for commands.
- Most servers don't do this. Because of the prompt without a newline,
- you'll have to use the C<sysread> variant of the interactive client above.
-
- This server accepts one of five different commands, sending output
- back to the client. Note that unlike most network servers, this one
- only handles one incoming client at a time. Multithreaded servers are
- covered in Chapter 6 of the Camel.
-
- Here's the code. We'll
-
- #!/usr/bin/perl -w
- use IO::Socket;
- use Net::hostent; # for OO version of gethostbyaddr
-
- $PORT = 9000; # pick something not in use
-
- $server = IO::Socket::INET->new( Proto => 'tcp',
- LocalPort => $PORT,
- Listen => SOMAXCONN,
- Reuse => 1);
-
- die "can't setup server" unless $server;
- print "[Server $0 accepting clients]\n";
-
- while ($client = $server->accept()) {
- $client->autoflush(1);
- print $client "Welcome to $0; type help for command list.\n";
- $hostinfo = gethostbyaddr($client->peeraddr);
- printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
- print $client "Command? ";
- while ( <$client>) {
- next unless /\S/; # blank line
- if (/quit|exit/i) { last; }
- elsif (/date|time/i) { printf $client "%s\n", scalar localtime; }
- elsif (/who/i ) { print $client `who 2>&1`; }
- elsif (/cookie/i ) { print $client `/usr/games/fortune 2>&1`; }
- elsif (/motd/i ) { print $client `cat /etc/motd 2>&1`; }
- else {
- print $client "Commands: quit date who cookie motd\n";
- }
- } continue {
- print $client "Command? ";
- }
- close $client;
- }
-
- =head1 UDP: Message Passing
-
- Another kind of client-server setup is one that uses not connections, but
- messages. UDP communications involve much lower overhead but also provide
- less reliability, as there are no promises that messages will arrive at
- all, let alone in order and unmangled. Still, UDP offers some advantages
- over TCP, including being able to "broadcast" or "multicast" to a whole
- bunch of destination hosts at once (usually on your local subnet). If you
- find yourself overly concerned about reliability and start building checks
- into your message system, then you probably should use just TCP to start
- with.
-
- Here's a UDP program similar to the sample Internet TCP client given
- earlier. However, instead of checking one host at a time, the UDP version
- will check many of them asynchronously by simulating a multicast and then
- using select() to do a timed-out wait for I/O. To do something similar
- with TCP, you'd have to use a different socket handle for each host.
-
- #!/usr/bin/perl -w
- use strict;
- use Socket;
- use Sys::Hostname;
-
- my ( $count, $hisiaddr, $hispaddr, $histime,
- $host, $iaddr, $paddr, $port, $proto,
- $rin, $rout, $rtime, $SECS_of_70_YEARS);
-
- $SECS_of_70_YEARS = 2208988800;
-
- $iaddr = gethostbyname(hostname());
- $proto = getprotobyname('udp');
- $port = getservbyname('time', 'udp');
- $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
-
- socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!";
- bind(SOCKET, $paddr) || die "bind: $!";
-
- $| = 1;
- printf "%-12s %8s %s\n", "localhost", 0, scalar localtime time;
- $count = 0;
- for $host (@ARGV) {
- $count++;
- $hisiaddr = inet_aton($host) || die "unknown host";
- $hispaddr = sockaddr_in($port, $hisiaddr);
- defined(send(SOCKET, 0, 0, $hispaddr)) || die "send $host: $!";
- }
-
- $rin = '';
- vec($rin, fileno(SOCKET), 1) = 1;
-
- # timeout after 10.0 seconds
- while ($count && select($rout = $rin, undef, undef, 10.0)) {
- $rtime = '';
- ($hispaddr = recv(SOCKET, $rtime, 4, 0)) || die "recv: $!";
- ($port, $hisiaddr) = sockaddr_in($hispaddr);
- $host = gethostbyaddr($hisiaddr, AF_INET);
- $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
- printf "%-12s ", $host;
- printf "%8d %s\n", $histime - time, scalar localtime($histime);
- $count--;
- }
-
- =head1 SysV IPC
-
- While System V IPC isn't so widely used as sockets, it still has some
- interesting uses. You can't, however, effectively use SysV IPC or
- Berkeley mmap() to have shared memory so as to share a variable amongst
- several processes. That's because Perl would reallocate your string when
- you weren't wanting it to.
-
- Here's a small example showing shared memory usage.
-
- use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU);
-
- $size = 2000;
- $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!";
- print "shm key $id\n";
-
- $message = "Message #1";
- shmwrite($id, $message, 0, 60) || die "$!";
- print "wrote: '$message'\n";
- shmread($id, $buff, 0, 60) || die "$!";
- print "read : '$buff'\n";
-
- # the buffer of shmread is zero-character end-padded.
- substr($buff, index($buff, "\0")) = '';
- print "un" unless $buff eq $message;
- print "swell\n";
-
- print "deleting shm $id\n";
- shmctl($id, IPC_RMID, 0) || die "$!";
-
- Here's an example of a semaphore:
-
- use IPC::SysV qw(IPC_CREAT);
-
- $IPC_KEY = 1234;
- $id = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!";
- print "shm key $id\n";
-
- Put this code in a separate file to be run in more than one process.
- Call the file F<take>:
-
- # create a semaphore
-
- $IPC_KEY = 1234;
- $id = semget($IPC_KEY, 0 , 0 );
- die if !defined($id);
-
- $semnum = 0;
- $semflag = 0;
-
- # 'take' semaphore
- # wait for semaphore to be zero
- $semop = 0;
- $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag);
-
- # Increment the semaphore count
- $semop = 1;
- $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag);
- $opstring = $opstring1 . $opstring2;
-
- semop($id,$opstring) || die "$!";
-
- Put this code in a separate file to be run in more than one process.
- Call this file F<give>:
-
- # 'give' the semaphore
- # run this in the original process and you will see
- # that the second process continues
-
- $IPC_KEY = 1234;
- $id = semget($IPC_KEY, 0, 0);
- die if !defined($id);
-
- $semnum = 0;
- $semflag = 0;
-
- # Decrement the semaphore count
- $semop = -1;
- $opstring = pack("s!s!s!", $semnum, $semop, $semflag);
-
- semop($id,$opstring) || die "$!";
-
- The SysV IPC code above was written long ago, and it's definitely
- clunky looking. For a more modern look, see the IPC::SysV module
- which is included with Perl starting from Perl 5.005.
-
- A small example demonstrating SysV message queues:
-
- use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU);
-
- my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU);
-
- my $sent = "message";
- my $type = 1234;
- my $rcvd;
- my $type_rcvd;
-
- if (defined $id) {
- if (msgsnd($id, pack("l! a*", $type_sent, $sent), 0)) {
- if (msgrcv($id, $rcvd, 60, 0, 0)) {
- ($type_rcvd, $rcvd) = unpack("l! a*", $rcvd);
- if ($rcvd eq $sent) {
- print "okay\n";
- } else {
- print "not okay\n";
- }
- } else {
- die "# msgrcv failed\n";
- }
- } else {
- die "# msgsnd failed\n";
- }
- msgctl($id, IPC_RMID, 0) || die "# msgctl failed: $!\n";
- } else {
- die "# msgget failed\n";
- }
-
- =head1 NOTES
-
- Most of these routines quietly but politely return C<undef> when they
- fail instead of causing your program to die right then and there due to
- an uncaught exception. (Actually, some of the new I<Socket> conversion
- functions croak() on bad arguments.) It is therefore essential to
- check return values from these functions. Always begin your socket
- programs this way for optimal success, and don't forget to add B<-T>
- taint checking flag to the #! line for servers:
-
- #!/usr/bin/perl -Tw
- use strict;
- use sigtrap;
- use Socket;
-
- =head1 BUGS
-
- All these routines create system-specific portability problems. As noted
- elsewhere, Perl is at the mercy of your C libraries for much of its system
- behaviour. It's probably safest to assume broken SysV semantics for
- signals and to stick with simple TCP and UDP socket operations; e.g., don't
- try to pass open file descriptors over a local UDP datagram socket if you
- want your code to stand a chance of being portable.
-
- As mentioned in the signals section, because few vendors provide C
- libraries that are safely re-entrant, the prudent programmer will do
- little else within a handler beyond setting a numeric variable that
- already exists; or, if locked into a slow (restarting) system call,
- using die() to raise an exception and longjmp(3) out. In fact, even
- these may in some cases cause a core dump. It's probably best to avoid
- signals except where they are absolutely inevitable. This
- will be addressed in a future release of Perl.
-
- =head1 AUTHOR
-
- Tom Christiansen, with occasional vestiges of Larry Wall's original
- version and suggestions from the Perl Porters.
-
- =head1 SEE ALSO
-
- There's a lot more to networking than this, but this should get you
- started.
-
- For intrepid programmers, the indispensable textbook is I<Unix Network
- Programming> by W. Richard Stevens (published by Addison-Wesley). Note
- that most books on networking address networking from the perspective of
- a C programmer; translation to Perl is left as an exercise for the reader.
-
- The IO::Socket(3) manpage describes the object library, and the Socket(3)
- manpage describes the low-level interface to sockets. Besides the obvious
- functions in L<perlfunc>, you should also check out the F<modules> file
- at your nearest CPAN site. (See L<perlmodlib> or best yet, the F<Perl
- FAQ> for a description of what CPAN is and where to get it.)
-
- Section 5 of the F<modules> file is devoted to "Networking, Device Control
- (modems), and Interprocess Communication", and contains numerous unbundled
- modules numerous networking modules, Chat and Expect operations, CGI
- programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
- Threads, and ToolTalk--just to name a few.
-