Blame t/200_udp.t

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
}