perl tcp服务器端编程，接收客户端信息并处理后发送响应给客户端

点击(此处)折叠或打开

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{CHLD} = sub {
   
8.      while((my $pid = waitpid(-1, WNOHANG)) >0) {
   
9.           print "Reaped child $pid\n";
   
10.       }
    
11. };
    
12. 
    
13. 
    
14. #my $zombies = 0;
    
15. #$SIG{CHLD} = sub {$zombies++;};
    
16. 
    
17. my $port = $ARGV[0] || '3000';
    
18. my $sock = IO::Socket::INET->new( Listen => 20,
    
19.                                   LocalPort => $port,
    
20.                                   Timeout => 60*1,
    
21.                                   Reuse => 1)
    
22.   or die "Can't create listening socket: $!\n";
    
23. 
    
24. warn "Starting server on port $port...\n";
    
25. while (1) {
    
26.      next unless my $session = $sock->accept;
    
27.      defined (my $pid = fork) or die "Can't fork: $!\n";
    
28. 
    
29. 
    
30. 
    
31.      if($pid == 0) {
    
32.           my $peer = gethostbyaddr($session->peeraddr,AF_INET) || $session->peerhost;
    
33.           my $port = $session->peerport;
    
34.           warn "Connection from [$peer,$port]\n";
    
35.           $session->autoflush(1);
    
36.           #print $session (my $s = localtime), "\n";
    
37.           #print $session "OK shumeiShumei2018\n";
    
38.           sysread $session, my $handshake_req,1024;
    
39.           print "First req: $handshake_req\n";
    
40.           my($handshake_resp) = handshake($handshake_req);
    
41.           print "resp: $handshake_resp\n";
    
42.           print $session $handshake_resp;
    
43.           warn "Connection from [$peer,$port] finished\n";
    
44.           close $session;
    
45.           exit 0;
    
46.       }else {
    
47.           print "Forking child $pid\n";
    
48.       }
    
49. close $sock;
    
50. 
    
51. ### sub routines
    
52. #
    
53. sub handshake {
    
54.     my $req = shift;
    
55.     if ( $req =~ /sentry/) {
    
56.         return ("OK sentry");
    
57.     } elsif ( $req =~ /saas/ ) {
    
58.         return ("OK saas");
    
59.     } elsif ( $req =~ /data/ ) {
    
60.         return ("OK data");
    
61.     } elsif ( $req =~ /his/ ) {
    
62.         return ("OK his");
    
63.     } elsif ( $req =~ /bill/ ) {
    
64.         return ("OK bill");
    
65.     } else {
    
66.         return ("OK shumeiShumei2016");
    
67.     }
    
68.     return ("req:$req");
    
69. }