====== Perl server sockets example ======

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.





===== Code =====
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.

<code perl>
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;


</code>

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

<code>
perl ./server.pl
</code>

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

<code>
 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
...
</code>

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 [[http://feeds.feedburner.com/codealias|my RSS feed]] to stay tuned.


{{tag>unix coding howto}}