快捷導(dǎo)航

perl Socket編程實(shí)例代碼

更新時(shí)間：2013年02月01日 00:29:28 作者：

Perl的networking 功能非常強(qiáng)大，基本上用c/c++能做的事perl都能做，而且做得更輕松方便，甚至可以只用10來(lái)行代碼就完成了c/c++要幾十上百甚至幾百行才能完成得好的工作

在networking方面，最基礎(chǔ)的是BSD socket編程，但往往perl入門(mén)時(shí)在這個(gè)方面，最頭疼的無(wú)疑是如何開(kāi)始，如何Step by step。最好的藥方就是Example，一段完整的可以運(yùn)行（working）的代碼，通過(guò)實(shí)踐來(lái)感受遠(yuǎn)比看枯燥的manual來(lái)得深刻。

以下給出幾段使用Socket及IO::Socket編寫(xiě)的Server/client，他們能實(shí)現(xiàn)最簡(jiǎn)單但是卻最基本的任務(wù)，包括一個(gè)forking/accept的模型?？梢灾苯訌?fù)制這些代碼，然后小加修改即可開(kāi)發(fā)一些小型的tcp/udp應(yīng)用了。

TCP 客戶(hù)端, Socket 模塊

簡(jiǎn)介：實(shí)現(xiàn)從服務(wù)器端讀取一行信息然后返回

復(fù)制代碼代碼如下:

#!/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;

執(zhí)行結(jié)果：
perl tcp_socket_cli.pl localhost 25
Received 41 bytes, content 220 ESMTP Postfix - ExtMail 0.12-hzqbbc

TCP 服務(wù)端 Socket模塊, forking/accept模型
簡(jiǎn)介：一個(gè)多進(jìn)程的TCP服務(wù)器，sample中實(shí)現(xiàn)了daytime的功能

復(fù)制代碼代碼如下:

#!/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訪(fǎng)問(wèn)該server的執(zhí)行結(jié)果：
[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 13927

TCP 客戶(hù)端 ,IO::Sockiet模塊
簡(jiǎn)介：同樣為客戶(hù)端，不過(guò)使用的是IO::Socket 面向?qū)ο竽K

復(fù)制代碼代碼如下:

#!/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 服務(wù)端, IO::Socket模塊, forking/accept模型
簡(jiǎn)介：同樣的一個(gè)daytime
服務(wù)器，使用IO::Socket重寫(xiě)。

復(fù)制代碼代碼如下:

#!/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;

現(xiàn)在再介紹使用Socket及IO::Socket模塊來(lái)進(jìn)行Unix domain Socket的client/server開(kāi)發(fā)。Unix Domain Socket（簡(jiǎn)稱(chēng)unix socket）和TCP/UDP等INET類(lèi)型socket相比起來(lái)有幾個(gè)優(yōu)點(diǎn)：
1）、安全性高，unix socket只在單機(jī)環(huán)境中使用，不支持機(jī)器之間通信
2）、效率高，執(zhí)行時(shí)的速度約是TCP的兩倍，多用于操作系統(tǒng)內(nèi)部通信（IPC）
3）、支持SOCK_DGRAM，但和UDP不同，前后消息是嚴(yán)格有序的

因此使用Unix socket來(lái)設(shè)計(jì)單機(jī)的IPC應(yīng)用是首選。非常實(shí)用。大量的Unix應(yīng)用軟件都使用unix socket來(lái)進(jìn)行程序間通信。

Unix Domain Socket客戶(hù)端, Socket模塊
簡(jiǎn)介：使用Unix domain socket的客戶(hù)端。

復(fù)制代碼代碼如下:

#!/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 服務(wù)端, Socket模塊
簡(jiǎn)介：使用Unix domain socket實(shí)現(xiàn)的daytime服務(wù)器。

復(fù)制代碼代碼如下:

#!/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;