|
Packit |
7ef13a |
# Test using UDP with two IO::Multiplex
|
|
Packit |
7ef13a |
# servers communicating with each other.
|
|
Packit |
7ef13a |
# Assume no UDP packet loss on loopback.
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
# This script tests the following:
|
|
Packit |
7ef13a |
# 1) Sending packets using a connected UDP socket.
|
|
Packit |
7ef13a |
# (connect() and send() syscalls)
|
|
Packit |
7ef13a |
# 2) Sending packets using unconnected UDP socket.
|
|
Packit |
7ef13a |
# (sendto() syscall)
|
|
Packit |
7ef13a |
# 3) Receiving UDP packets.
|
|
Packit |
7ef13a |
# (bind() and recv() syscalls)
|
|
Packit |
7ef13a |
# 4) The tied handle interface to send UDP data.
|
|
Packit |
7ef13a |
# print $fh $UDP_data;
|
|
Packit |
7ef13a |
# 5) The mux_input interface for incoming UDP data.
|
|
Packit |
7ef13a |
# (simple $$data scalar consumption)
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
use strict;
|
|
Packit |
7ef13a |
use Test;
|
|
Packit |
7ef13a |
use IO::Socket;
|
|
Packit |
7ef13a |
use IO::Multiplex;
|
|
Packit |
7ef13a |
use POSIX qw(ENOTCONN EDESTADDRREQ);
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
if($^O eq 'MSWin32')
|
|
Packit |
7ef13a |
{ no warnings;
|
|
Packit |
7ef13a |
*ENOTCONN = sub() {10057};
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
$| = 1;
|
|
Packit |
7ef13a |
plan tests => 15;
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
# Create a recv()ing socket.
|
|
Packit |
7ef13a |
ok my $sock1 = new IO::Socket::INET
|
|
Packit |
7ef13a |
LocalAddr => "127.0.0.1",
|
|
Packit |
7ef13a |
Proto => "udp",
|
|
Packit |
7ef13a |
or die $!;
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
my $magic_port = $sock1->sockport;
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
# Create connect()ed socket for send()ing.
|
|
Packit |
7ef13a |
ok my $sock2 = new IO::Socket::INET
|
|
Packit |
7ef13a |
PeerAddr => "127.0.0.1",
|
|
Packit |
7ef13a |
PeerPort => $magic_port,
|
|
Packit |
7ef13a |
Proto => "udp",
|
|
Packit |
7ef13a |
or die $!;
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
# Create a generic unconnected socket for sendto()ing.
|
|
Packit |
7ef13a |
ok my $sock3 = new IO::Socket::INET
|
|
Packit |
7ef13a |
Proto => "udp"
|
|
Packit |
7ef13a |
or die $!;
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
my $msg1 = "uno";
|
|
Packit |
7ef13a |
my $msg2 = "dos";
|
|
Packit |
7ef13a |
my $msg3 = "tres";
|
|
Packit |
7ef13a |
my $msg4 = "cuatro";
|
|
Packit |
7ef13a |
my $msg5 = "cinco";
|
|
Packit |
7ef13a |
my $msg6 = "seis";
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
my $pid = fork();
|
|
Packit |
7ef13a |
# Catch runaway processes just in case...
|
|
Packit |
7ef13a |
alarm(10);
|
|
Packit |
7ef13a |
$SIG{ALRM} = sub {
|
|
Packit |
7ef13a |
die "[$$] Got bored";
|
|
Packit |
7ef13a |
};
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
if (!defined $pid) {
|
|
Packit |
7ef13a |
ok 0;
|
|
Packit |
7ef13a |
die "fork: $!";
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
if ($pid) {
|
|
Packit |
7ef13a |
# Parent process
|
|
Packit |
7ef13a |
# This will be the Pitcher IO::Multiplex server.
|
|
Packit |
7ef13a |
my $plexer = new IO::Multiplex;
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
$plexer->add($sock2);
|
|
Packit |
7ef13a |
$plexer->add($sock3);
|
|
Packit |
7ef13a |
$plexer->set_callback_object("Pitcher");
|
|
Packit |
7ef13a |
# Set timer to do mux_timeout in 2 seconds
|
|
Packit |
7ef13a |
$plexer->set_timeout($sock2, 2);
|
|
Packit |
7ef13a |
$plexer->loop;
|
|
Packit |
7ef13a |
ok 1;
|
|
Packit |
7ef13a |
exit;
|
|
Packit |
7ef13a |
} else {
|
|
Packit |
7ef13a |
# Child process
|
|
Packit |
7ef13a |
# This will be the Catcher IO::Multiplex server.
|
|
Packit |
7ef13a |
# (No talking allowed.)
|
|
Packit |
7ef13a |
my $plexer = new IO::Multiplex;
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
$plexer->add($sock1);
|
|
Packit |
7ef13a |
$plexer->set_callback_object("Catcher");
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
$plexer->loop;
|
|
Packit |
7ef13a |
exit;
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
sub Pitcher::mux_timeout {
|
|
Packit |
7ef13a |
my $self = shift;
|
|
Packit |
7ef13a |
my $mux = shift;
|
|
Packit |
7ef13a |
my $fh = shift;
|
|
Packit |
7ef13a |
if (fileno $fh == fileno $sock2) {
|
|
Packit |
7ef13a |
ok 1;
|
|
Packit |
7ef13a |
# Connected UDP socket should know where to send it
|
|
Packit |
7ef13a |
print $fh $msg1;
|
|
Packit |
7ef13a |
ok !$!;
|
|
Packit |
7ef13a |
} elsif (fileno $fh == fileno $sock3) {
|
|
Packit |
7ef13a |
ok 1;
|
|
Packit |
7ef13a |
# Unconnected UDP socket should fail
|
|
Packit |
7ef13a |
# when trying to send() a packet.
|
|
Packit |
7ef13a |
$! = 0;
|
|
Packit |
7ef13a |
print $fh $msg2;
|
|
Packit |
7ef13a |
ok ($! == ENOTCONN || $! == EDESTADDRREQ)
|
|
Packit |
7ef13a |
or warn "DEBUG: bang = [$!](".($!+0).")";
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
# Grab the real peer destination.
|
|
Packit |
7ef13a |
ok my $saddr = $mux->{_fhs}{$sock2}{udp_peer};
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
# Unconnected UDP socket will sendto() just fine
|
|
Packit |
7ef13a |
# but only with an explicit destination.
|
|
Packit |
7ef13a |
ok send($fh, $msg3, 0, $saddr);
|
|
Packit |
7ef13a |
ok !$!;
|
|
Packit |
7ef13a |
} else {
|
|
Packit |
7ef13a |
die "$$: Not my fh?";
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
sub Pitcher::mux_input {
|
|
Packit |
7ef13a |
my $package = shift;
|
|
Packit |
7ef13a |
my $mux = shift;
|
|
Packit |
7ef13a |
my $fh = shift;
|
|
Packit |
7ef13a |
my $data = shift;
|
|
Packit |
7ef13a |
if (fileno $fh == fileno $sock2) {
|
|
Packit |
7ef13a |
ok ($$data eq $msg2);
|
|
Packit |
7ef13a |
$mux->set_timeout($sock3, 3);
|
|
Packit |
7ef13a |
} elsif (fileno $fh == fileno $sock3) {
|
|
Packit |
7ef13a |
if ($$data eq $msg4) {
|
|
Packit |
7ef13a |
ok 1;
|
|
Packit |
7ef13a |
# Even though this was the unconnected socket,
|
|
Packit |
7ef13a |
# it should remember where the last packer came from.
|
|
Packit |
7ef13a |
print $fh $msg5;
|
|
Packit |
7ef13a |
ok !$!;
|
|
Packit |
7ef13a |
} elsif ($$data eq $msg6) {
|
|
Packit |
7ef13a |
# Yippy, caught the final packet
|
|
Packit |
7ef13a |
ok 1;
|
|
Packit |
7ef13a |
# All done
|
|
Packit |
7ef13a |
$mux->endloop;
|
|
Packit |
7ef13a |
} else {
|
|
Packit |
7ef13a |
die "sock3 caught weird [$$data]";
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
} else {
|
|
Packit |
7ef13a |
die "$$: Pitcher found something weird [$$data]";
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
$$data = "";
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
|
|
Packit |
7ef13a |
# Just bounce it back with one up
|
|
Packit |
7ef13a |
sub Catcher::mux_input {
|
|
Packit |
7ef13a |
my $package = shift;
|
|
Packit |
7ef13a |
my $mux = shift;
|
|
Packit |
7ef13a |
my $fh = shift;
|
|
Packit |
7ef13a |
my $data = shift;
|
|
Packit |
7ef13a |
if ($$data eq $msg1) {
|
|
Packit |
7ef13a |
print $fh $msg2;
|
|
Packit |
7ef13a |
} elsif ($$data eq $msg3) {
|
|
Packit |
7ef13a |
print $fh $msg4;
|
|
Packit |
7ef13a |
} elsif ($$data eq $msg5) {
|
|
Packit |
7ef13a |
print $fh $msg6;
|
|
Packit |
7ef13a |
# I'm done.
|
|
Packit |
7ef13a |
$mux->endloop;
|
|
Packit |
7ef13a |
} else {
|
|
Packit |
7ef13a |
die "$$: Caught something weird [$$data]";
|
|
Packit |
7ef13a |
}
|
|
Packit |
7ef13a |
$$data = "";
|
|
Packit |
7ef13a |
}
|