Perl Socket 通信recv超时退出子进程

#!/usr/bin/perl
#server
use strict;
use Socket;
use IO::Handle;
use POSIX ":sys_wait_h";

my($this, $now);
my $port = shift || 29688;
my $address=inet_aton("0.0.0.0");
$this =sockaddr_in($port,$address); #pack('Sna4x8', AF_INET, $port, "\0\0\0\0");
print "Port = $port\n";
my $prototype = getprotobyname('tcp');
socket(SOCKET, PF_INET, SOCK_STREAM, $prototype) || die "socket: $!\n";
print "Socket ok.\n";
bind(SOCKET, $this) || die "bind: $!\n";
print "Bind ok.\n";
listen(SOCKET, SOMAXCONN) || die "connect: $!\n";
print "Listen ok.\n";
SOCKET->autoflush;

while(1){
print "In loop.\n";
accept(CLIENT, SOCKET) || die "$!\n";
CLIENT->autoflush;
print "Accept ok.\n";
while(waitpid(-1,WNOHANG)>0){}

my $pid = fork(); #有远程访问就fork子进程处理
CLIENT->autoflush;
if (not defined $pid) {
print CLIENT "resources not avilable.\n";
close(CLIENT);
}elsif ($pid == 0) {
print "\nfork pid:$pid\n";
CLIENT->autoflush;
while(1)
{
my $c = '';
print "what happened";
sysread(CLIENT, $c, 100) or die "recv: $!";
print "\nclient say:$c\n";
if ($c =~ /quit/gi)
{
close(CLIENT);
exit;
}
syswrite(CLIENT, $c."back\n",100);
}
print "\npid:$pid\n";
}
close(SOCKET);
-----------------------------------------------------------------
#!/usr/bin/perl
#client.pl
require 5.6.0.0;
#use strict;
use Socket;
#use FileHandle;
use IO::Handle;

my($remote, $port, @thataddr, $that,$them, $proto,@now);
$remote = "vps.9588.org"; #shift || 'localhost' ;
$port = 29688 ;
@thataddr=gethostbyname($remote);
my $address=inet_aton("$remote");
$that =sockaddr_in($port,$address);
$proto = getprotobyname('tcp');
# Make the socket filehandle
if ( socket(SOCK, PF_INET, SOCK_STREAM, $proto ) ){
print "Socket ok.\n";
}
else { die $!; }
if (! connect(SOCK, $that)) {
print "Connect error.\n";
}
else{
print "Connect ok.\n";
while (1){
print "\nPlease input:";
$msg_out=<STDIN>;
if ($msg_out eq "\n"){next;}
#if ($msg_out!~ /cd|touch/gi ){recv (SOCK,$msg_in,2048,0);}
if ($msg_out=~/quit/i)
{
syswrite(SOCK,"I will quit,bye!",100);
close(SOCK);
exit 0;
}
syswrite(SOCK,$msg_out,100);
sysread(SOCK,$msg_in,100);
print "Server result:$msg_in\n";
}
}
close(SOCK);

-----------------------------------------------------------------
-----------------------------------------------------------------

这个带了认证和超时自动断开链接
#!/usr/bin/perl
#server
use strict;
use Socket;
use IO::Handle;
use POSIX ":sys_wait_h";

sub auth
{
my %userslist =(
   "edwinzhou" => "123456",
   "test" => "test"
);
my $getstr = "";
my $authfail = 0;
sysread(CLIENT, $getstr,30);
chomp($getstr);
if ($getstr =~ /auth/gi && $getstr =~ /:/gi)
{
   my @un_pass = split(":",$getstr);
   if (defined $userslist{$un_pass[1]})
   {
      if ($userslist{$un_pass[1]} eq $un_pass[2])
      {
         syswrite(CLIENT,"auth:ok");
         return "ok";
      }else{$authfail = 1;}
   }else{$authfail = 1;}
}else{$authfail = 1;}

if ($authfail == 1)
{
    print "auth:fail\n";
    syswrite(CLIENT,"auth:fail");
    close(CLIENT);
}
}

sub cleardp
{
while(waitpid(-1,WNOHANG)>0){}
}

sub settimeout #定义ALRM发生信号时的操作，这里发信给客户端并断开链接，子进程退出
{
$SIG{ALRM} = sub {
print "recv timeout\n";
syswrite(CLIENT,"timeout");
close(CLIENT);
exit;
};
}

my($this, $now);
my $port = shift || 29688;
my $address=inet_aton("0.0.0.0");
$this =sockaddr_in($port,$address); #pack('Sna4x8', AF_INET, $port, "\0\0\0\0");
print "Port = $port\n";
my $prototype = getprotobyname('tcp');
socket(SOCKET, PF_INET, SOCK_STREAM, $prototype) || die "socket: $!\n";
print "Socket ok.\n";
bind(SOCKET, $this) || die "bind: $!\n";
print "Bind ok.\n";
listen(SOCKET, SOMAXCONN) || die "connect: $!\n";
print "Listen ok.\n";
SOCKET->autoflush;
while(1){
print "In loop.\n";
accept(CLIENT, SOCKET) || die "$!\n";
CLIENT->autoflush;
print "Accept ok.\n";
cleardp();
#$SIG{ALRM} = {}; #网上有的地方说是必须的，不过好像不加也可以

my $pid = fork();
CLIENT->autoflush;
if (not defined $pid) {
print CLIENT "resources not avilable.\n";
close(CLIENT);
}elsif ($pid == 0) {
print "\nfork pid:$pid\n";
CLIENT->autoflush;
my $c = "";
settimeout(); #调用定义ALARM子例程
alarm( 10 );
my $authresult = auth(); #在中间的这段，如果大于10秒还没有完成，就调用ALARM中定义的操作
alarm( 0 );
print "\nauthresult:$authresult\n";
exit if $authresult ne "ok";
while(1)
{
alarm( 10 ); #同上，一般放在会超时的操作代码
sysread(CLIENT, $c, 100); #or die "recv: $!";
alarm( 0 );
chomp($c);
print "\nclient say:$c\n";
if ($c =~ /quit/gi)
{
close(CLIENT);
exit;
}
syswrite(CLIENT, $c."back\n",100);
}
print "\npid:$pid\n";
}
}
---------------------------------------------------------------
#!/usr/bin/perl
#client.pl
require 5.6.0.0;
#use strict;
use Socket;
#use FileHandle;
use IO::Handle;

my($remote, $port, @thataddr, $that,$them, $proto,@now);
$remote = shift || 'localhost' ;
$port = 29688 ;
@thataddr=gethostbyname($remote);
my $address=inet_aton("$remote");
$that =sockaddr_in($port,$address);
$proto = getprotobyname('tcp');
# Make the socket filehandle
if ( socket(SOCK, PF_INET, SOCK_STREAM, $proto ) ){
print "Socket ok.\n";
}
else { die $!; }
if (! connect(SOCK, $that)) {
print "Connect error.\n";
}
else{
print "Connect ok.\n";

while (1){
print "\nPlease input:";
$msg_out=<STDIN>;
if ($msg_out eq "\n"){next;}
#if ($msg_out!~ /cd|touch/gi ){recv (SOCK,$msg_in,2048,0);}
if ($msg_out=~/quit/i)
{
syswrite(SOCK,"I will quit,bye!",100);
close(SOCK);
exit 0;
}
syswrite(SOCK,$msg_out,100);
sysread(SOCK,$msg_in,100);
if ($msg_in =~ /auth:fail/gi)
{
   print "login fail...";
   close(SOCK);
   exit 0;
}

print "Server result:$msg_in\n";
}
}
close(SOCK);

--------------------------------------------------------------
--------------------------------------------------------------

利用IO::Socket模块的方法，功能同上，可以在超时时间到达后回收子进程
#server
#!/usr/bin/perl
use strict;
use IO::Socket;
use IO::Socket 'sockatmark';
use POSIX ":sys_wait_h","WNOHANG";

my $session;

sub cleardp
{
while(waitpid(-1,WNOHANG)>0){}
}

sub auth
{
my %userslist =(
   "edwinzhou" => "123456",
   "test" => "test"
);
my $getstr = "";
my $authfail = 0;
sysread($session, $getstr,30);
chomp($getstr);
if ($getstr =~ /auth/gi && $getstr =~ /:/gi)
{
   my @un_pass = split(":",$getstr);
   if (defined $userslist{$un_pass[1]})
   {
      if ($userslist{$un_pass[1]} eq $un_pass[2])
      {
         syswrite($session,"auth:ok\n");
         return "ok";
      }else{$authfail = 1;}
   }else{$authfail = 1;}
}else{$authfail = 1;}

if ($authfail == 1)
{
    print "auth:fail\n";
    syswrite($session,"auth:fail\n");
    close($session);
}
}

sub settimeout
{
$SIG{ALRM} = sub {
print "recv timeout\n";
syswrite($session,"timeout\n");
close($session);
exit;
};
}

my $port      = $ARGV[0] || '29688';
my $sock = IO::Socket::INET->new( Listen     => 20,
                                   LocalPort => $port,
                                   Timeout    => 20*1,
                                   Reuse      => 1)
  or die "Can't create listening socket: $!\n";

while (1) {
     cleardp();
     print "Listening...\n";
     next unless $session = $sock->accept;
     defined (my $pid = fork) or die "Can't fork: $!\n";
     if($pid == 0) {

$session->autoflush(1);
my $c;
settimeout();
alarm( 120 );
my $authresult = auth();
alarm( 0 );
print "\nauthresult:$authresult\n";
exit if $authresult ne "ok";
while (1)
{
alarm( 20 );
sysread($session,$c,100); #|| die "error:$!\n";
alarm( 0 );
chomp($c);
print "client say:$c\n";
if ($c =~ /quit/gi)
{
close($session);
exit;
}
syswrite($session,$c,100);
}
}else
{
print "Forking child $pid\n";
}
}
--------------------------------------------------------------
--------------------------------------------------------------
perl socket，远程shell例子，还有点Bug
#!/usr/bin/perl
#server.pl
#my $prototype = getprotobyname('tcp');
#print $prototype,"\n";
#print SOMAXCONN;
require 5.6.0.0;
#use strict;
use Socket;
#use FileHandle;
use IO::Handle;
use POSIX ":sys_wait_h";

my($this, $now);
my $port = shift || 29688;
my $address=inet_aton("0.0.0.0");
$this =sockaddr_in($port,$address); #pack('Sna4x8', AF_INET, $port, "\0\0\0\0");
print "Port = $port\n";
my $prototype = getprotobyname('tcp');
socket(SOCKET, PF_INET, SOCK_STREAM, $prototype) || die "socket: $!\n";
print "Socket ok.\n";
bind(SOCKET, $this) || die "bind: $!\n";
print "Bind ok.\n";
listen(SOCKET, SOMAXCONN) || die "connect: $!\n";
print "Listen ok.\n";
SOCKET->autoflush;

while(1){
print "In loop.\n";
accept(CLIENT, SOCKET) || die "$!\n";
CLIENT->autoflush;
print "Accept ok.\n";
while(waitpid(-1,WNOHANG)>0){}

my $pid = fork();
if (not defined $pid) {
print CLIENT "resources not avilable.\n";
close(CLIENT);
}elsif ($pid == 0) {
print "\nfork pid:$pid";
open(STDIN, ">&CLIENT");
open(STDOUT, ">&CLIENT");
open(STDERR, ">&CLIENT");
system("/bin/sh");
close(STDIN);
close(STDOUT);
close(STDERR);
close(CLIENT);
exit 0
}
print "\npid:$pid";
}
close(SOCKET);
----------------------------------------------------------------------
#!/usr/bin/perl
#client.pl
require 5.6.0.0;
#use strict;
use Socket;
#use FileHandle;
use IO::Handle;

my($remote, $port, @thataddr, $that,$them, $proto,@now);
$remote = shift || 'localhost' ;
$port = 29688 ;
@thataddr=gethostbyname($remote);
my $address=inet_aton("$remote");
$that =sockaddr_in($port,$address);
$proto = getprotobyname('tcp');
# Make the socket filehandle
if ( socket(SOCK, PF_INET, SOCK_STREAM, $proto ) ){
print "Socket ok.\n";
}
else { die $!; }
if (! connect(SOCK, $that)) {
print "Connect error.\n";
}
else{
print "Connect ok.\n";
while (1){
print "\nPlease input:";
$msg_out=<STDIN>;
if ($msg_out eq "\n"){next;}
send(SOCK,$msg_out,0);
if ($msg_out!~ /cd|touch/gi ){recv (SOCK,$msg_in,2048,0);}
exit if $msg_out=~/quit/i;
print "Server result:$msg_in\n";
}
}
close(SOCK);


--------------------------------------------------------------
--------------------------------------------------------------
Crypt::RSA 对通讯进行加密传输
#!/usr/bin/perl
use strict;
use IO::Socket;
use IO::Socket 'sockatmark';
use POSIX ":sys_wait_h","WNOHANG";
use Crypt::RSA;

my $session;
my $ifen = 1; #定义服务端是否需要强制加密 1-是 0否
my %ck; #定义散列，用来存放客户端传来的公钥 ：应该定义在子进程中，以后改
my $rsa = new Crypt::RSA;
my $p_pubkey;

sub cleardp
{
    while(waitpid(-1,WNOHANG)>0){}
}

sub auth
{
    my %userslist =(
       "edwinzhou" => "123456",
       "test" => "test");
    my $getstr = "";
    my $authfail = 0;
    sysread($session, $getstr,30);
    chomp($getstr);
    if ($getstr =~ /auth/gi && $getstr =~ /:/gi)
    {
       my @un_pass = split(":",$getstr);
       if (defined $userslist{$un_pass[1]})
       {
          if ($userslist{$un_pass[1]} eq $un_pass[2])
          {
             syswrite($session,"auth:ok\n");
             return "ok";
          }else{$authfail = 1;}
       }else{$authfail = 1;}
    }else{$authfail = 1;}

    if ($authfail == 1)
    {
        print "auth:fail\n";
        syswrite($session,"auth:fail\n");
        close($session);
    }
}

sub settimeout
{
    $SIG{ALRM} = sub {
        print "recv timeout\n";
        syswrite($session,"timeout\n");
        close($session);
        exit;
    };
}

sub consult  #和客户端协商是否使用加密
{
    my $enback;
    sysread($session,my $msgread,15);
    my @tmp = split(":",$msgread);
    if ($tmp[0] ne "encrypt")
    {
       syswrite($session,"unknow\n");
       close($session);
       exit;
    }
    if ($ifen == 0)
    {
       $enback = "encrypt:ok";
    }else{
       if ($tmp[1] == 0)
       {
          $enback = "encrypt:fail";
          syswrite($session,$enback,length($enback));
          close($session);
          exit;
       }else{
          $enback = "encrypt:ok";
       }
    }
    print "result:$enback\n";
    syswrite($session,$enback,length($enback));
    return $tmp[1];
}

sub receive_client_pubkey #接收并保存客户端的公钥
{
    my $clientpubkey;
    while (1)
    {
        sysread($session,$clientpubkey,1096);
        if ($clientpubkey =~ /pub:.*/gi)
        {
           my @tmp =split(":",$clientpubkey);
           $ck{$tmp[1]} = $tmp[2];
           syswrite($session,"pubrevok",length("pubrevok"));
        }
        elsif ($clientpubkey eq "pubsendover")
        {
           last;
        }
        else
        {
           syswrite($session,"pub:unknow",length("pub:unknow"));
           close($session);
           exit;
        }
    }
    foreach my $eachkey (keys(%ck))
    {
       print "$eachkey:",$ck{$eachkey},"\n";
    }
}

sub encrypt($)
{
    my $message = shift;
    $p_pubkey = bless(\%ck,'Crypt::RSA::Key::Public'); #组合
    #print "zhizhen:",$p_pubkey,"\n";
    my $cyphertext =
            $rsa->encrypt (
                Message    => $message,
                Key        => $p_pubkey,
                Armour     => 1
            ) || die "encrypt error:",$rsa->errstr();
    print "encrypted:$cyphertext\n";
    return $cyphertext;
}

my $port      = $ARGV[0] || '29688';
my $sock = IO::Socket::INET->new( Listen     => 20,
                                   LocalPort => $port,
                                   Timeout    => 20*1,
                                   Reuse      => 1)
  or die "Can't create listening socket: $!\n";

while (1) {
     cleardp();
     print "Listening...\n";
     next unless $session = $sock->accept;
     defined (my $pid = fork) or die "Can't fork: $!\n";
     if ($pid == 0)
     {
        $session->autoflush(1);
        my $c;
        settimeout();
        my $clientifen = consult();
        if ($clientifen == 0)
        {
           print "client didn't need encrypt\n";
        }else{
           print "client need encrypt\n";
           receive_client_pubkey();
           my $hello = "hello";
           my $encryptstr = encrypt($hello);
           syswrite($session,$encryptstr,length($encryptstr));
        }
       alarm( 120 );
       my $authresult = auth();
       alarm( 0 );
       print "\nauthresult:$authresult\n";
       exit if $authresult ne "ok";
       while (1)
       {
             alarm( 20 );
             sysread($session,$c,100) || die "error:$!\n";
             alarm( 0 );
             chomp($c);
             print "client say:$c\n";
             if ($c =~ /quit/gi)
             {
                close($session);
                exit;
             }
             syswrite($session,$c,100);
       }
     }else
      {
             print "Forking child $pid\n";
      }
}
--------------------------------------------------------------

#!/usr/bin/perl
#client.pl
require 5.6.0.0;
#use strict;
use Socket;
#use FileHandle;
use IO::Handle;
use Crypt::RSA;

my $rsa;
my ($public, $private);

sub consult($)
{
    my $ifen = shift;
    my $msg = "encrypt:$ifen";
    my $msgread;
    syswrite(SOCK,$msg,length($msg));
    sysread(SOCK,$msgread,15);
    my @tmp = split(":",$msgread);
    if ($tmp[1] ne "ok")
    {
        print "Server Force Encryption!\n";
        exit 0;
    }
}

sub send_pub_key
{
    $rsa = new Crypt::RSA;
    ($public, $private) =
           $rsa->keygen (
              Identity  => 'Lord Macbeth <[e-mail]>',
              Size      => 1024, 
              Password  => 'A day so foul & fair',
              Verbosity => 1,
          ) or die $rsa->errstr();
    my @tmp = split("=",$public);
    foreach my $eachkey (keys(%$public))
    {
         my $sendpub = "";
         my $msgin;
         $sendpub = "pub:$eachkey:".%$public->{$eachkey};
         print "$eachkey:".%$public->{$eachkey}."\n";
         syswrite(SOCK,$sendpub,length($sendpub));
         sysread(SOCK,$msgin,10);
         if ($msgin ne "pubrevok")
         {
            return 0;
         }
    }
    syswrite(SOCK,"pubsendover",length("pubsendover"));
    return 1;
}

sub encrypt
{
    my $message = "hello";
    print "public:$public\n";
    my $cyphertext =
           $rsa->encrypt (
               Message    => $message,
               Key        => $public,
               Armour     => 1,
           ) || die $rsa->errstr();
    return $cyphertext;
}

sub decrypt
{
    my $enstr = shift;
    my $plaintext =
          $rsa->decrypt (
               Cyphertext => $enstr,
               Key        => $private,
               Armour     => 1,
          ) || die $rsa->errstr();
    return $plaintext;
}

my($remote, $port, @thataddr, $that,$them, $proto,@now);
$remote = shift || 'localhost' ;
$port = 29688 ;
@thataddr=gethostbyname($remote);
my $address=inet_aton("$remote");
$that =sockaddr_in($port,$address);
$proto = getprotobyname('tcp');
if ( socket(SOCK, PF_INET, SOCK_STREAM, $proto ) ){
print "Socket ok.\n";
}
else { die $!; }
if (! connect(SOCK, $that)) {
print "Connect error.\n";
}
else{
print "Connect ok.\n";

my $ifencryption = 1;
consult($ifencryption);
if ($ifencryption == 1)
{
   my $sendkey_result = send_pub_key();
   if ($sendkey_result == 1)
   {
      sysread(SOCK,my $msg,500);
      print $msg,"\n";
      my $destr = decrypt($msg);
      print $destr,"\n";
   }
   else
   {
      print "send key error\n";
      close(SOCK);
      exit 0;
   }
}

while (1){
print "\nPlease input:";
$msg_out=<STDIN>;
if ($msg_out eq "\n"){next;}
if ($msg_out=~/quit/i)
{
syswrite(SOCK,"I will quit,bye!",100);
close(SOCK);
exit 0;
}
syswrite(SOCK,$msg_out,100);
sysread(SOCK,$msg_in,100);
print "error:$!\n";
if ($msg_in =~ /auth:fail/gi)
{
   print "login fail...";
   close(SOCK);
   exit 0;
}
chomp($msg_in);
print "Server result:$msg_in\n";
}
}
close(SOCK);