Perl Netwerk programmatie

TCP verbindingen

IP header:

00	04	08	16	19
Version	IHL	TOS	Total length
Identification			Flags	Fragment offset
TTL		Protocol	Header checksum
Source IP address
Destination IP address
Options and padding

TCP header:

00	04	07	10	16
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)

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:

Een connectie maken

Eerst is er nog niets:

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:

Name Purpose Man page

PF_UNIX, PF_LOCAL Local 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)

Name	Purpose	Man page
PF_UNIX, PF_LOCAL	Local 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: $!";

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 */
};
```
00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

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: $!";
```

De server zegt bereid te zijn verbindingen te ontvangen:

In perl gaat dit met de "listen" operator:

listen SOCKET,QUEUESIZE

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: $!";

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: $!";

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.
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: $!";
```
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)

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:

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

print $fh "Een goede hoeveelheid data\n";

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

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";

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

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

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

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:

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

$line = <$fh>;

$fh =>"Een goede hoeveelheid data\nEn "

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

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

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

E n

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)

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.

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)

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)

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)

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 ?

Meerdere dingen tegelijk in één process, deel 2

select RBITS,WBITS,EBITS,TIMEOUT

00	01	02	03	04	05	06	07	08	09	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31
0	0	0	1	0	0	0	0	0	0	1	0	0	0	0	0	1	1	0	0	0	0	0	0	0	0	0	0	0	0	1	0

After select:

00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31

0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0

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)

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)

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)

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)

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)

"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)

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";
    }
}

00	01	02	03	04	05	06	07	08	09	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31
Family																Port
Address
in_addr padding
in_addr padding