Blob Blame History Raw
# 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);

if($^O eq 'MSWin32')
{   no warnings;
    *ENOTCONN = sub() {10057};
}

$| = 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 = "";
}