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 |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
Version | IHL | TOS | Total length | ||||||||||||||||||||||||||||
Identification | Flags | Fragment offset | |||||||||||||||||||||||||||||
TTL | Protocol | Header checksum | |||||||||||||||||||||||||||||
Source IP address | |||||||||||||||||||||||||||||||
Destination IP address | |||||||||||||||||||||||||||||||
Options and padding |
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 |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
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)
In perl creëer je een socket met de "socket" operator:
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:
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)
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: $!";
In perl doe je deze binding met de "bind" operator:
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 */
};
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:
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
En tenslotte hebben we inet_aton in Socket.pm:
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: $!";
NAME listen - listen for connections on a socket SYNOPSIS #includeOnze server code: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.
listen($socket, 5) || die "Could not listen on socket: $!";
use Socket; socket(my $socket, PF_INET, SOCK_STREAM, Socket::IPPROTO_TCP()) || die "could not create socket: $!";
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.
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: $!";
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";
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 |
---|
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 |
---|
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 |
---|
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 |
---|
#!/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)
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():
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)
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)
#!/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)
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 ?
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,SCALAREvent 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)
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)
#!/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)
#!/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)
#!/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)
<- First Number ? -> 15 <- Second Number ? -> 28 <- 15*28=420 <- First Number ? -> ^DWeten 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)
#!/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";
}
}