当前位置 博文首页 > perl Socket编程实例代码

    perl Socket编程实例代码

    作者:admin 时间:2021-02-06 21:01

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

    js