The flexibility provided by Perl sockets allows the implementation of advanced network services. The following article explains how to implement an full blown multi-threaded server in Perl.

The code below is an implementation of a multi-threaded TCP/IP server that listens to connections from the port 8888 and executes any received commands in the shell and returns the resulting output. It is a kind of remote shell.

use IO::Socket;
 
$port = 8888;
$SIG{'INT'} = 'cleanup';
 
create_listener();
 
sub create_listener {
 
    my $proto          = getprotobyname('tcp');
    my ( $adr_internet, $adr_sock );
    chop( my $hostname = `hostname ` );
    my $request;
 
    # Creat a server socket
    socket( SOCK_SERVER, PF_INET, SOCK_STREAM, $proto )
      or die "socket error: $!";
 
    # Build server address
    $adr_internet = gethostbyname($hostname)
      or die "gethostbyname error: $!";
 
    $adr_sock = sockaddr_in( $port, $adr_internet )
      or die "sockaddr_in error: $!";
 
    # Bind the socket
    bind( SOCK_SERVER, $adr_sock ) or die "bind error: $!";
 
    # Start listening
    listen( SOCK_SERVER, $max_connexions ) or die "listen: $!";
    print "Server $hostname listening on port $port \n";
 
    my ( $adr_sock_client, $port_client, $adr_client );
 
    $nb_sock = 0;
    while (1)
    {
 
        $adr_sock_client = accept( SOCK, SOCK_SERVER );
        my ( $port_client, $adr_client ) =
          sockaddr_in($adr_sock_client);
        my $name = gethostbyaddr( $adr_client, AF_INET );
        print "Received connection from $name\n";
        $nb_sock++;
 
        print "Creating child process to serve client\n";
        my $child;
 
        if ( ( $child = fork() ) == 0 ) {
 
            chomp( $request = <SOCK> );
 
            while ( not( $request =~ /quit/i ) ) {
 
                if (length($request) > 1){
                print "Command received from [$name] :$request\n";
                my $res = treat_request($request);
                }
 
                chomp( $request = <SOCK> );
 
            }
            print "Terminating session with [$name]\n";
            close(SOCK)        or die "close error: $!";
            close(SOCK_SERVER) or die "Erreur close : $!";
 
            exit(0);
        }
 
 
    }
 
}
 
sub treat_request {
 
    $res = `@_ `;
    print SOCK $res . "\n";
 
    # flush socket buffer
    select(SOCK);
    $| = 1;
    select(STDOUT);
}
 
 
sub cleanup {
    print "\n\nCaught Interrupt (^C), Aborting\n";
    close(SOCK);
    close(SOCK_SERVER);
    exit(1);
}
 
1;

To test the server, place the code above into a file (e.g. server.pl) and run the server as follows :

perl ./server.pl

Then, connect to the server using telnet and run some commands. Here is a sample session (my machine's name is HANNIBAL).

 26$telnet  HANNIBAL 8888
Trying 127.0.1.1...
Connected to HANNIBAL.
Escape character is '^]'.

ps
  PID TTY          TIME CMD
 6294 pts/1    00:00:00 bash
 6543 pts/1    00:00:02 vim
 6795 pts/1    00:00:00 perl
 ...

ls -l
total 96
drwxr-xr-x   2 root root  4096 Nov 14 14:50 bin
drwxr-xr-x   3 root root  4096 Nov 28 15:51 boot
lrwxrwxrwx   1 root root    11 Sep 14 21:10 cdrom -> media/cdrom
drwxr-xr-x  13 root root 14080 Dec  5 15:10 dev
drwxr-xr-x 142 root root 12288 Dec  5 15:12 etc
drwxr-xr-x   3 root root  4096 Sep 14 21:15 home
...

In the coming articles, I will explain how to create a network client using Perl sockets and how to protect the client/server communication with Kerberos. Subscribe to my RSS feed to stay tuned.

Labels: unix, coding, howto