perl Socket编程实例代码

在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-hzqbbc

tcp 服务端 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 13927

tcp 客户端 ,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;