Newsgroup: it.comp.lang.perl
Titolo: Perl server con più porte, win32 (LUNGO)

**** Post for FREE via your newsreader at 
post.usenet.com
 ****
Salve a tutti,
e' la prima volta che utilizzo i sockets in Perl e vorrei il vostro
aiuto per ottimizzare il codice dello script che segue.
(Nota: sto usando Perl per win32)
Questo script crea 3 socket e ascolta su 3 porte; quando arriva
una connessione su una di esse, il relativo socket viene selezionato
e accettato (select e accept) e viene loggato ogni dato che arriva
dall'esterno.
E' piuttosto semplice, ma ora vorrei fare quanto segue:
1. ottimizzare il codice in modo da poter aggiungere altre porte senza
dover aggiungere ogni volta il relativo codice server (guardate il codice
e capirete...) in modo da avere uno script piu' compatto;
2. modificare lo script in modo che accetti piu' di una connessione
simultaneamente (al momento, lo script ascolta sul socket selezionato
fino alla fine della connessione, quindi ritorna in loop e attende la
prossima connessione; ascolta in pratica 1 sola connessione per volta).
Vi ringrazio anticipatamente per ogni vostro aiuto o consiglio.
Chris
----SEGUE SCRIPT PERL / WIN32 ----
#!/usr/bin/perl
use Socket;
$port1=4001;
$port2=4002;
$port3=4003;
$banner="Connected to 
cjrxghlf.com
 ...\n\r";
$out="/LOGFILE";
$sockaddr='S n a4 x8';
socket(S1,AF_INET,SOCK_STREAM,getprotobyname('tcp')) || die "socket: $!";
$this1=pack($sockaddr,AF_INET,$port1,"\0\0\0\0");
bind(S1,$this1) || die "bind: $!";
listen(S1,10) || die "listen: $!";
socket(S2,AF_INET,SOCK_STREAM,getprotobyname('tcp')) || die "socket: $!";
$this2=pack($sockaddr,AF_INET,$port2,"\0\0\0\0");
bind(S2,$this2) || die "bind: $!";
listen(S2,10) || die "listen: $!";
socket(S3,AF_INET,SOCK_STREAM,getprotobyname('tcp')) || die "socket: $!";
$this3=pack($sockaddr,AF_INET,$port3,"\0\0\0\0");
bind(S3,$this3) || die "bind: $!";
listen(S3,10) || die "listen: $!";
open OUT, ">>$out" or die "Cannot open $out for append :$!";
close OUT;
$rin = '';
vec( $rin, fileno(S1), 1) = 1;
vec( $rin, fileno(S2), 1) = 1;
vec( $rin, fileno(S3), 1) = 1;
while( 1 ) {
  $nfound = select( $rout = $rin, undef, undef, undef);
  if( vec( $rout, fileno(S1), 1) ) {
        $|=1;
        select(STDOUT);
        ($addr=accept(NS,S1)) || die "accept: $!";
        select(NS);
        $|=1;
        select(STDOUT);
        ($af,$port_in,$inetaddr)=unpack($sockaddr,$addr);
        @inetaddr=unpack('C4',$inetaddr);
        ($i1,$i2,$i3,$i4)=@inetaddr;
        $ipaddr="$i1.$i2.$i3.$i4";
        print "port $port1 IP $ipaddr CONNECTED\n";
        print NS $banner;
        open OUT, ">>$out" or die "Cannot open $out for append :$!";
        print OUT scalar(localtime)," port $port1 IP $ipaddr CONNECTED\n\n";
        while(<NS>) {
                print NS "Command received successfully\n\r";
                print OUT scalar(localtime)," port $port1 IP $ipaddr typed:
$_\n";
        }
        print OUT scalar(localtime)," port $port1 IP $ipaddr
DISCONNECTED\n\n";
        print OUT "----------------------------------------\n\n";
        close OUT;
        print "port $port1 IP $ipaddr DISCONNECTED\n";
        close(NS);
  }
  if( vec( $rout, fileno(S2), 1) ) {
        $|=1;
        select(STDOUT);
        ($addr=accept(NS,S2)) || die "accept: $!";
        select(NS);
        $|=1;
        select(STDOUT);
        ($af,$port_in,$inetaddr)=unpack($sockaddr,$addr);
        @inetaddr=unpack('C4',$inetaddr);
        ($i1,$i2,$i3,$i4)=@inetaddr;
        $ipaddr="$i1.$i2.$i3.$i4";
        print "port $port2 IP $ipaddr CONNECTED\n";
        print NS $banner;
        open OUT, ">>$out" or die "Cannot open $out for append :$!";
        print OUT scalar(localtime)," port $port2 IP $ipaddr CONNECTED\n\n";
        while(<NS>) {
                print NS "Command received successfully\n\r";
                print OUT scalar(localtime)," port $port2 IP $ipaddr typed:
$_\n";
        }
        print OUT scalar(localtime)," port $port2 IP $ipaddr
DISCONNECTED\n\n";
        print OUT "----------------------------------------\n\n";
        close OUT;
        print "port $port2 IP $ipaddr DISCONNECTED\n";
        close(NS);
  }
  if( vec( $rout, fileno(S3), 1) ) {
        $|=1;
        select(STDOUT);
        ($addr=accept(NS,S3)) || die "accept: $!";
        select(NS);
        $|=1;
        select(STDOUT);
        ($af,$port_in,$inetaddr)=unpack($sockaddr,$addr);
        @inetaddr=unpack('C4',$inetaddr);
        ($i1,$i2,$i3,$i4)=@inetaddr;
        $ipaddr="$i1.$i2.$i3.$i4";
        print "port $port3 IP $ipaddr CONNECTED\n";
        print NS $banner;
        open OUT, ">>$out" or die "Cannot open $out for append :$!";
        print OUT scalar(localtime)," port $port3 IP $ipaddr CONNECTED\n\n";
        while(<NS>) {
                print NS "Command received successfully\n\r";
                print OUT scalar(localtime)," port $port3 IP $ipaddr typed:
$_\n";
        }
        print OUT scalar(localtime)," port $port3 IP $ipaddr
DISCONNECTED\n\n";
        print OUT "----------------------------------------\n\n";
        close OUT;
        print "port $port3 IP $ipaddr DISCONNECTED\n";
        close(NS);
  }
}
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 *** Usenet.com - The #1 Usenet Newsgroup Service on The Planet! ***
 
http://www.usenet.com
-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

 e capirete...) in modo da avere uno script piu' compatto;
La prima cosa da eliminare è l'uso di filehandle con nome (S1, S2,
etc...). Questo si ottiene facilmente, usando IO::Socket::INET. Es:
 sub bind_and_listen
 {
   my $port  = shift;
   return IO::Socket::INET->new(
          Listen    => 1,
          LocalPort => $port,
          Reuse => 1,
          Proto     => 'tcp' );
 }
A questo punto possiamo usare gli oggetti restituiti inserendoli nel
vettore della select, usando il metodo fileno.
Qui però suggerirei di non usare select() direttamente ma di passare
da IO::Select, che semplifica molto le cose.
 my $s = IO::Select->new();
 my $sock1 = bind_and_listen( 4001 );
 $s->add( $sock1 );
 # etc...
 while( 1 )
 {
   my @handles = $s->can_read;
   # etc....
 }
La cosa migliore comunque è costruirsi un sistema di demultiplexing degli
eventi (connessione in attesa, dati in ingesso disponibili), che faccia il
dispatching ad oggetti indipendenti, associati alle varie sessioni attive.
Questo ti consente di gestire connessioni concorrenti *senza* forkare o
spawnare thread. Ecco un esempio scritto al volo, ispirato a una tecnica
che normalmente uso in altri contesti. Implementazione ultra-semplice
senza controllo di errori o altro, giusto per dare un'idea di ciò che
intendo:
 use strict;
 package handler; #classe handler 
 sub new { return bless { }; }
 sub handle_input
 {
   my( $self, $sock ) = @_;
   print "handle_input $sock\n";
    my $data = <$sock>;
    $data =~ s/\r|\n//g;
    print $sock "ricevuto: $data \n";
 #   ....
    return undef if( $data =~ /close|quit/ );
    return 1; 
 # se restituisco undef $sock viene chiuso 
 # altrimenti verrò chiamato ancora se ci sono dati disponibili
 # (vedi sotto)
 }
 package main;
 use IO::Socket::INET;
 use IO::Select;
 sub bind_and_listen
 {
   my $port  = shift;
   return IO::Socket::INET->new(
          Listen    => 1,
          LocalPort => $port,
          Reuse => 1,
          Proto     => 'tcp' );
 }   
 my $selector = IO::Select->new();
 my $sock = bind_and_listen( 4001 );
 $selector->add( $sock );
 my $sock2 = bind_and_listen( 4002 );
 $selector->add( $sock2 );
 my %readers = ();
 while(1)
  {
   print "selecting " . $selector->count . " handles...\n";     
    my @handles = $selector->can_read( 30 ) ; #timeout di 30 secs
    for my $s( @handles )
    {
       my $reader = $readers{$s};
       if( $reader )
       {
          my $rc =  $s->connected() ; 
          if( $rc )
          {
            print "data available $s\n";
            $rc = $reader->handle_input( $s );    
          }
          unless( $rc ) # $s non è 'connected' oppure
                        # handle_input ha restituito undef
         {
            print "removing $s\n";
            delete $readers{$s};
            $selector->remove($s);
            $s->close();
         }
       }
       else 
       {
          print "incoming connection $s\n";
          my $sock = $s->accept();
          $selector->add( $sock );
          #creo handler e lo associo a $sock
          $readers{$sock} = new handler; 
       }
    }
    if( @handles == 0 ) { exit(0); } #errore... 
  }
Max