?? perlipc.pod
字號:
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-E<gt>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 as well as later in this manpage.
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 S_IRWXG S_IRWXO);
$size = 2000;
$key = shmget(IPC_PRIVATE, $size, S_IRWXU|S_IRWXG|S_IRWXO) || die "$!";
print "shm key $key\n";
$message = "Message #1";
shmwrite($key, $message, 0, 60) || die "$!";
print "wrote: '$message'\n";
shmread($key, $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 $key\n";
shmctl($key, 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";
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;
$key = semget($IPC_KEY, 0 , 0 );
die if !defined($key);
$semnum = 0;
$semflag = 0;
# 'take' semaphore
# wait for semaphore to be zero
$semop = 0;
$opstring1 = pack("sss", $semnum, $semop, $semflag);
# Increment the semaphore count
$semop = 1;
$opstring2 = pack("sss", $semnum, $semop, $semflag);
$opstring = $opstring1 . $opstring2;
semop($key,$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;
$key = semget($IPC_KEY, 0, 0);
die if !defined($key);
$semnum = 0;
$semflag = 0;
# Decrement the semaphore count
$semop = -1;
$opstring = pack("sss", $semnum, $semop, $semflag);
semop($key,$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.
=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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -