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