Perl Netwerk programmatie

  1. TCP verbindingen

    IP header:

    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    Version IHL TOS Total length
    Identification Flags Fragment offset
    TTL Protocol Header checksum
    Source IP address
    Destination IP address
    Options and padding

    TCP header:

    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    Source Port Destination Port
    Sequence Number
    Acknowledgment Number
    Data Offset reserved ECN Control Bits Window
    Checksum Urgent Pointer
    Options and padding
    Data

    TCP verbinding = quad(IP A, Poort A, IP B, Poort B)

  2. Sockets

    • Op iedere host is er wat informatie over de verbinding:

    • Als we alleen naar deze informatie op host A kijken zien we een verbonden socket (een half-verbinding):

    • Een socket is een "dinges" waarop we dit soort informatie kunnen gaan plaatsen:

  3. Een connectie maken

    1. Eerst is er nog niets:

    2. Een kant (de server, hier host B) besluit dat hij connecties will accepteren. De eerste stap daarvoor is een socket opzetten:

      In perl creëer je een socket met de "socket" operator:

      socket SOCKET,DOMAIN,TYPE,PROTOCOL
      Opens a socket of the specified kind and attaches it to filehandle SOCKET. DOMAIN, TYPE, and PROTOCOL are specified the same as for the system call of the same name. You should "use Socket" first to get the proper definitions imported. See the examples in "Sockets: Client/Server Communication" in perlipc.
      On systems that support a close-on-exec flag on files, the flag will be set for the newly opened file descriptor, as determined by the value of $^F. See "$^F" in perlvar.

      Ok, laten we dan even naar wat elementen in de socket manpage kijken:

      DOMAIN
      The domain parameter specifies a communication domain; this selects the protocol family which will be used for communication. These families are defined in <sys/socket.h>. The currently understood formats include:
      NamePurposeMan page
      PF_UNIX, PF_LOCALLocal communication unix(7)
      PF_INET IPv4 Internet protocols ip(7)
      PF_INET6 Internet protocols  
      PF_IPX IPX - Novell protocols  
      PF_NETLINK Kernel user interface device netlink(7)
      PF_X25 ITU-T X.25 / ISO-8208 protocol x25(7)
      PF_AX25 Amateur radio AX.25 protocol  
      PF_ATMPVC Access to raw ATM PVCs  
      PF_APPLETALK Appletalk ddp(7)
      PF_PACKET Low level packet interface packet(7)

      TYPE
      The socket has the indicated type, which specifies the communication semantics. Currently defined types are:
      SOCK_STREAM
      Provides sequenced, reliable, two-way, connection-based byte streams. An out-of-band data transmission mechanism may be supported.
      SOCK_DGRAM
      Supports datagrams (connectionless, unreliable messages of a fixed maximum length).
      ....

      PROTOCOL
      The protocol specifies a particular protocol to be used with the socket. Normally only a single protocol exists to support a particular socket type within a given protocol family, in which a case protocol can be specified as 0. However, it is possible that many protocols may exist, in which case a particular protocol must be specified in this manner. The protocol number to use is specific to the "communication domain" in which communication is to take place; see protocols(5). See getprotoent(3) on how to map protocol name strings to protocol numbers.
      
      use Socket;
      my $proto = Socket::IPPROTO_TCP(); # of exporteer expliciet
      # defined(my $proto = getprotobyname("tcp")) ||
      #     die "Unknown protocol 'tcp'";
      # my $proto = 0;
      socket(my $socket, PF_INET, SOCK_STREAM, $proto) ||
        die "could not create socket: $!";
      
    3. De server kiest een IP adres en poort om op te luisteren:

      In perl doe je deze binding met de "bind" operator:

      bind SOCKET,NAME
      Binds a network address to a socket, just as the bind system call does. Returns true if it succeeded, false otherwise. NAME should be a packed address of the appropriate type for the socket. See the examples in "Sockets: Client/Server Communication" in perlipc.

      We moeten blijkbaar in de bind manpage kijken:

      
      NAME
          bind - bind a name to a socket
      
      SYNOPSIS
          #include <sys/types.h>
          #include <sys/socket.h>
      
          int bind(int sockfd, struct sockaddr *my_addr, socklen_t addrlen);
      DESCRIPTION
          bind gives the socket sockfd the local address my_addr. my_addr is
          addrlen bytes long. Traditionally, this is called "assigning a name to
          a  socket." When a socket is created with socket(2), it exists in a
          name space (address family) but has no name assigned.
      
          It is normally necessary to assign a local address using bind before  a
          SOCK_STREAM socket may receive connections (see accept(2)).
      
          The  rules used in name binding vary between address families. Consult
          the manual entries in Section 7 for detailed information. For AF_INET
          see  ip(7), for AF_UNIX see unix(7), for AF_APPLETALK see ddp(7), for
          AF_PACKET see packet(7), for AF_X25 see x25(7) and for AF_NETLINK see
          netlink(7).
      

      Volgende stap is de ip(7) manpage:

      
      struct sockaddr_in {
          sa_family_t    sin_family; /* address family: AF_INET */
          u_int16_t      sin_port;   /* port in network byte order */
          struct in_addr  sin_addr;  /* internet address */
      };
      
      0001020304050607 0809101112131415 1617181920212223 2425262728293031
      Family Port
      Address
      in_addr padding
      in_addr padding
      In perl zouden we zulk een byte-sequentie kunnen produceren met pack (en soms vind je inderdaad perl programmas die het zo doen), maar gelukking is er een gemakkelijkere manier met Socket.pm:
      pack_sockaddr_in PORT, IP_ADDRESS
      Takes two arguments, a port number and an opaque string, IP_ADDRESS (as returned by inet_aton(), or a v-string). Returns the sockaddr_in structure with those arguments packed in with AF_INET filled in. For Internet domain sockets, this structure is normally what you need for the arguments in bind(), connect(), and send(), and is also returned by getpeername(), getsockname() and recv().

      En tenslotte hebben we inet_aton in Socket.pm:

      inet_aton HOSTNAME
      Takes a string giving the name of a host, and translates that to an opaque string (if programming in C, struct in_addr). Takes arguments of both the 'rtfm.mit.edu' type and '18.181.0.24'. If the host name cannot be resolved, returns undef. For multi-homed hosts (hosts with more than one address), the first address found is returned.

      Dus onze code wordt:

      my $addr = inet_aton("127.0.0.1");
      my $bind = pack_sockaddr_in(1234, $addr);
      bind($socket, $bind) ||
          die "Could not bind socket to 127.0.0.1:1234: $!";
      
      We kunnen ook alleen op een poort luisteren zonder een specifiek IP adres te kiezen (het quad zal vervolledigd worden wanneer de verbinding gemaakt wordt):


      Dit werkt door gebruik van INADDR_ANY:
      my $bind = pack_sockaddr_in(1234, INADDR_ANY);
      bind($socket, $bind) ||
          die "Could not bind socket to port 1234: $!";
      
    4. De server zegt bereid te zijn verbindingen te ontvangen:


      In perl gaat dit met de "listen" operator:
      listen SOCKET,QUEUESIZE
      Does the same thing that the listen system call does. Returns true if it succeeded, false otherwise. See the example in "Sockets: Client/Server Communication" in perlipc.
      En weer naar de listen manpage:
      NAME
          listen - listen for connections on a socket
      
      SYNOPSIS
          #include 
      
          int listen(int s, int backlog);
      
      DESCRIPTION
          To  accept  connections,  a  socket  is first created with socket(2), a
          willingness to accept incoming connections and a queue limit for incom-
          ing connections are specified with listen, and then the connections are
          accepted with accept(2).  The listen call applies only  to  sockets  of
          type SOCK_STREAM or SOCK_SEQPACKET.
      
          The backlog parameter defines the maximum length the queue of pending
          connections may grow to. If a connection request arrives with the queue
          full the client may receive an error with an indication of ECONNREFUSED
          or, if the underlying protocol supports retransmission, the request may
          be ignored so that retries succeed.
      
      Onze server code:
      listen($socket, 5) ||
          die "Could not listen on socket: $!";
      
    5. De client gaat nu een verbinding maken. Eerst weer een socket creëren:


      Client code:
      use Socket;
      socket(my $socket, PF_INET, SOCK_STREAM, Socket::IPPROTO_TCP()) ||
        die "could not create socket: $!";
      
    6. De client bindt zich aan een bepaald IP adres en poort (dit wordt normaal NIET gedaan):


      Client code:

      my $addr = inet_aton("127.0.0.1");
      my $bind = pack_sockaddr_in(1235, $addr);
      bind($socket, $bind) ||
          die "Could not bind socket to 127.0.0.1:1235: $!";
      
      Port 0 betekent dat het systeem een vrije poort mag kiezen.

    7. De client maakt een verbinding met de server:


      In perl gebruik je daar de "connect" operator voor:
      connect SOCKET,NAME
      Attempts to connect to a remote socket, just as the connect system call does. Returns true if it succeeded, false otherwise. NAME should be a packed address of the appropriate type for the socket. See the examples in "Sockets: Client/Server Communication" in perlipc.

      Onze client code groeit dus met:
      defined(my $addr = inet_aton("localhost")) ||
          die "Could not find an address for 'localhost'";
      my $destination = pack_sockaddr_in(1234, $addr);
      connect($socket, $destination) ||
          die "Could not connect to localhost:1234: $!";
      
    8. De server ziet dat er een inkomende verbinding is en doet er iets mee


      Een inkomende verbinding accepteren gaat in perl met de "accept" operator:
      accept NEWSOCKET,GENERICSOCKET
      Accepts an incoming socket connect, just as the accept(2) system call does. Returns the packed address if it succeeded, false otherwise. See the example in "Sockets: Client/Server Communication" in perlipc.

      On systems that support a close-on-exec flag on files, the flag will be set for the newly opened file descriptor, as determined by the value of $^F. See "$^F" in perlvar.
      En de server code groeit weer:
      while (1) {
          my $peer_packed = accept(my $accepted, $socket);
          if (!$peer_packed) {
              print STDERR "Error accepting connection: $!\n";
              next;
          }
      
          my ($peer_port, $peer_address) =
              unpack_sockaddr_in($peer_packed);
          my $peer_ip = inet_ntoa($peer_address);
          print STDERR "Received a connection from $peer_ip:$peer_port\n";
          print $accepted "Hello $peer_ip:$peer_port\n";
          close $accepted;
      }
      
      Aan de client kant kunnen we nu proberen deze string te lezen:
      defined(my $line = <$socket>) ||
          die "Unexpected EOF on connection to 127.0.0.1:1234\n";
      print STDERR "Peer said: $line";
      
    (Toon server_base.pl en client_bound.pl)
  4. Suffering from buffering

    Wat als we een sleep bijvoegen in de server, als volgt:
        print STDERR "Received a connection from $peer_ip:$peer_port\n";
        print $accepted "Hello $peer_ip:$peer_port\n";
        sleep 5;
        close $accepted;
    
    (Toon server_noflush.pl en client_bound.pl)

    De oorzaak is STDIO buffering:

    0001020304050607 0809101112131415 1617181920212223 2425262728293031
                                       
    print $fh "Een goede hoeveelheid data\n";
    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    E e n   g o e d e   h o e v e e l h e i d   d a t a \n      
    print $fh "En meer data\n";
    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    E e n   g o e d e   h o e v e e l h e i d   d a t a \n E n   m e
    "Een goede hoeveelheid data\nEn me" => $fh
    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    e r   d a t a \n                           

    Buffering afzetten voor een filehandle:

    my $old_fh = select($fh);
    $| = 1;
    select($old_fh);
    
    (Toon server_flush.pl en client_bound.pl)

    Er is ook buffering aan de ontvangende kant:
    0001020304050607 0809101112131415 1617181920212223 2425262728293031
                                       

    $line = <$fh>;

    $fh =>"Een goede hoeveelheid data\nEn "
    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    E e n   g o e d e   h o e v e e l h e i d   d a t a \n E n      

    "Een goede hoeveelheid data\n" => $line

    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    E n                                   

  5. IO::Socket::INET

    Onze server code:
    
    #!/usr/bin/perl -w
    use strict;
    use Socket;
    # my $proto = Socket::IPPROTO_TCP(); # of exporteer expliciet
    # defined(my $proto = getprotobyname("tcp") ||
    #     die "Unknown protocol 'tcp'";
    my $proto = 0;
    socket(my $socket, PF_INET, SOCK_STREAM, $proto) ||
      die "could not create socket: $!";
    
    my $addr = inet_aton("127.0.0.1");
    my $bind = pack_sockaddr_in(1234, $addr);
    bind($socket, $bind) ||
        die "Could not bind socket to 127.0.0.1:1234: $!";
    listen($socket, 5) ||
        die "Could not listen on socket: $!";
    
    while (1) {
        my $peer_packed = accept(my $accepted, $socket);
        if (!$peer_packed) {
            print STDERR "Error accepting connection: $!\n";
            next;
        }
    
        my $old_fh = select($accepted);
        $| = 1;
        select($old_fh);
    
        my ($peer_port, $peer_address) =
            unpack_sockaddr_in($peer_packed);
        my $peer_ip = inet_ntoa($peer_address);
        print STDERR "Received a connection from $peer_ip:$peer_port\n";
        print $accepted "Hello $peer_ip:$peer_port\n";
        close $accepted;
    }
    
    Hetzelfde met IO::Socket::INET:
    
    #!/usr/bin/perl -w
    use strict;
    use IO::Socket::INET;
    
    my $socket = IO::Socket::INET->new(# Proto => "tcp",
                                       LocalAddr => "127.0.0.1",
                                       LocalPort => 1234,
                                       Listen    => 5) ||
        die "Could not listen on 127.0.0.1:1234: $!";
    
    while (1) {
        my $accepted = $socket->accept;
        # (my ($accepted, $peer_packed) = $socket->accept;
        if (!$accepted) {
            print STDERR "Error accepting connection: $!\n";
            next;
        }
    
        my $peer_port = $accepted->peerport;
        my $peer_ip   = $accepted->peerhost;
        print STDERR "Received a connection from $peer_ip:$peer_port\n";
        print $accepted "Hello $peer_ip:$peer_port\n";
        sleep 5;
        close $accepted;
    }
    
    Onze client code:
    
    #!/usr/bin/perl -w
    use strict;
    use Socket;
    socket(my $socket, PF_INET, SOCK_STREAM, Socket::IPPROTO_TCP()) ||
      die "could not create socket: $!";
    my $addr = inet_aton("127.0.0.1");
    my $bind = pack_sockaddr_in(1235, $addr);
    bind($socket, $bind) ||
        die "Could not bind socket to 127.0.0.1:1235: $!";
    
    defined($addr = inet_aton("localhost")) ||
        die "Could not find an address for 'localhost'";
    my $destination = pack_sockaddr_in(1234, $addr);
    connect($socket, $destination) ||
        die "Could not connect to localhost:1234: $!";
    defined(my $line = <$socket>) ||
        die "Unexpected EOF on connection to 127.0.0.1:1234\n";
    print STDERR "Peer said: $line";
    
    Hetzelfde met IO::Socket::INET:
    
    #!/usr/bin/perl -w
    use strict;
    use IO::Socket::INET;
    
    my $socket = IO::Socket::INET->new(# Proto => "tcp",
                                       # LocalAddr => "127.0.0.1",
                                       # LocalPort => 1235,
                                       PeerAddr => "127.0.0.1",
                                       PeerPort => 1234) ||
        die "Could not listen on 127.0.0.1:1234: $!";
    defined(my $line = <$socket>) ||
        die "Unexpected EOF on connection to 127.0.0.1:1234\n";
    print STDERR "Peer said: $line";
    
    (Toon server_io_inet.pl en client_io_inet.pl)
  6. Meerder clients: multitasking

    (Toon server_io_inet.pl met meerdere client_io_inet.pl)

    Een eenvoudige oplossing zou zijn als er evenveel versies van ons programma liepen als er verbindingen zijn, waar ieder programma een verbinding afhandelt. En daarbovenop nog het originele programma dat inkomende verbindigen afvangt.

    Dat kan met "fork" of multithreading.

  7. Fork

    Oorspronkelijk:

    Fork():

    Later:

    Child doet exit 5:

    Parent doet wait:

    Server code wordt nu:

    #!/usr/bin/perl -w
    use strict;
    use POSIX ":sys_wait_h";
    use IO::Socket::INET;
    
    sub reaper {
        my $child;
        # If a second child dies while in the signal handler caused by the
        # first death, we won't get another signal. So must loop here else
        # we will leave the unreaped child as a zombie. And the next time
        # two children die we get another zombie. And so on.
        while ((my $child = waitpid(-1,WNOHANG)) > 0) {
            print STDERR "Child $child exits with status $?\n";
        }
        $SIG{CHLD} = \&reaper;  # loathe sysV
    }
    $SIG{CHLD} = \&reaper;
    
    # Modern UNIX:
    # $SIG{CHLD} = "IGNORE";
    
    my $socket = IO::Socket::INET->new(LocalAddr => "127.0.0.1",
                                       LocalPort => 1234,
                                       Listen    => 5) ||
        die "Could not listen on 127.0.0.1:1234: $!\n";
    
    while (1) {
        my $accepted = $socket->accept;
        # (my ($accepted, $peer_packed) = $socket->accept;
        if (!$accepted) {
            print STDERR "Error accepting connection: $!\n";
            next;
        }
        defined(my $pid = fork) ||
            die "Could not fork: $!";
    
        if ($pid) {
            # Parent
            # Schrijf expliciet voor duidelijkheid
            close $accepted;
            next;
        }
        # Child
        close $socket;
        my $peer_port = $accepted->peerport;
        my $peer_ip   = $accepted->peerhost;
        print STDERR "Pid $$, received a connection from $peer_ip:$peer_port\n";
        print $accepted "Hello $peer_ip:$peer_port\n";
        sleep 5;
        close $accepted;
        exit;
    }
    
    (Toon server_fork.pl met meerdere client_io_inet.pl)

    (Toon server_fork_no_intr.pl met meerdere client_io_inet.pl)

    (talk about preforking)

  8. Threads

    Oorspronkelijk:

    Thread_create():

    Later:

    Subthread returns:

    Thread doet thread_join():

    Tenminste...dat was het plan. Maar er waren te veel problemen met gedeelde datastructuren.

    Windows fork-emulatie leidde to ithreads.

    Oorspronkelijk:

    Thread_create():

    Later:

    Subthread returns:

    Thread doet thread_join():

    Threaded server code:

    #!/usr/bin/perl -w
    use strict;
    use IO::Socket::INET;
    use threads;
    
    my $socket = IO::Socket::INET->new(LocalAddr => "127.0.0.1",
                                       LocalPort => 1234,
                                       Listen    => 5) ||
        die "Could not listen on 127.0.0.1:1234: $!\n";
    
    while (1) {
        my $accepted = $socket->accept;
        if (!$accepted) {
            print STDERR "Error accepting connection: $!\n";
            next;
        }
        my $thr = threads->new(\&process_request, $socket, $accepted);
        $thr->detach;
        close($accepted);
    }
    
    sub process_request {
        my ($socket, $accepted) = @_;
        close $socket;
        my $peer_port = $accepted->peerport;
        my $peer_ip   = $accepted->peerhost;
        print STDERR "Pid $$, received a connection from $peer_ip:$peer_port\n";
        print $accepted "Hello $peer_ip:$peer_port\n";
        sleep 5;
        close($accepted);
    }
    
    (Toon server_thread.pl met meerdere client_io_inet.pl)
  9. Hoger niveau modules voor forking/threading

    Veel van het werk nodig voor deze stijl van servers schrijven is allemaal al aanwezig in Net::Daemon en Net::Server. De code kan er dan als volgt uit zien:
    #!/usr/bin/perl -w
    use strict;
    use base qw(Net::Server::Fork);
    
    sub process_request {
        my $self = shift;
        my $accepted = $self->{server}{client};
        my $peer_port = $accepted->peerport;
        my $peer_ip   = $accepted->peerhost;
        print STDERR "Pid $$, received a connection from $peer_ip:$peer_port\n";
        print $accepted "Hello $peer_ip:$peer_port\n";
        sleep 5;
    }
    
    __PACKAGE__->run(host => "127.0.0.1",
                     port => 1234);
    
    (Toon server_net.pl met meerdere client_io_inet.pl)
  10. Meerdere dingen tegelijk in één process

    Server en client proberen beide een file te sturen:
    open(my $fh, "<", $file) || die "Could not open $file: $!";
    local $_;
    print $accepted $_ while <$fh>;
    shutdown($accepted, 1);
    1 while <$accepted>;
    
    (Toon server_cross_files.pl en client_cross_files.pl met korte en lange files. Doe strace)

    $SIG{PIPE} = "IGNORE";

    Eerst read, dan write:

    local $_;
    1 while <$accepted>;
    shutdown($accepted, 0);
    open(my $fh, "<", $file) || die "Could not open $file: $!";
    print $accepted $_ while <$fh>;
    
    (Toon server_cross_files2.pl en client_cross_files2.pl met korte en lange files)

    (Toon server_cross_files{,2}.pl en client_cross_files{,2}.pl met korte en lange files)

    Opsplitsen met nog een fork:

    local $_;
    defined($pid = fork) || die "Could not fork: $!";
    if ($pid) {
        # parent
        shutdown($accepted, 1);
        1 while <$accepted>;
    } else {
        # child
        shutdown($accepted, 0);
        open(my $fh, "<", $file) || die "Could not open $file: $!";
        print $accepted $_ while <$fh>;
    }
    close $accepted;
    print STDERR "Next!\n";
    _exit(0);
    
    (Toon server_cross_fork.pl en client_cross_fork.pl)

    Chat server ?

  11. Meerdere dingen tegelijk in één process, deel 2

    select RBITS,WBITS,EBITS,TIMEOUT
    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    00010000 00100000 11000000 00000010

    After select:

    0001020304050607 0809101112131415 1617181920212223 2425262728293031
    00010000 00000000 01000000 00000000

    Als klaar voor read/write => één laag niveau read/write.

    sysread FILEHANDLE,SCALAR,LENGTH,OFFSET
    sysread FILEHANDLE,SCALAR,LENGTH
    
    syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET
    syswrite FILEHANDLE,SCALAR,LENGTH
    syswrite FILEHANDLE,SCALAR
    
    Event driven code:
    my $accepted_fd = fileno($accepted);
    
    my $read = 0;
    my $reading = 1;
    my $rd_mask = "";
    vec($rd_mask, $accepted_fd, 1) = 1;
    
    open(my $fh, "<", $file) || die "Could not open $file: $!";
    my $out_buffer = do { local $/; <$fh> };
    my $writing;
    my $wr_mask = "";
    if ($out_buffer eq "") {
        $writing = 0;
        shutdown($accepted, 1);
    } else {
        $writing = 1;
        vec($wr_mask, $accepted_fd, 1) = 1;
    }
    
    while ($reading || $writing) {
        my $nfound =
            select(my $rd = $rd_mask, my $wr = $wr_mask, undef, undef);
        if ($nfound < 0) {
            next if $! == EINTR;
            die "Select error: $!";
        }
        if ($reading && vec($rd, $accepted_fd, 1)) {
            my $rc = sysread($accepted, my $buffer, 4096);
            if ($rc) {
                $read += $rc;
            } elsif (defined($rc)) {
                # EOF
                print STDERR "Read $read bytes\n";
                $reading = 0;
                $rd_mask = "";
                shutdown($accepted, 0);
            } else {
                # Error
                die "Read error: $!" if $! != EINTR;
            }
        }
        if ($writing && vec($wr, $accepted_fd, 1)) {
            if (defined(my $rc = syswrite($accepted, $out_buffer))) {
                substr($out_buffer, 0, $rc, "");
                if ($out_buffer eq "") {
                    $writing = 0;
                    $wr_mask = "";
                    shutdown($accepted, 1);
                }
            } else {
                # Error
                die "Write error: $!" if $! != EINTR;
            }
        }
    }
    

    (Toon server_fork_select.pl en client_select.pl. Doe strace)

    (Talk about blocking/non-blocking)

    (Toon server_fork_select2.pl en client_select2.pl)

  12. Binnenkomende verbindingen als events

    Mogelijke stijl: ${*$socket}{out_buffer} = "";

    Beter: een object per verbinding:

    #!/usr/bin/perl -w
    use strict;
    use IO::Socket::INET;
    use POSIX qw(EINTR);
    
    my $rd_mask = my $wr_mask = "";
    my %connections;
    
    package Connection;
    use POSIX qw(EINTR EWOULDBLOCK);
    
    sub new {
        my ($class, $socket, $out) = @_;
        $socket->blocking(0);
        my $connection = bless {
            handle	   => $socket,
            fileno	   => fileno($socket),
            reading	   => 1,
            in_buffer  => "",
            out_buffer => $out,
            peer_ip    => $socket->peerhost,
            peer_port  => $socket->peerport,
        }, $class;
        vec($rd_mask, $connection->{fileno}, 1) = 1;
        vec($wr_mask, $connection->{fileno}, 1) = 1 if $out ne "";
        print STDERR "Handling connection from ",
            "$connection->{peer_ip}:$connection->{peer_port}\n";
        return $connection;
    }
    
    sub readable {
        my $connection = shift;
    
        my $rc = sysread($connection->{handle}, my $buffer, 8192);
        if ($rc) {
            $connection->{in_buffer} .= $buffer;
            return;
        }
        if (defined($rc)) {
            # EOF
            printf STDERR "Read %d bytes\n", length($connection->{in_buffer});
            $connection->{reading} = 0;
            vec($rd_mask, $connection->{fileno}, 1) = 0;
            shutdown($connection->{handle}, 0);
            delete $connections{$connection} if $connection->{out_buffer} eq "";
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error reading from socket to ",
            "$connection->{peer_ip}:$connection->{peer_port}: $!\n";
        delete $connections{$connection};
        vec($rd_mask, $connection->{fileno}, 1) = 0;
        vec($wr_mask, $connection->{fileno}, 1) = 0;
        $connection->{reading} = 0;
        close $connection->{handle};
    }
    
    sub writable {
        my $connection = shift;
    
        if (defined(my $rc = syswrite($connection->{handle},
                                      $connection->{out_buffer}))) {
            substr($connection->{out_buffer}, 0, $rc, "");
            if ($connection->{out_buffer} eq "") {
                vec($wr_mask, $connection->{fileno}, 1) = 0;
                shutdown($connection->{handle}, 1);
                delete $connections{$connection} if !$connection->{reading};
            }
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error writing to socket to ",
            "$connection->{peer_ip}:$connection->{peer_port}: $!\n";
        delete $connections{$connection};
        vec($rd_mask, $connection->{fileno}, 1) = 0;
        vec($wr_mask, $connection->{fileno}, 1) = 0;
        $connection->{reading} = 0;
        close $connection->{handle};
    }
    
    sub DESTROY {
        my $connection = shift;
        print STDERR "Connection to ",
            "$connection->{peer_ip}:$connection->{peer_port} forgotten\n";
    }
    
    package main;
    
    $SIG{PIPE} = "IGNORE";
    
    defined(my $file = shift) || die "Usage: $0 file\n";
    open(my $fh, "<", $file) || die "Could not open $file: $!";
    my $out = do { local $/; <$fh> };
    
    my $listener = IO::Socket::INET->new(LocalAddr => "127.0.0.1",
                                         LocalPort => 1234,
                                         Listen    => 5) ||
        die "Could not listen on 127.0.0.1:1234: $!\n";
    
    $listener->blocking(0);
    my $listener_fd = fileno($listener);
    vec($rd_mask, $listener_fd, 1) = 1;
    
    while (1) {
        my $rc = select(my $rd = $rd_mask, my $wr = $wr_mask, undef, undef);
        if ($rc < 0) {
            next if $! == EINTR;
            die "Unexpected select error: $!";
        }
        for my $connection (values %connections) {
            $connection->writable if vec($wr, $connection->{fileno}, 1);
            $connection->readable if
                vec($rd, $connection->{fileno}, 1) && $connection->{reading};
        }
        if (vec($rd, $listener_fd, 1)) {
            if (my $socket = $listener->accept) {
                my $connection = Connection->new($socket, $out);
                $connections{$connection} = $connection;
            } else {
                print STDERR "Error accepting connection: $!\n" unless $! == EINTR;
            }
        }
    }
    

    (Toon server_select2.pl en client_cross_sleepy.pl)

  13. Gebruik van IO::Select

    #!/usr/bin/perl -w
    use strict;
    use IO::Socket::INET;
    use IO::Select;
    use POSIX qw(EINTR);
    
    my $rd_set = IO::Select->new();
    my $wr_set = IO::Select->new();
    
    my %connections;
    
    package Connection;
    use POSIX qw(EINTR EWOULDBLOCK);
    
    sub new {
        my ($class, $socket, $out) = @_;
        $socket->blocking(0);
        my $connection = bless {
            handle	   => $socket,
            reading	   => 1,
            in_buffer  => "",
            out_buffer => $out,
            peer_ip    => $socket->peerhost,
            peer_port  => $socket->peerport,
        }, $class;
        $rd_set->add($connection->{handle});
        $wr_set->add($connection->{handle}) if $out ne "";
        print STDERR "Handling connection from ",
            "$connection->{peer_ip}:$connection->{peer_port}\n";
        return $connection;
    }
    
    sub readable {
        my $connection = shift;
    
        my $rc = sysread($connection->{handle}, my $buffer, 8192);
        if ($rc) {
            $connection->{in_buffer} .= $buffer;
            return;
        }
        if (defined($rc)) {
            # EOF
            printf STDERR "Read %d bytes\n", length($connection->{in_buffer});
            $connection->{reading} = 0;
            $rd_set->remove($connection->{handle});
            shutdown($connection->{handle}, 0);
            $connection->remove if $connection->{out_buffer} eq "";
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error reading from socket to ",
            "$connection->{peer_ip}:$connection->{peer_port}: $!\n";
        $connection->drop;
    }
    
    sub writable {
        my $connection = shift;
    
        if (defined(my $rc = syswrite($connection->{handle},
                                      $connection->{out_buffer}))) {
            substr($connection->{out_buffer}, 0, $rc, "");
            if ($connection->{out_buffer} eq "") {
                $wr_set->remove($connection->{handle});
                shutdown($connection->{handle}, 1);
                $connection->remove if !$connection->{reading};
            }
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error writing to socket to ",
            "$connection->{peer_ip}:$connection->{peer_port}: $!\n";
        $connection->drop;
    }
    
    sub remove {
        my $connection = shift;
        delete $connections{$connection->{handle}};
    }
    
    sub drop {
        my $connection = shift;
        $connection->remove;
        $rd_set->remove($connection->{handle});
        $wr_set->remove($connection->{handle});
        $connection->{reading} = 0;
        close $connection->{handle};
    }
    
    sub DESTROY {
        my $connection = shift;
        print STDERR "Connection to ",
            "$connection->{peer_ip}:$connection->{peer_port} forgotten\n";
    }
    
    package main;
    
    $SIG{PIPE} = "IGNORE";
    
    defined(my $file = shift) || die "Usage: $0 file\n";
    open(my $fh, "<", $file) || die "Could not open $file: $!";
    my $out = do { local $/; <$fh> };
    
    my $listener = IO::Socket::INET->new(LocalAddr => "127.0.0.1",
                                         LocalPort => 1234,
                                         Listen    => 5) ||
        die "Could not listen on 127.0.0.1:1234: $!\n";
    
    $listener->blocking(0);
    $rd_set->add($listener);
    
    while (1) {
        $! = EINTR;
        if (my ($readable, $writable) =
            IO::Select::select($rd_set, $wr_set, undef, undef)) {
            $connections{$_}->writable for @$writable;
            for (@$readable) {
                if ($_ eq $listener) {
                    if (my $socket = $listener->accept) {
                        my $connection = Connection->new($socket, $out);
                        $connections{$socket} = $connection;
                    } else {
                        print STDERR "Error accepting connection: $!\n" unless
                            $! == EINTR;
                    }
                } else {
                    $connections{$_}->readable if $connections{$_}{reading};
                }
            }
        } else {
            die "Select failed: $!" unless $! == EINTR;
        }
    }
    

    (Toon server_io_select.pl en client_select.pl)

  14. Abstractie van de leesbaar/schrijfbaar testen: Event

    #!/usr/bin/perl -w
    use strict;
    use IO::Socket::INET;
    use Event qw(loop);
    use POSIX qw(EINTR);
    
    package Connection;
    use POSIX qw(EINTR EWOULDBLOCK);
    
    sub new {
        my ($class, $socket, $out) = @_;
        $socket->blocking(0);
        my $connection = bless {
            handle	   => $socket,
            rd_watcher => undef,
            wr_watcher => undef,
            in_buffer  => "",
            out_buffer => $out,
            peer_ip    => $socket->peerhost,
            peer_port  => $socket->peerport,
        }, $class;
        $connection->{rd_watcher} = Event->io(fd => $connection->{handle},
                                              poll => "r",
                                              cb => [$connection, "readable"]);
        $connection->{wr_watcher} = Event->io(fd => $connection->{handle},
                                              poll => "w",
                                              cb => [$connection, "writable"]);
        print STDERR "Handling connection from ",
            "$connection->{peer_ip}:$connection->{peer_port}\n";
        return $connection;
    }
    
    sub readable {
        my $connection = shift;
    
        my $rc = sysread($connection->{handle}, my $buffer, 8192);
        if ($rc) {
            $connection->{in_buffer} .= $buffer;
            return;
        }
        if (defined($rc)) {
            # EOF
            printf STDERR "Read %d bytes\n", length($connection->{in_buffer});
            $connection->{rd_watcher}->cancel;
            $connection->{rd_watcher} = undef;
            shutdown($connection->{handle}, 0);
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error reading from socket to ",
            "$connection->{peer_ip}:$connection->{peer_port}: $!\n";
        $connection->drop;
    }
    
    sub writable {
        my $connection = shift;
    
        if (defined(my $rc = syswrite($connection->{handle},
                                      $connection->{out_buffer}))) {
            substr($connection->{out_buffer}, 0, $rc, "");
            if ($connection->{out_buffer} eq "") {
                $connection->{wr_watcher}->cancel;
                $connection->{wr_watcher} = undef;
                shutdown($connection->{handle}, 1);
            }
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error writing to socket to ",
            "$connection->{peer_ip}:$connection->{peer_port}: $!\n";
        $connection->drop;
    }
    
    sub drop {
        my $connection = shift;
        if ($connection->{rd_watcher}) {
            $connection->{rd_watcher}->cancel;
            $connection->{rd_watcher} = undef;
        }
        if ($connection->{wr_watcher}) {
            $connection->{wr_watcher}->cancel;
            $connection->{wr_watcher} = undef;
        }
        close $connection->{handle};
    }
    
    sub DESTROY {
        my $connection = shift;
        print STDERR "Connection to ",
            "$connection->{peer_ip}:$connection->{peer_port} forgotten\n";
    }
    
    package main;
    
    $SIG{PIPE} = "IGNORE";
    
    defined(my $file = shift) || die "Usage: $0 file\n";
    my $out = do {
        open(my $fh, "<", $file) || die "Could not open $file: $!";
        local $/;
        <$fh>;
    };
    
    my $listener = IO::Socket::INET->new(LocalAddr => "127.0.0.1",
                                         LocalPort => 1234,
                                         Listen    => 5) ||
        die "Could not listen on 127.0.0.1:1234: $!\n";
    
    $listener->blocking(0);
    Event->io(fd => $listener,
              poll => "r",
              cb => sub {
                  if (my $socket = $listener->accept) {
                      Connection->new($socket, $out);
                  } else {
                      print STDERR "Error accepting connection: $!\n" unless
                          $! == EINTR;
                  }
              });
    
    loop;
    

    (Toon server_event.pl en client_select.pl)

  15. Clients kunnen ook met meerder partijen praten

    #!/usr/bin/perl -w
    use strict;
    use Event qw(loop);
    use POSIX qw(EINPROGRESS);
    use IO::Socket::INET;
    use Socket qw(:all);
    
    for my $port (@ARGV) {
        my $socket = IO::Socket::INET->new(proto => "tcp") || 
            die "Could not create socket: $!";
        $socket->blocking(0);
        if (connect($socket, pack_sockaddr_in($port, inet_aton("127.0.0.1")))) {
            activate($socket);
        } elsif ($! == EINPROGRESS) {
            my $watcher;
            $watcher = Event->io(fd => $socket,
                                 poll => "w",
                                 cb => sub { 
                                     $watcher->cancel;
                                     connect_result($socket);
                                 });
        } else {
            print STDERR "Could not connect to 127.0.0.1:$port: $!";
        }
    }
    
    sub connect_result {
        my $socket = shift;
        my $packed = getsockopt($socket, SOL_SOCKET, SO_ERROR);
        if (my $rc = unpack("I", $packed)) {
            print STDERR "Could not connect: ", $! = $rc, "\n";
            return;
        }
        activate($socket);
    }
    
    sub activate {
        my $socket = shift;
        print STDERR "Do real work on $socket\n";
    }
    
    loop;
    
    (Toon perl client_event.pl 22 80)

  16. "event driven" programmeren

    
    <- First Number ?
    -> 15
    <- Second Number ?
    -> 28
    <- 15*28=420
    <- First Number ?
    -> ^D
    
    Weten wat we doen door waar we zijn:
    #!/usr/bin/perl -w
    use strict;
    use base qw(Net::Server::Fork);
    
    sub process_request {
        my $self = shift;
        my $accepted = $self->{server}{client};
        while (1) {
            print $accepted "First Number ?\n";
            defined(my $num1 = <$accepted>) || last;
    
            print $accepted "Second Number ?\n";
            defined(my $num2 = <$accepted>) || last;
    
            printf $accepted "%d*%d=%d\n", $num1, $num2, $num1*$num2;
        }
    }
    
    __PACKAGE__->run(host => "127.0.0.1",
                     port => 1234);
    
    (Toon calculator_net.pl en telnet)

    Weten wat we doen door expliciet state by te houden:

    #!/usr/bin/perl -w
    use strict;
    use IO::Socket::INET;
    use Event qw(loop);
    use POSIX qw(EINTR);
    
    package Connection;
    use POSIX qw(EINTR EWOULDBLOCK);
    
    sub new {
        my ($class, $socket) = @_;
        $socket->blocking(0);
        my $connection = bless {
            state	   => undef,
            handle	   => $socket,
            rd_watcher => undef,
            wr_watcher => undef,
            in_buffer  => "",
            out_buffer => "",
            nums	   => [],
        }, $class;
        $connection->{rd_watcher} = 
            Event->io(fd => $connection->{handle},
                      poll => "r",
                      cb => [$connection, "readable"]);
        $connection->want_num1;
        return $connection;
    }
    
    sub readable {
        my $connection = shift;
    
        my $rc = sysread($connection->{handle}, my $buffer, 8192);
        if ($rc) {
            $connection->{in_buffer} .= $buffer;
            $connection->{state}->($connection, $1) while
                $connection->{in_buffer} =~ s/^(.*)\n//;
            return;
        }
        if (defined($rc)) {
            # EOF
            $connection->drop;
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error reading from socket $!\n";
        $connection->drop;
    }
    
    sub writable {
        my $connection = shift;
    
        if (defined(my $rc = syswrite($connection->{handle},
                                      $connection->{out_buffer}))) {
            substr($connection->{out_buffer}, 0, $rc, "");
            if ($connection->{out_buffer} eq "") {
                $connection->{wr_watcher}->cancel;
                $connection->{wr_watcher} = undef;
            }
            return;
        }
        return if $! == EINTR || $! == EWOULDBLOCK;
        print STDERR "Error writing to socket: $!\n";
        $connection->drop;
    }
    
    sub drop {
        my $connection = shift;
    
        if ($connection->{rd_watcher}) {
            $connection->{rd_watcher}->cancel;
            $connection->{rd_watcher} = undef;
        }
        if ($connection->{wr_watcher}) {
            $connection->{wr_watcher}->cancel;
            $connection->{wr_watcher} = undef;
        }
        close $connection->{handle};
    }
    
    sub write : method {
        my $connection = shift;
        $connection->{out_buffer} .= shift;
        return if $connection->{out_buffer} eq "" ||
            $connection->{wr_watcher};
        $connection->{wr_watcher} =
            Event->io(fd => $connection->{handle},
                      poll => "w",
                      cb => [$connection, "writable"]);
    }
    
    sub want_num1 {
        my $connection = shift;
        $connection->write("First Number ?\n");
        $connection->{state} = \&got_num1;
    }
    
    sub got_num1 {
        my $connection = shift;
        $connection->{nums}[0] = shift;
        $connection->want_num2;
    }
    
    sub want_num2 {
        my $connection = shift;
        $connection->write("Second Number ?\n");
        $connection->{state} =  \&got_num2;
    }
    
    sub got_num2 {
        my $connection = shift;
        my $num1 = $connection->{nums}[0];
        my $num2 = shift;
        $connection->write(sprintf("%d*%d=%d\n", 
                                   $num1, $num2, $num1*$num2));
        $connection->want_num1;
    }
    
    sub DESTROY {
        my $connection = shift;
        print STDERR "Connection forgotten\n";
    }
    
    package main;
    
    $SIG{PIPE} = "IGNORE";
    
    my $listener = IO::Socket::INET->new(LocalAddr => "127.0.0.1",
                                         LocalPort => 1234,
                                         Listen    => 5) ||
        die "Could not listen on 127.0.0.1:1234: $!\n";
    
    $listener->blocking(0);
    Event->io(fd => $listener,
              poll => "r",
              cb => sub {
                  if (my $socket = $listener->accept) {
                      Connection->new($socket);
                  } else {
                      print STDERR "Error accepting connection: $!\n"
                          unless $! == EINTR;
                  }
              });
    
    loop;
    
    (Toon calculator_net.pl en telnet)

  17. POE

    #!/usr/bin/perl -w
    use strict;
    use Socket;
    use POE qw(Wheel::SocketFactory Wheel::ReadWrite);
    
    POE::Session->create
        (args => shift,
         inline_states => {
            _start		=> \&start,
            _default	=> \&default,
    
            accepted	=> \&accepted,
            listener_fails	=> \&listener_fails,
    
            want_num1	=> \&want_num1,
            want_num2	=> \&want_num2,
            connection_error=> \&connection_error,
        });
    $poe_kernel->run();
    
    sub default {
        print STDERR "calling non existant event $_[ARG0]\n" unless
            substr($_[ARG0], 0, 1) eq "_";
        return;
    }
    
    sub start {
        my ($heap, $port) = @_[HEAP, ARG0];
        $port ||= 1234;
        $heap->{listener} = POE::Wheel::SocketFactory->new
            (BindPort => $port,
             SuccessEvent => "accepted",
             FailureEvent => "listener_fails");
    }
    
    sub listener_fails {
        my ($heap, $operator, $errstr) = @_[HEAP, ARG0, ARG2];
        print STDERR "$operator: $errstr\n";
        delete $heap->{listener};
    }
    
    sub accepted {
        my ($heap, $socket, $peer_address, $peer_port) = @_[HEAP, ARG0..ARG2];
        printf(STDERR "Connection from %s:%d\n", 
               inet_ntoa($peer_address), $peer_port);
        my $wheel = POE::Wheel::ReadWrite->new
            (Handle     => $socket,
             InputEvent => "want_num1",
             ErrorEvent => "connection_error");
        $heap->{connections}{$wheel->ID} = {
            wheel => $wheel
        };
        $wheel->put("Number 1?");
    }
    
    sub connection_error {
        my ($heap, $operator, $errno, $errstr, $wheel_id) = @_[HEAP, ARG0..ARG3];
        my $connection = delete $heap->{connections}{$wheel_id};
        if ($errno) {
            print STDERR "$operator: $errstr\n";
        } else {
            # EOF
            print STDERR "Connection closed\n";
        }
    }
    
    sub want_num1 {
        my ($heap, $num1, $wheel_id) = @_[HEAP, ARG0, ARG1];
        my $connection = $heap->{connections}{$wheel_id};
        $connection->{num1} = $num1;
        $connection->{wheel}->event(InputEvent => "want_num2");
        $connection->{wheel}->put("Number 2?");
    }
    
    sub want_num2 {
        my ($heap, $num2, $wheel_id) = @_[HEAP, ARG0, ARG1];
        my $connection = $heap->{connections}{$wheel_id};
        my $num1 = $connection->{num1};
        $connection->{wheel}->put(sprintf("%d*%d=%d", $num1, $num2, $num1*$num2));
        $connection->{wheel}->event(InputEvent => "want_num1");
        $connection->{wheel}->put("Number 1?");
    }
    

    (Toon server_poe.pl en telnet)

    Verander de input methodes op de volgende manier:

    sub want_num1 {
        my ($heap, $num1, $wheel_id) = @_[HEAP, ARG0, ARG1];
        if ($num1 eq "exit") {
            %$heap = ();
            return;
        }
        my $connection = $heap->{connections}{$wheel_id};
        $connection->{num1} = $num1;
        $connection->{wheel}->event(InputEvent => "want_num2");
        $connection->{wheel}->put("Number 2?");
    }
    

    (Toon server_poe2.pl, telnet en exit)

    Zelfde oefening voor de client kant:

    #!/usr/bin/perl -w
    use strict;
    use Socket;
    use POE qw(Wheel::SocketFactory Wheel::ReadWrite);
    
    for my $port (@ARGV) {
      POE::Session->create
          (args => $port,
           inline_states => {
               _start	=> \&start,
               _default	=> \&default,
    
               connected	=> \&connected,
               connect_failed => \&connect_failed,
    
               got_line	    => \&got_line,
               connection_error => \&connection_error,
           });
    }
    $poe_kernel->run();
    
    sub default {
        print STDERR "calling non existant event $_[ARG0]\n" unless
            substr($_[ARG0], 0, 1) eq "_";
        return;
    }
    
    sub start {
        my ($heap, $port) = @_[HEAP, ARG0];
        $heap->{wheel} = POE::Wheel::SocketFactory->new
            (RemoteAddress => "127.0.0.1",
             RemotePort    => $port,
             SuccessEvent  => "connected",
             FailureEvent  => "connect_failed");
    }
    
    sub connect_failed {
        my ($heap, $operator, $errstr) = @_[HEAP, ARG0, ARG2];
        print STDERR "$operator: $errstr\n";
        delete $heap->{wheel};
    }
    
    sub connected {
        my ($heap, $socket) = @_[HEAP, ARG0];
        $heap->{wheel} = POE::Wheel::ReadWrite->new
            (Handle     => $socket,
             InputEvent => "got_line",
             ErrorEvent => "connection_error");
    }
    
    sub connection_error {
        my ($heap, $operator, $errno, $errstr, $wheel_id) = @_[HEAP, ARG0..ARG3];
        delete $heap->{wheel};
        if ($errno) {
            print STDERR "$operator: $errstr\n";
        } else {
            # EOF
            print STDERR "Connection closed\n";
        }
    }
    
    sub got_line {
        my ($heap, $line) = @_[HEAP, ARG0];
        if ($line =~ /Number/) {
            $heap->{wheel}->put(int rand 10);
        } elsif (my ($result) = $line =~ /=(\d+)/) {
            printf STDERR "wheel %d: $line\n", $heap->{wheel}->ID;
            if ($result == 42) {
                print STDERR "Finally!\n";
                delete $heap->{wheel};
            }
        } else {
            delete $heap->{wheel};
            print STDERR "Unexpected line '$line'\n";
        }
    }