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[0] || '127.0.0.1';
 7 my $port = $ARGV[1] || '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[0] || '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的執行結果:

[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 面向對象模塊
 1 #!/usr/bin/perl -w
 2 # tcp_iosocket_cli.pl
 3 use strict;
 4 use IO::Socket;
 5 
 6 my $addr = $ARGV[0] || '127.0.0.1';
 7 my $port = $ARGV[1] || '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[0] || '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[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服務器。
 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[0] || '/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;

 


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM