脚本之家,脚本语言编程技术及教程分享平台!
分类导航

Python|VBS|Ruby|Lua|perl|VBA|Golang|PowerShell|Erlang|autoit|Dos|bat|

服务器之家 - 脚本之家 - perl - perl Socket编程实例代码

perl Socket编程实例代码

2020-06-05 13:51perl教程网 perl

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;


现在再介绍使用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;

 

延伸 · 阅读

精彩推荐
  • perlPerl List::Util模块使用实例

    Perl List::Util模块使用实例

    这篇文章主要介绍了Perl List::Util模块使用实例,本文给出扫描符合条件的某个列表并取出第一个符合条件的、求1到1000之间的和 、求一组数字的最大值与最小...

    脚本之家4712020-06-22
  • perlperl pop push shift unshift实例介绍

    perl pop push shift unshift实例介绍

    perl的pop跟push操作数组的最右边,shift跟unshift操作数组的最左边 ...

    脚本之家4612020-06-10
  • perlperl常见问题集合之二

    perl常见问题集合之二

    哪些平台上有 Perl?要到哪里去找? Perl的标准发行版(由 perl 发展小组负责维护)仅以原始码形式发行。您可在 http: //www.perl.com/CPAN/src/latest.tar.gz处取得。这个档...

    脚本之家2102020-05-29
  • perlperl命令行参数内建数组@ARGV浅析

    perl命令行参数内建数组@ARGV浅析

    这篇文章主要介绍了perl命令行参数内建数组@ARGV浅析,本文重点在于讲解@ARGV的用法,并通过实例来说明,需要的朋友可以参考下 ...

    perl教程网6162020-06-18
  • perlPerl从文件中读取字符串的两种实现方法

    Perl从文件中读取字符串的两种实现方法

    有时候我们需要从文件中读取字符串,这里简单介绍下, 需要的朋友可以参考下 ...

    脚本之家6252020-06-08
  • perlPerl使用nginx FastCGI环境做WEB开发实例

    Perl使用nginx FastCGI环境做WEB开发实例

    这篇文章主要介绍了Perl使用nginx FastCGI环境做WEB开发实例,实现了路由系统和模板系统,需要的朋友可以参考下...

    Perl教程网2412020-06-18
  • perlPerl的经典用法分享

    Perl的经典用法分享

    Perl的经典用法分享,学习perl的朋友可以参考下 ...

    脚本之家6562020-06-06
  • perlperl use vars pragma使用技巧

    perl use vars pragma使用技巧

    perl 中的vars是perl中的一个pragma(预编译指示符),专门用来预定义全局变量,这些预定义后的全局变量在qw()列表中,在整个引用perl文件中皆可使用,即便使...

    perl教程网6812020-06-16