File: 03_provided_socket.t

package info (click to toggle)
libpoe-component-client-ping-perl 1.177-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid, trixie
  • size: 148 kB
  • sloc: perl: 819; makefile: 7
file content (157 lines) | stat: -rw-r--r-- 4,209 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
#!/usr/bin/perl -w
# vim: filetype=perl ts=2 sw=2 expandtab

use strict;

sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE qw(Component::Client::Ping);

BEGIN {
  $| = 1;
  unless (POE::Component::Client::Ping->can_open_socket()) {
    print "1..0 # skipped: ICMP ping requires root privilege\n";
    exit 0;
  }
};

use Test::More tests => 2;

sub PING_TIMEOUT () { 5 }; # seconds between pings
sub PING_COUNT   () { 1 }; # ping repetitions
sub DEBUG        () { 0 }; # display more information

#------------------------------------------------------------------------------
# A bunch of addresses to ping.

my @addresses = qw(
  127.0.0.1 209.34.66.60 216.127.84.31 216.132.181.250 216.132.181.251
  64.106.159.160 64.127.105.9 64.235.246.143 64.38.255.150
  66.207.163.5 66.33.204.143
);

#------------------------------------------------------------------------------
# This session uses the ping component to resolve things.

sub client_start {
  my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];

  DEBUG and warn($session->ID, ": starting pinger client session...\n");

  # Set up recording.
  $heap->{requests}    = 0;
  $heap->{answers}     = 0;
  $heap->{dones}       = 0;
  $heap->{ping_counts} = { };

  # Start pinging.
  foreach my $address (@addresses) {
    $heap->{ping_counts}->{$address} = 0;
    $kernel->call( $session, ping => $address );
  }
}

sub client_send_ping {
  my ($kernel, $session, $heap, $address) = @_[KERNEL, SESSION, HEAP, ARG0];

  DEBUG and warn( $session->ID, ": pinging $address...\n" );

  $heap->{requests}++;
  $heap->{ping_counts}->{$address}++;
  $kernel->post(
    'pinger',     # Post the request to the 'pinger'.
    'ping',       # Ask it to 'ping' an address.
    'pong',       # Have it post an answer to my 'pong' state.
    $address,     # This is the address we want it to ping.
    PING_TIMEOUT  # This is the optional time to wait.
  );
}

sub client_got_pong {
  my ($kernel, $session, $heap, $request_packet, $response_packet) =
    @_[KERNEL, SESSION, HEAP, ARG0, ARG1];

  my ($request_address, $request_timeout, $request_time) = @{$request_packet};
  my (
    $response_address, $roundtrip_time, $reply_time, $reply_ttl
  ) = @{$response_packet};

  if (defined $response_address) {
    DEBUG and warn(
      sprintf(
        "%d: ping to %-15.15s at %10d. " .
        "pong from %-15.15s in %6.3f s (ttl %3d)\n",
        $session->ID,
        $request_address, $request_time,
        $response_address, $roundtrip_time, $reply_ttl,
      )
    );

    $heap->{answers}++ if $roundtrip_time <= $request_timeout;
    $heap->{bad_ttl}++ if (
      $reply_ttl !~ /^\d+$/ or
      $reply_ttl < 0 or
      $reply_ttl > 255
    );
  }
  else {
    DEBUG and warn( $session->ID, ": time's up for $request_address...\n" );

    $kernel->yield(ping => $request_address) if (
      $heap->{ping_counts}->{$request_address} < PING_COUNT
    );

    $heap->{dones}++;
  }
}

sub client_stop {
  my ($session, $heap) = @_[SESSION, HEAP];
  DEBUG and warn( $session->ID, ": pinger client session stopped...\n" );

  ok(
    (
      $heap->{requests} == $heap->{dones}
      && $heap->{answers}
      && !$heap->{bad_ttl}
    ),
    "pinger client session got responses"
  );
}

#------------------------------------------------------------------------------

# Create a raw socket externally for the component to use.

use Symbol qw(gensym);
use Socket;

my $protocol = Socket::IPPROTO_ICMP;

my $socket = gensym();
socket($socket, PF_INET, SOCK_RAW, $protocol)
  or die "can't create icmp socket: $!";

# Create a pinger component.
POE::Component::Client::Ping->spawn(
  Alias   => 'pinger',     # This is the name it'll be known by.
  Timeout => PING_TIMEOUT, # This is how long it waits for echo replies.
  Socket => $socket,
);

# Create two sessions that will use the pinger.  This tests
# concurrency against the same addresses.
for (my $session_index = 0; $session_index < 2; $session_index++) {
  POE::Session->create(
    inline_states => {
      _start => \&client_start,
      _stop  => \&client_stop,
      pong   => \&client_got_pong,
      ping   => \&client_send_ping,
    }
  );
}

# Run it all until done.
POE::Kernel->run();

exit;