Perl Socket 编程样例（1）(转载)

时间：2008-03-07 来源：zhenggb

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 模块

简介：实现从服务器端读取一行信息然后返回

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