perl Socket编程例子
Perl的networking 功能非常强大，基本上用c/c++能做的事perl都能做，而且做得更轻松方便，甚至可以只用10来行代码就完成了c/c++要几十上百甚至几百行才能完成得好的工作。在networking方面，最基础的是BSD socket编程，但往往perl入门时在这个方面，最头疼的无疑是如何开始，如何Step by
step。最好的药方就是Example，一段完整的可以运行（working）的代码，通过实践来感受远比看枯燥的manual来得深刻。
以下给出几段使用Socket及IO::Socket编写的Server/client，他们能实现最简单但是却最基本的任务，包括一个forking/accept的模型。可以直接复制这些代码，然后小加修改即可开发一些小型的tcp/udp应用了。
TCP 客户端, Socket 模块
简介：实现从服务器端读取一行信息然后返回
1 #!/usr/bin/perl -w
2 # tcp_socket_cli.pl
3 use strict;
4 use Socket;
5
6 my $addr = $ARGV || '127.0.0.1';
7 my $port = $ARGV || '3000';
8 my $dest = sockaddr_in($port, inet_aton($addr));
9 my $buf = undef;
10
11 socket(SOCK,PF_INET,SOCK_STREAM,6) or die "Can't create socket: $!";
12 connect(SOCK,$dest) or die "Can't connect: $!";
13
14 my $bs = sysread(SOCK, $buf, 2048); # try to read 2048
15 print "Received $bs bytes, content $buf\n"; # actually get $bs bytes
16 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的功能
1 #!/usr/bin/perl -w
2 # tcp_socket_dt_srv.pl
3 use strict;
4 use Socket;
5 use IO::Handle;
6 use POSIX qw(WNOHANG);
7
8 my $port = $ARGV || '3000';
9 my $proto = getprotobyname('tcp');
10
11 $SIG{'CHLD'} = sub {
12 while((my $pid = waitpid(-1, WNOHANG)) >0) {
13 print "Reaped child $pid\n";
14 }
15 };
16
17 socket(SOCK, AF_INET, SOCK_STREAM, getprotobyname('tcp'))
18 or die "socket() failed: $!";
19 setsockopt(SOCK,SOL_SOCKET,SO_REUSEADDR,1)
20 or die "Can't set SO_REUSADDR: $!" ;
21
22 my $my_addr = sockaddr_in($port,INADDR_ANY);
23 bind(SOCK,$my_addr) or die "bind() failed: $!";
24 listen(SOCK,SOMAXCONN) or die "listen() failed: $!";
25
26 warn "Starting server on port $port...\n";
27
28 while (1) {
29 next unless my $remote_addr = accept(SESSION,SOCK);
30 defined(my $pid=fork) or die "Can't fork: $!\n";
31
32 if($pid==0) {
33 my ($port,$hisaddr) = sockaddr_in($remote_addr);
34 warn "Connection from [",inet_ntoa($hisaddr),",$port]\n";
35 SESSION->autoflush(1);
36 print SESSION (my $s = localtime);
37 warn "Connection from [",inet_ntoa($hisaddr),",$port] finished\n";
38 close SESSION;
39 exit 0;
40 }else {
41 print "Forking child $pid\n";
42 }
43 }
44
45 close SOCK;
利用上述tcp_socket_cli.pl访问该server的执行结果：
$ perl tcp_socket_dt_srv.pl
Starting server on port 3000...
Connection from
Connection from finished
Reaped child 13927
Forking child 13927
TCP 客户端 ,IO::Sockiet模块
简介：同样为客户端，不过使用的是IO::Socket 面向对象模块
1 #!/usr/bin/perl -w
2 # tcp_iosocket_cli.pl
3 use strict;
4 use IO::Socket;
5
6 my $addr = $ARGV || '127.0.0.1';
7 my $port = $ARGV || '3000';
8 my $buf = undef;
9
10 my $sock = IO::Socket::INET->new(
11 PeerAddr => $addr,
12 PeerPort => $port,
13 Proto => 'tcp')
14 or die "Can't connect: $!\n";
15 $buf = <$sock>;
16 my $bs = length($buf);
17 print "Received $bs bytes, content $buf\n"; # actually get $bs bytes
18 close $sock;
TCP 服务端, IO::Socket模块, forking/accept模型
简介：同样的一个daytime
服务器，使用IO::Socket重写。
1 #!/usr/bin/perl
2 # tcp_iosocket_dt_srv.pl
3 use strict;
4 use IO::Socket;
5 use POSIX qw(WNOHANG);
6
7 $SIG = sub {
8 while((my $pid = waitpid(-1, WNOHANG)) >0) {
9 print "Reaped child $pid\n";
10 }
11 };
12
13 my $port = $ARGV || '3000';
14 my $sock = IO::Socket::INET->new( Listen => 20,
15 LocalPort => $port,
16 Timeout => 60*1,
17 Reuse => 1)
18 or die "Can't create listening socket: $!\n";
19
20 warn "Starting server on port $port...\n";
21 while (1) {
22 next unless my $session = $sock->accept;
23 defined (my $pid = fork) or die "Can't fork: $!\n";
24
25 if($pid == 0) {
26 my $peer = gethostbyaddr($session->peeraddr,AF_INET) || $session->peerhost;
27 my $port = $session->peerport;
28 warn "Connection from [$peer,$port]\n";
29 $session->autoflush(1);
30 print $session (my $s = localtime), "\n";
31 warn "Connection from [$peer,$port] finished\n";
32 close $session;
33 exit 0;
34 }else {
35 print "Forking child $pid\n";
36 }
37 }
38 close $sock;
现在再介绍使用Socket及IO::Socket模块来进行Unix domain
Socket的client/server开发。Unix Domain Socket（简称unix
socket）和TCP/UDP等INET类型socket相比起来有几个优点：
[*]安全性高，unix socket只在单机环境中使用，不支持机器之间通信
[*]效率高，执行时的速度约是TCP的两倍，多用于操作系统内部通信（IPC）
[*]支持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 || '/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服务器。
1 #!/usr/bin/perl -w
2 # tcp_socket_dt_srv.pl
3 use strict;
4 use Socket;
5 use IO::Handle;
6 use POSIX qw(WNOHANG);
7
8 my $path = $ARGV || '/tmp/daytime.sock';
9
10 $SIG{'CHLD'} = sub {
11 while((my $pid = waitpid(-1, WNOHANG)) >0) {
12 print "Reaped child $pid\n";
13 }
14 };
15
16 socket(SOCK, PF_UNIX, SOCK_STREAM, 0)
17 or die "socket() failed: $!";
18 setsockopt(SOCK,SOL_SOCKET,SO_REUSEADDR,1)
19 or die "Can't set SO_REUSADDR: $!" ;
20
21 unlink $path if -r $path;
22
23 bind(SOCK,sockaddr_un($path)) or die "bind() failed: $!";
24 listen(SOCK,SOMAXCONN) or die "listen() failed: $!";
25
26 warn "Starting server on path $path...\n";
27
28 while (1) {
29 next unless my $sockname = accept(SESSION,SOCK);
30 defined (my $pid=fork) or die "Can't fork: $!\n";
31
32 if($pid==0) {
33 SESSION->autoflush(1);
34 print SESSION (my $s = localtime);
35 close SESSION;
36 exit 0;
37 }else {
38 print "Forking child $pid\n";
39 }
40 }
41
42 close SOCK;
页:
[1]