< linux网络编程工具>>配套源码

				程序清单17-3：server.pl
				#!/usr/bin/perl
				 #
				 # Sample connection oriented server using Perl
				 #
				 $AF_UNIX = 1;
				 $AF_INET=2;     # Use AF_INET instead of AF_UNIX.
				 $SOCK_STR = 1;  # Use STREAMS.
				 $PROTOCOL = 0;  # stick to the default protocols (IP).
				
				 $port = 6668 unless $port;
				
				 #
				 # The pattern for packing into a sockaddr structure
				 #
				 $PACKIT='S n C4 x8';
				
				 #
				 # Disable any buffering on any newly created sockets.
				 #
				 select(NEWSOCKET);
				 $| = 1;
				 select(stdout);
				
				 #
				 # Create the socket.
				 #
				 socket(MY_SOCKET, $AF_INET, $SOCK_STR, $PROTOCOL) ||
				                        die "\n $0: Cannot open socket: $!";
				 print "Socket successfully opened\n";
				
				 #
				 # Get the host address for this node
				 #
				
				 ($name, $aliases, $addrtype, $len, @addrs) = gethostbyname("www.ikra.com"); 
				 ($a,$b,$c,$d) = unpack('C4',$addrs[0]);
				 print "Server Name=$name, Server Address= $a.$b.$c.$d\n"; 
				 $my_ip_addr = pack($PACKIT,$AF_INET,$port,$addrs[0]);
				
				 #
				 # If you just want to test with the localhost, try this line 
				 # instead of the above.
				 # $my_ip_addr = pack($PACKIT,$AF_INET,$port,127,0,0,1);
				
				 #
				 # Bind to the socket and listen on this port
				 #
				 bind(MY_SOCKET, $my_ip_addr) || die "$0: Cannot bind .. $!\n";
				 print  "\n Bound to socket";
				 listen(MY_SOCKET,5)  || die "$0: Cannot listen: $!\n";
				 print  "\n Listening \n";
				
				 while(1) {
				      $remote = accept(NEWSOCKET, MY_SOCKET) || die "$0: Unacceptable: $!\n";
				
				 #
				 # In case you have to display incoming connection
				 # information, you can uncomment the next three lines of code: 
				
				 #         @remoteInfo = unpack($PACKIT,$remote);
				 #         $, = ' ';
				 #         print @remoteInfo; print "\n";
				
				      # $pid = fork || &cleanup; 
				
				           if ($pid == fork)  {  # child
				           sleep 3;
				           print NEWSOCKET "Welcome to this server\n";
				           # in child,.. you can do other stuff here.
				           close NEWSOCKET;
				           # I chose to just print this message and terminate
				           close MY_SOCKET;
				           exit;
				      }
				      else {  # parent s
				           sleep 10;
				           close MY_SOCKET;
				           close NEWSOCKET;  # in parent
				           exit;
				      }
				
				 }
				 sub cleanup { close NEWSOCKET; close(MY_SOCKET); die "$0: Cannot fork : $!\n"; }