在networking方面，最基礎的是BSD socket編程，但往往perl入門時在這個方面，最頭疼的無疑是如何開始，如何Step by step。最好的藥方就是Example，一段完整的可以運行（working）的代碼，通過實踐來感受遠比看枯燥的manual來得深刻。
以下給出幾段使用Socket及IO::Socket編寫的Server/client，他們能實現最簡單但是卻最基本的任務，包括一個forking/accept的模型?？梢灾苯訌椭七@些代碼，然后小加修改即可開發一些小型的tcp/udp應用了。
TCP 客戶端, Socket 模塊
簡介：實現從服務器端讀取一行信息然后返回
復制代碼 代碼如下:
#!/usr/bin/perl -w
# tcp_socket_cli.pl
use strict;
use Socket;
my $addr = $ARGV[0] || '127.0.0.1';
my $port = $ARGV[1] || '3000';
my $dest = sockaddr_in($port, inet_aton($addr));
my $buf = undef;
socket(SOCK,PF_INET,SOCK_STREAM,6) or die "Can't create socket: $!";
connect(SOCK,$dest) or die "Can't connect: $!";
my $bs = sysread(SOCK, $buf, 2048); # try to read 2048
print "Received $bs bytes, content $buf/n"; # actually get $bs bytes
close SOCK;
執行結果：
perl tcp_socket_cli.pl localhost 25
Received 41 bytes, content 220 ESMTP Postfix - ExtMail 0.12-hzqbbcTCP 服務端 Socket模塊, forking/accept模型
簡介：一個多進程的TCP服務器，sample中實現了daytime的功能
復制代碼 代碼如下:
#!/usr/bin/perl -w
# tcp_socket_dt_srv.pl
use strict;
use Socket;
use IO::Handle;
use POSIX qw(WNOHANG);
my $port = $ARGV[0] || '3000';
my $proto = getprotobyname('tcp');
$SIG{'CHLD'} = sub {
while((my $pid = waitpid(-1, WNOHANG)) >0) {
print "Reaped child $pid/n";
}
};
socket(SOCK, AF_INET, SOCK_STREAM, getprotobyname('tcp'))
or die "socket() failed: $!";
setsockopt(SOCK,SOL_SOCKET,SO_REUSEADDR,1)
or die "Can't set SO_REUSADDR: $!" ;
my $my_addr = sockaddr_in($port,INADDR_ANY);
bind(SOCK,$my_addr) or die "bind() failed: $!";
listen(SOCK,SOMAXCONN) or die "listen() failed: $!";
warn "Starting server on port $port.../n";
while (1) {
next unless my $remote_addr = accept(SESSION,SOCK);
defined(my $pid=fork) or die "Can't fork: $!/n";
if($pid==0) {
my ($port,$hisaddr) = sockaddr_in($remote_addr);
warn "Connection from [",inet_ntoa($hisaddr),",$port]/n";
SESSION->autoflush(1);
print SESSION (my $s = localtime);
warn "Connection from [",inet_ntoa($hisaddr),",$port] finished/n";
close SESSION;
exit 0;
}else {
print "Forking child $pid/n";
}
}
close SOCK;
利用上述tcp_socket_cli.pl訪問該server的執行結果：
[hzqbbc@local misc]$ perl tcp_socket_dt_srv.pl
Starting server on port 3000...
Connection from [127.0.0.1,32888]
Connection from [127.0.0.1,32888] finished
Reaped child 13927
Forking child 13927TCP 客戶端 ,IO::Sockiet模塊
簡介：同樣為客戶端，不過使用的是IO::Socket 面向對象模塊
復制代碼 代碼如下:
#!/usr/bin/perl -w
# tcp_iosocket_cli.pl
use strict;
use IO::Socket;
my $addr = $ARGV[0] || '127.0.0.1';
my $port = $ARGV[1] || '3000';
my $buf = undef;
my $sock = IO::Socket::INET->new(
PeerAddr => $addr,
PeerPort => $port,
Proto => 'tcp')
or die "Can't connect: $!/n";
$buf = <$sock>;
my $bs = length($buf);
print "Received $bs bytes, content $buf/n"; # actually get $bs bytes
close $sock;
TCP 服務端, IO::Socket模塊, forking/accept模型
簡介：同樣的一個daytime
服務器，使用IO::Socket重寫。
復制代碼 代碼如下:
#!/usr/bin/perl
# tcp_iosocket_dt_srv.pl
use strict;
use IO::Socket;
use POSIX qw(WNOHANG);
$SIG = sub {
while((my $pid = waitpid(-1, WNOHANG)) >0) {
print "Reaped child $pid/n";
}
};
my $port = $ARGV[0] || '3000';
my $sock = IO::Socket::INET->new( Listen => 20,
LocalPort => $port,
Timeout => 60*1,
Reuse => 1)
or die "Can't create listening socket: $!/n";
warn "Starting server on port $port.../n";
while (1) {
next unless my $session = $sock->accept;
defined (my $pid = fork) or die "Can't fork: $!/n";
if($pid == 0) {
my $peer = gethostbyaddr($session->peeraddr,AF_INET) || $session->peerhost;
my $port = $session->peerport;
warn "Connection from [$peer,$port]/n";
$session->autoflush(1);
print $session (my $s = localtime), "/n";
warn "Connection from [$peer,$port] finished/n";
close $session;
exit 0;
}else {
print "Forking child $pid/n";
}
}
close $sock;
現在再介紹使用Socket及IO::Socket模塊來進行Unix domain Socket的client/server開發。Unix Domain Socket（簡稱unix socket）和TCP/UDP等INET類型socket相比起來有幾個優點：
1）、安全性高，unix socket只在單機環境中使用，不支持機器之間通信
2）、效率高，執行時的速度約是TCP的兩倍，多用于操作系統內部通信（IPC）
3）、支持SOCK_DGRAM，但和UDP不同，前后消息是嚴格有序的因此使用Unix socket來設計單機的IPC應用是首選。非常實用。大量的Unix應用軟件都使用unix socket來進行程序間通信。
Unix Domain Socket客戶端, Socket模塊
簡介：使用Unix domain socket的客戶端。
復制代碼 代碼如下:
#!/usr/bin/perl -w
use strict;
use Socket;
use IO::Handle;
my $path = $ARGV[0] || '/tmp/daytime.sock';
socket(my $sock, PF_UNIX, SOCK_STREAM, 0);
my $sun = sockaddr_un($path);
connect($sock, $sun) or die "Connect: $!/n";
$sock->autoflush(1);
my $buf = <$sock>;
my $bs = length($buf);
print "Received $bs bytes, content $buf/n";
close $sock;
Unix Domain Socket 服務端, Socket模塊
簡介：使用Unix domain socket實現的daytime服務器。
復制代碼 代碼如下:
#!/usr/bin/perl -w
# tcp_socket_dt_srv.pl
use strict;
use Socket;
use IO::Handle;
use POSIX qw(WNOHANG);
my $path = $ARGV[0] || '/tmp/daytime.sock';
$SIG{'CHLD'} = sub {
while((my $pid = waitpid(-1, WNOHANG)) >0) {
print "Reaped child $pid/n";
}
};
socket(SOCK, PF_UNIX, SOCK_STREAM, 0)
or die "socket() failed: $!";
setsockopt(SOCK,SOL_SOCKET,SO_REUSEADDR,1)
or die "Can't set SO_REUSADDR: $!" ;
unlink $path if -r $path;
bind(SOCK,sockaddr_un($path)) or die "bind() failed: $!";
listen(SOCK,SOMAXCONN) or die "listen() failed: $!";
warn "Starting server on path $path.../n";
while (1) {
next unless my $sockname = accept(SESSION,SOCK);
defined (my $pid=fork) or die "Can't fork: $!/n";
if($pid==0) {
SESSION->autoflush(1);
print SESSION (my $s = localtime);
close SESSION;
exit 0;
}else {
print "Forking child $pid/n";
}
}
close SOCK;
