X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pod%2Fperlipc.pod;h=6467a295e3bf3f235fa5972b74abbd0e14b3d173;hb=aaa68c4a88ea4a62f62819baf4cacc0ca679c5fa;hp=3649e4f88339a167c9e7d9cae34cc068506c6940;hpb=1450d0701497dd4642a74925571472b56356c156;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pod/perlipc.pod b/pod/perlipc.pod index 3649e4f..6467a29 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -234,8 +234,7 @@ 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. +since you could no longer even write SIGCHLD handlers. =head1 Using open() for IPC @@ -453,8 +452,8 @@ doesn't actually work: open(PROG_FOR_READING_AND_WRITING, "| some program |") -and if you forget to use the B<-w> flag, then you'll miss out -entirely on the diagnostic message: +and if you forget to use the C 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. @@ -667,7 +666,8 @@ instead. my $port = shift || 2345; my $proto = getprotobyname('tcp'); - $port = $1 if $port =~ /(\d+)/; # untaint port number + + ($port) = $port =~ /^(\d+)$/ || die "invalid port"; socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, @@ -710,7 +710,8 @@ go back to service a new client. my $port = shift || 2345; my $proto = getprotobyname('tcp'); - $port = $1 if $port =~ /(\d+)/; # untaint port number + + ($port) = $port =~ /^(\d+)$/ || die "invalid port"; socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, @@ -835,7 +836,7 @@ domain sockets can show up in the file system with an ls(1) listing. You can test for these with Perl's B<-S> file test: unless ( -S '/dev/log' ) { - die "something's wicked with the print system"; + die "something's wicked with the log system"; } Here's a sample Unix-domain client: @@ -922,7 +923,7 @@ 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 +IO::Socket from CPAN, where you'll also 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. @@ -1022,9 +1023,9 @@ something to the server before fetching the server's response. } 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 +its standard port, number 80. If 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 8080>. The C +as the named-parameter pair, C<< PeerPort => 8080 >>. The C 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 @@ -1142,7 +1143,7 @@ well. 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 Cnew()> method with +It does this by calling the C<< IO::Socket::INET->new() >> method with slightly different arguments than the client did. =over @@ -1305,16 +1306,16 @@ 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 S_IRWXG S_IRWXO); + use IPC::SysV qw(IPC_PRIVATE IPC_RMID S_IRWXU); $size = 2000; - $key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!"; - print "shm key $key\n"; + $id = shmget(IPC_PRIVATE, $size, S_IRWXU) || die "$!"; + print "shm key $id\n"; $message = "Message #1"; - shmwrite($key, $message, 0, 60) || die "$!"; + shmwrite($id, $message, 0, 60) || die "$!"; print "wrote: '$message'\n"; - shmread($key, $buff, 0, 60) || die "$!"; + shmread($id, $buff, 0, 60) || die "$!"; print "read : '$buff'\n"; # the buffer of shmread is zero-character end-padded. @@ -1322,16 +1323,16 @@ Here's a small example showing shared memory usage. print "un" unless $buff eq $message; print "swell\n"; - print "deleting shm $key\n"; - shmctl($key, IPC_RMID, 0) || die "$!"; + 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; - $key = semget($IPC_KEY, 10, 0666 | IPC_CREAT ) || die "$!"; - print "shm key $key\n"; + $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: @@ -1339,8 +1340,8 @@ Call the file F: # create a semaphore $IPC_KEY = 1234; - $key = semget($IPC_KEY, 0 , 0 ); - die if !defined($key); + $id = semget($IPC_KEY, 0 , 0 ); + die if !defined($id); $semnum = 0; $semflag = 0; @@ -1348,14 +1349,14 @@ Call the file F: # 'take' semaphore # wait for semaphore to be zero $semop = 0; - $opstring1 = pack("sss", $semnum, $semop, $semflag); + $opstring1 = pack("s!s!s!", $semnum, $semop, $semflag); # Increment the semaphore count $semop = 1; - $opstring2 = pack("sss", $semnum, $semop, $semflag); + $opstring2 = pack("s!s!s!", $semnum, $semop, $semflag); $opstring = $opstring1 . $opstring2; - semop($key,$opstring) || die "$!"; + semop($id,$opstring) || die "$!"; Put this code in a separate file to be run in more than one process. Call this file F: @@ -1365,22 +1366,53 @@ Call this file F: # that the second process continues $IPC_KEY = 1234; - $key = semget($IPC_KEY, 0, 0); - die if !defined($key); + $id = semget($IPC_KEY, 0, 0); + die if !defined($id); $semnum = 0; $semflag = 0; # Decrement the semaphore count $semop = -1; - $opstring = pack("sss", $semnum, $semop, $semflag); + $opstring = pack("s!s!s!", $semnum, $semop, $semflag); - semop($key,$opstring) || die "$!"; + 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 when they