使用perl编写socket程序范例

 服务器端：

#!/usr/bin/perl
use IO::SOCKET;
$sock = IO::SOCKET::INET->new(LocalAddr=>'127.0.0.1',
                        LocalPort=>8080,
                        Proto=>'tcp',
                         Listen=>3,
                          Reuse=>1);
$sock_2 = $sock->accept();
while($data=){

  print $data;
}
close $sock;

客户端：

#!/usr/bin/perl
use IO::SOCKET;
$sock = IO::SOCKET::INET->new('127.0.0.1::8080');
$msg = "Hello";
$sock->print($msg);
close $sock;

 

 

从服务器获取信息范例：

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

 

 

 

 

 

 

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