Network Programming With Perl
Network Programming With Perl
Network Programming
http://kickme.to/tiger/
Network
Programming
with
Perl
Graham Barr
<gbarr@pobox.com>
Agenda
☞ TCP server/client
☞ Common problems
☞ UDP server/client
☞ Case studies
examples
☞ IO::Socket, with
examples
Slide 2
Introduction
Slide 3
Socket properties
Ä A type
Ä An address family
Ä A communication protocol
Slide 4
Socket types
Slide 5
Address families
Slide 7
The socket model
☞ The Server
Slide 8
The socket model ( cont.)
☞ The client
Slide 9
The socket model ( cont.)
Slide 10
Creating a socket
$proto = getprotobyname(’tcp’);
Slide 11
Binding the socket
Slide 12
Binding the socket ( cont.)
$port = getservbyname(’ftp’,’tcp’);
$service = getservbyport(21, ’tcp’);
☞ If you do not care which port the socket is bound to, you
can use 0 and the kernel will select a free port number.
Slide 13
Binding the socket ( cont.)
Slide 15
Listen for connections
☞ On the server side you must tell the system that you
want to wait for incoming connections. This is done with
the listen function
listen(SOCK, 10);
$proto = getprotobyname(’tcp’);
socket(SOCK, AF_INET, SOCK_STREAM, $proto)
or die "socket: $!";
$port = getservbyname(’daytime’,’tcp’);
$inaddr = inet_aton(’localhost’);
$paddr = sockaddr_in($port, $inaddr);
Slide 18
Connecting to the server ( cont.)
eval {
local $SIG{ALRM} = sub { die "Timeout" };
alarm 20; # a 20 second timeout
my $val = connect(SOCK, $paddr);
alarm 0;
$val;
} or die "connect: $!";
Slide 19
Accepting a client connection
($port,$inaddr) = sockaddr_in($peer);
$dotted_quad = inet_ntoa($inaddr);
Slide 20
example protocols
Slide 21
TCP daytime client
#!/bin/perl -w
# Example of a TCP daytime client using perl calls directly
use Socket qw(AF_INET SOCK_STREAM inet_aton sockaddr_in);
# get protocol number
$proto = getprotobyname(’tcp’);
# create the generic socket
socket(SOCK, AF_INET, SOCK_STREAM, $proto) or die "socket: $!";
# no need for bind here
# get packed address for host
$addr = inet_aton(’localhost’);
# get port number for the daytime protocol
$port = getservbyname(’daytime’, ’tcp’);
# pack the address structure for connect
$paddr = sockaddr_in($port, $addr);
Slide 22
TCP daytime client ( cont.)
# connect to host
connect(SOCK, $paddr) or die "connect: $!";
# get and print the date
print <SOCK>;
# close the socket
close(SOCK) || die "close: $!";
Slide 23
TCP daytime server
#!/bin/perl -w
# Example of a daytime TCP server using perl functions
use Socket qw(INADDR_ANY AF_INET SOMAXCONN SOCK_STREAM sockaddr_in);
# Get protocol number
my $proto = getprotobyname(’tcp’);
# Create generic socket
socket(SOCK, AF_INET, SOCK_STREAM, $proto) or die "socket: $!";
# Bind to the daytime port on any interface
my $port = getservbyname(’daytime’,’tcp’);
my $paddr = sockaddr_in($port, INADDR_ANY);
bind(SOCK, $paddr) or die "bind: $!";
# Notify the kernel we want to accept connections
listen(SOCK, SOMAXCONN) or die "listen: $!";
while(1) {
if(accept(CLIENT, SOCK)) {
print CLIENT scalar localtime, "\n";
close CLIENT;
}
}
Slide 24
Using UDP
Slide 25
Using UDP ( cont.)
Slide 26
Using UDP ( cont.)
Slide 27
UDP daytime client
#!/bin/perl -w
# Example of a daytime UDP client using perl calls directly
use Socket qw(AF_INET SOCK_DGRAM inet_aton sockaddr_in);
# get protocol number
$proto = getprotobyname(’udp’);
# create the generic socket
socket(SOCK, AF_INET, SOCK_DGRAM, $proto) or die "socket: $!";
# no need for bind here
# get packed address for host
$addr = inet_aton(’localhost’);
# get port number for the daytime protocol
$port = getservbyname(’daytime’,’udp’);
# pack the address structure for send
$paddr = sockaddr_in($port, $addr);
Slide 28
UDP daytime client ( cont.)
Slide 29
UDP daytime server
#!/bin/perl -w
# Example of a daytime UDP server using perl functions
use Socket qw(INADDR_ANY AF_INET SOMAXCONN SOCK_DGRAM sockaddr_in);
# Get protocol number
my $proto = getprotobyname(’udp’);
# Create generic socket
socket(SOCK, AF_INET, SOCK_DGRAM, $proto) or die "socket: $!";
# Bind to the daytime port on any interface
my $port = getservbyname(’daytime’,’udp’);
my $paddr = sockaddr_in($port, INADDR_ANY);
bind(SOCK, $paddr) or die "bind: $!";
# no listen() as that is a SOCK_STREAM call()
$rin = "";
vec($rin, fileno(SOCK), 1) = 1;
while (select($rout=$rin, undef, undef, undef)) {
$from = recv(SOCK, $buffer, 1, 0) or next;
send(SOCK, scalar localtime, 0, $from) || die "send: $!";
}
Slide 30
IO::Socket
Slide 31
Create a socket with IO::Socket
$sock1 = IO::Socket->new(
Domain => ’INET’, @args);
$sock2 = IO::Socket::INET->new(@args);
Slide 32
IO::Socket::INET
Slide 33
IO::Socket::INET ( cont.)
use IO::Socket;
$s = IO::Socket::INET->new(’localhost:80’)
|| die "IO::Socket: $@";
is the same as
$s = IO::Socket::INET->new(
PeerAddr => ’localhost’,
PeerPort => 80,
Proto => ’tcp’
);
Slide 34
IO::Socket TCP daytime client
#!/bin/perl -w
# Example of tcp daytime client using IO::Socket
use IO::Socket;
my $sock = IO::Socket::INET->new("localhost:daytime")
or die "IO::Socket: $@";
# Print the date
print <$sock>;
# close the socket
close($sock) || die "close: $!";
Slide 35
Finding information about a socket
$paddr = getsockname(SOCK);
($port, $ipaddr) = sockaddr_in($paddr);
$quad = inet_ntoa($ipaddr);
$paddr = getpeername(SOCK);
($path) = sockaddr_un($paddr);
Slide 36
Finding information about a socket
Slide 37
Finding information about a socket
if ($type == AF_INET) {
($port, $ipaddr) = sockaddr_in($paddr);
$quad = inet_ntoa($ipaddr);
}
elsif ($type == AF_UNIX) {
$path = sockaddr_un($paddr);
}
else {
die "Unknown address family";
}
Slide 38
Types of server
☞ Forking server
☞ Concurrent server
☞ Threaded server
Slide 39
Forking server
vec($rin = "",fileno(SERVER),1) = 1;
while (select($rout=$rin,undef,undef)) {
if(vec($rout,fileno(SERVER),1)) {
$client = gensym();
$addr = accept($client, SERVER) or next;
$client[ fileno($client) ] = $client;
vec($rin, fileno($client), 1) = 1;
}
else {
for( $loop = 0 ; $loop < @client ; $loop++) {
process_client($client[$loop])
if (vec($rout, $loop, 1));
}
}
}
Slide 41
Threaded server
use Thread::Pool;
use Symbol qw(gensym);
$pool = Thread::Pool->new;
M
die "accept: $!";
Slide 43
Common problems
☞ Output buffer
☞ Closing handles
Slide 44
Output buffer
☞ Problem
☞ Example
Slide 45
Output buffer ( cont.)
☞ Explanation
Slide 46
Output buffer ( cont.)
☞ Solution
Ä Turn on auto-flush
$ofh = select(SOCK)
$| = 1;
select($ofh);
select((select(SOCK), $|=1)[0]);
Ä Or use syswrite.
☞ The stdio functions in perl are
Slide 47
Comparing packed addresses
☞ Problem
☞ Example
Slide 48
Comparing packed addresses ( cont.)
☞ Explanation
Slide 49
Comparing packed addresses ( cont.)
☞ Solution
$addr1 = sockaddr_in(sockaddr_in($addr1));
$addr2 = sockaddr_in(sockaddr_in($addr2));
Slide 50
Closing handles
☞ Problem
or
☞ Example
Slide 51
Closing handles ( cont.)
☞ Explanation
Slide 52
Closing handles ( cont.)
☞ Solution
if($pid) {
close($client)
} else {
process_client($client);
close($client);
exit(0);
}
Slide 53
Address in use
☞ Problem
☞ Example
$addr = inet_aton($host);
$paddr = sockaddr_in($port, $addr);
Slide 54
Address in use ( cont.)
☞ Explanation
☞ Solution
Slide 56
POP3
☞ Problem
☞ Solution
Slide 57
POP3
#!/bin/perl -w
use GetOpt::Long;
use Net::POP3;
$user = $ENV{USER} || $ENV{LOGNAME};
$out = "/var/spool/mail/" . $user;
$passwd = "";
$host = "mailhost";
GetOptions(
’h:s’ => \$host,
’u:s’ => \$user,
’p:s’ => \$passwd,
’o:s’ => \$out
);
open(OUT, ">>$out") or die "open: $!";
$pop3 = Net::POP3->new($host) or die "$@";
defined( $pop3->login($user,$passwd) ) or die $pop3->message;
$count = $pop3->stat;
Slide 58
POP3
foreach $n (1..$count) {
if ($mesg = $pop3->get($n)) {
# Add the From line for the mbox file format
print OUT "From pop3get ", scalar localtime,"\n";
print OUT map { s/^From/>From/; $_ } @$mesg;
print OUT "\n";
$pop3->delete($n) or warn $pop3->message;
}
else {
warn $pop3->message;
}
}
$pop3->quit;
close(OUT);
Slide 59
FTP
☞ Problem
or
Slide 60
FTP
☞ Solution
or
Slide 61
FTP
#!/bin/perl -w
use Getopt::Long;
use Net::FTP;
GetOptions(
’h:s’ => \$host,
’u:s’ => \$user,
’p:s’ => \$passwd,
’d:s’ => \$dir,
’f:s’ => \$file,
’r’ => \$remove
);
sub fileglob_to_re {
local($_) = @_;
s#([./^\$()])#\\$1#g;
s#\?#.#g;
s#\*#.*#g;
s#\{([^}]+)\}#’(’ . join("|", split(/,/,$1)) . ’)’#ge;
"^$_\$";
}
Slide 62
FTP
Slide 63
FTP - 2
☞ Problem
Ä The files are large and you do not have space for
them locally.
Or
☞ Solution
Slide 64
FTP - 2
#!/bin/perl -w
use Getopt::Long;
use Net::FTP;
$s_user = $d_user = ’anonymous’;
GetOptions(
’src:s’ => \$src,
’dest:s’ => \$dst,
’du:s’ => \$d_user,
’dp:s’ => \$d_passwd,
’su:s’ => \$s_user,
’sp:s’ => \$s_passwd,
);
# src and dest in format ftp.host.name:/path/to/file
($s_host, $s_dir, $s_file) = $src =~ m#^([^:]+):((?:.*/)?)([^/]+)$#;
($d_host, $d_dir, $d_file) = $dst =~ m#^([^:]+):((?:.*/)?)([^/]*)$#;
$d_file = $s_file unless length $d_file;
$s_ftp = Net::FTP->new($s_host) or die "$@";
$d_ftp = Net::FTP->new($d_host) or die "$@";
Slide 65
FTP - 2
Slide 66
Security
☞ Problem
☞ Solution
Slide 67
Security
#!/bin/perl -w
use Net::Ident;
use Net::Netmask qw(fetchNetblock);
use IO::Socket;
use IO::Select;
use Proc::Daemon;
my %allow = (
’127.0.0.0/24’ => { ’*’ => 1 },
’214.123.1.0/24’ => { ’tchrist’ => 0, ’*’ => 1 },
’192.168.1.0/24’ => { ’gbarr’ => 1 },
);
foreach $mask (keys %allow) {
Net::Netmask->new($mask)->storeNetblock;
}
$sesson_id = Proc::Daemon::init;
$sock = IO::Socket::INET->new(
LocalPort => ’daytime’,
Listen => SOMAXCONN,
Proto => ’tcp’,
Reuse => 1,
) or die "$@";
Slide 68
Security
$sel = IO::Select->new($sock);
while($sel->can_read) {
$client = $sock->accept;
print $client scalar localtime,"\n"
if check_user($client);
close($client);
}
sub check_user {
my $client = shift;
$peer = $client->peerhost;
$netblock = fetchNetblock($peer);
return 0 unless ref $netblock;
$allow = $allow{ $netblock->desc };
$user = Net::Ident::lookup($client);
return $allow->{$user} if exists $allow->{$user};
return $allow->{’*’} if exists $allow->{’*’};
return 0;
}
Slide 69
Security
WARNING
Slide 70
NNTP
☞ Problem
☞ Solution
Slide 71
NNTP
#!/bin/perl -w
use Net::NNTP;
use Getopt::Long;
$since = ’1d’;
$pattern = ’*’;
$outfile = "out";
Net::NNTP->debug(1);
GetOptions(
’h:s’ => \$host,
’g:s’ => \$groups,
’p:s’ => \$pattern,
’o:s’ => \$outfile,
’s:s’ => \$since
);
%map = ( ’m’ => 60, ’h’ => 60*60, ’d’ => 60*60*24, ’w’ => 60*60*24*7);
die "Bad since: $since" unless $since =~ /^(\d+)([mhdw])$/;
$since = time - ($1 * $map{$2});
Slide 72
NNTP
Slide 73
SMTP
☞ Problem
☞ Solution
Slide 74
SMTP
#!/bin/perl -w
use Getopt::Long;
use Net::SMTP;
$host = ’mailhost’;
$from = $ENV{USER} || $ENV{LOGNAME};
$subject = "No subject!";
GetOptions(
’h:s’ => \$host,
’f:s’ => \$from,
’s:s’ => \$subject
);
die "No addresses\n" unless @ARGV;
$smtp = Net::SMTP->new($host) or die "$@";
$smtp->mail($from) or die $smtp->message;
$smtp->recipient(@ARGV) or die $smtp->message;
Slide 75
SMTP
Slide 76
CPAN Modules used
Ä authors/id/GBARR/libnet-1.0606.tar.gz
☞ Proc::Daemon
Ä authors/id/ EHOOD/Proc-Daemon-0.01.tar.gz
☞ Net::Netmask
Ä authors/id/MUIR/modules/Net-Netmask-1.4.tar.gz
☞ Net::Ident
Ä authors/id/JPC/Net-Ident-1.10.tar.gz
☞ Thread::Pool
Ä authors/id/MICB/ThreadPool-0.1.tar.gz
Slide 77
Books
☞ Perl Cookbook
Author : Tom Christiansen & Nathan Torkington
Publisher : O'Reilly & Associates
ISBN : 1-56592-243-3
Slide 78