… | |
… | |
21 | |
21 | |
22 | =cut |
22 | =cut |
23 | |
23 | |
24 | package AnyEvent::FastPing; |
24 | package AnyEvent::FastPing; |
25 | |
25 | |
26 | use strict; |
26 | use common::sense; |
27 | no warnings; |
|
|
28 | |
27 | |
29 | use AnyEvent; |
28 | use AnyEvent; |
30 | |
29 | |
31 | BEGIN { |
30 | BEGIN { |
32 | our $VERSION = '1.11'; |
31 | our $VERSION = '2.0'; |
33 | our @ISA = qw(Exporter); |
32 | our @ISA = qw(Exporter); |
34 | |
33 | |
35 | require Exporter; |
34 | require Exporter; |
36 | #Exporter::export_ok_tags (keys %EXPORT_TAGS); |
35 | #Exporter::export_ok_tags (keys %EXPORT_TAGS); |
37 | |
36 | |
38 | require XSLoader; |
37 | require XSLoader; |
39 | XSLoader::load (__PACKAGE__, $VERSION); |
38 | XSLoader::load (__PACKAGE__, $VERSION); |
40 | } |
39 | } |
41 | |
40 | |
42 | our ($THR_REQ_FD, $THR_RES_FD, $ICMP4_FD, $ICMP6_FD); |
41 | our ($THR_RES_FD, $ICMP4_FD, $ICMP6_FD); |
43 | |
42 | |
44 | our $THR_REQ_FH; open $THR_REQ_FH, ">&=$THR_REQ_FD" or die "FATAL: cannot fdopen"; |
|
|
45 | our $THR_RES_FH; open $THR_RES_FH, "<&=$THR_RES_FD" or die "FATAL: cannot fdopen"; |
43 | our $THR_RES_FH; open $THR_RES_FH, "<&=$THR_RES_FD" or die "FATAL: cannot fdopen"; |
46 | |
44 | |
47 | our $THR_REQ_W; |
45 | our $ICMP4_FH; our $ICMP4_W = $ICMP4_FD >= 0 && (open $ICMP4_FH, "<&=$ICMP4_FD") && AE::io $ICMP4_FH, 0, \&_recv_icmp4; |
48 | our $THR_RES_W = AnyEvent->io (fh => $THR_RES_FH, poll => 'r', cb => sub { |
46 | our $ICMP6_FH; our $ICMP6_W = $ICMP6_FD >= 0 && (open $ICMP6_FH, "<&=$ICMP6_FD") && AE::io $ICMP6_FH, 0, \&_recv_icmp6; |
49 | my $sv = _read_res |
|
|
50 | or return; |
|
|
51 | |
47 | |
52 | $sv->(); |
48 | =item AnyEvent::FastPing::ipv4_supported |
|
|
49 | |
|
|
50 | Returns true if IPv4 is supported in this module and on this system. |
|
|
51 | |
|
|
52 | =item AnyEvent::FastPing::ipv6_supported |
|
|
53 | |
|
|
54 | Returns true if IPv6 is supported in this module and on this system. |
|
|
55 | |
|
|
56 | =item AnyEvent::FastPing::icmp4_pktsize |
|
|
57 | |
|
|
58 | Returns the number of bytes each IPv4 ping packet has. |
|
|
59 | |
|
|
60 | =item AnyEvent::FastPing::icmp6_pktsize |
|
|
61 | |
|
|
62 | Returns the number of bytes each IPv4 ping packet has. |
|
|
63 | |
|
|
64 | =cut |
|
|
65 | |
|
|
66 | sub new { |
|
|
67 | my ($klass) = @_; |
|
|
68 | |
|
|
69 | _new $klass, (rand 65536), (rand 65536), (rand 65536) |
|
|
70 | } |
|
|
71 | |
|
|
72 | our @IDLE_CB; |
|
|
73 | |
|
|
74 | sub DESTROY { |
|
|
75 | undef $IDLE_CB[ &id ]; |
|
|
76 | &_free; |
|
|
77 | } |
|
|
78 | |
|
|
79 | sub on_idle { |
|
|
80 | $IDLE_CB[ &id ] = $_[1]; |
|
|
81 | } |
|
|
82 | |
|
|
83 | our $THR_RES_W = AE::io $THR_RES_FH, 0, sub { |
|
|
84 | sysread $THR_RES_FH, my $buf, 8; |
|
|
85 | |
|
|
86 | for my $id (unpack "S*", $buf) { |
|
|
87 | _stop_id $id; |
|
|
88 | ($IDLE_CB[$id] || sub { })->(); |
|
|
89 | } |
|
|
90 | }; |
|
|
91 | |
|
|
92 | for(1..10) { |
|
|
93 | my $p = new AnyEvent::FastPing;#d# |
|
|
94 | $p->interval (0); |
|
|
95 | $p->max_rtt (0.5); |
|
|
96 | #$p->add_range (v127.0.0.1, v127.255.255.254, 0); |
|
|
97 | $p->add_range (v127.0.0.1, v127.0.0.1, 0); |
|
|
98 | #$p->add_range (v1.0.0.1, v1.255.255.254, 0); |
|
|
99 | $p->on_idle (my $cv = AE::cv); |
|
|
100 | my $cnt; |
|
|
101 | $p->on_recv (sub { |
|
|
102 | $cnt++; |
53 | }); |
103 | }); |
|
|
104 | $p->start; |
54 | |
105 | |
55 | our $THR_REQ_BUF; |
106 | { |
56 | |
107 | my $p = new AnyEvent::FastPing;#d# |
57 | sub _send_req($) { |
108 | $p->interval (0); |
58 | $THR_REQ_BUF .= $_[0]; |
109 | $p->max_rtt (0.5); |
59 | |
110 | $p->add_hosts ([v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.2, (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1)x8, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.3], 0); |
60 | $THR_REQ_W ||= AnyEvent->io (fh => $THR_REQ_FH, poll => 'w', cb => sub { |
111 | my $cnt; |
61 | my $len = syswrite $THR_REQ_FH, $THR_REQ_BUF; |
112 | $p->on_recv (sub { |
62 | substr $THR_REQ_BUF, 0, $len, ""; |
113 | use Data::Dump; ddx \@_; |
63 | |
|
|
64 | undef $THR_REQ_W unless length $THR_REQ_BUF; |
|
|
65 | }); |
114 | }); |
|
|
115 | $p->on_idle (sub { |
|
|
116 | undef $p; |
|
|
117 | }); |
|
|
118 | $p->start; |
66 | } |
119 | } |
67 | |
120 | |
68 | =item AnyEvent::FastPing::ipv4_supported |
121 | $cv->recv; |
69 | |
122 | warn $cnt; |
70 | Returns true if IPv4 is supported in this module and on this system. |
123 | } |
71 | |
|
|
72 | =item AnyEvent::FastPing::ipv6_supported |
|
|
73 | |
|
|
74 | Returns true if IPv6 is supported in this module and on this system. |
|
|
75 | |
|
|
76 | =item AnyEvent::FastPing::icmp4_pktsize |
|
|
77 | |
|
|
78 | Returns the number of bytes each IPv4 ping packet has. |
|
|
79 | |
|
|
80 | =item AnyEvent::FastPing::icmp6_pktsize |
|
|
81 | |
|
|
82 | Returns the number of bytes each IPv4 ping packet has. |
|
|
83 | |
124 | |
84 | =item AnyEvent::FastPing::icmp_ping [ranges...], $send_interval, $payload, \&callback |
125 | =item AnyEvent::FastPing::icmp_ping [ranges...], $send_interval, $payload, \&callback |
85 | |
126 | |
86 | Ping the given IPv4 address ranges. Each range is an arrayref of the |
127 | Ping the given IPv4 address ranges. Each range is an arrayref of the |
87 | form C<[lo, hi, interval]>, where C<lo> and C<hi> are octet strings with |
128 | form C<[lo, hi, interval]>, where C<lo> and C<hi> are octet strings with |
… | |
… | |
141 | $done->wait; |
182 | $done->wait; |
142 | |
183 | |
143 | =cut |
184 | =cut |
144 | |
185 | |
145 | sub icmp_ping($$$&) { |
186 | sub icmp_ping($$$&) { |
146 | _send_req _req_icmp_ping @_; |
187 | # _send_req _req_icmp_ping @_; |
147 | } |
188 | } |
148 | |
|
|
149 | our $ICMP4_FH; |
|
|
150 | our $ICMP4_W = (open $ICMP4_FH, "<&=$ICMP4_FD") && AnyEvent->io (fh => $ICMP4_FH, poll => 'r', cb => \&_recv_icmp4); |
|
|
151 | our $ICMP6_FH; |
|
|
152 | our $ICMP6_W = (open $ICMP6_FH, "<&=$ICMP6_FD") && AnyEvent->io (fh => $ICMP6_FH, poll => 'r', cb => \&_recv_icmp6); |
|
|
153 | |
189 | |
154 | =item AnyEvent::FastPing::register_cb \&cb |
190 | =item AnyEvent::FastPing::register_cb \&cb |
155 | |
191 | |
156 | Register a callback that is called for every received ping reply |
192 | Register a callback that is called for every received ping reply |
157 | (regardless of whether a ping is still in process or not and regardless of |
193 | (regardless of whether a ping is still in process or not and regardless of |
… | |
… | |
161 | entry for each received packet (replies are being batched for greater |
197 | entry for each received packet (replies are being batched for greater |
162 | efficiency). Each packet is represented by an arrayref with three members: |
198 | efficiency). Each packet is represented by an arrayref with three members: |
163 | the source address (an octet string of either 4 (IPv4) or 16 (IPv6) octets |
199 | the source address (an octet string of either 4 (IPv4) or 16 (IPv6) octets |
164 | length), the payload as passed to C<icmp_ping> and the round trip time in |
200 | length), the payload as passed to C<icmp_ping> and the round trip time in |
165 | seconds. |
201 | seconds. |
|
|
202 | |
|
|
203 | Example: register a callback which simply dumps the received data. Since |
|
|
204 | the coderef is created on the fly via sub, it would be hard to unregister |
|
|
205 | this callback again :) |
|
|
206 | |
|
|
207 | AnyEvent::FastPing::register_cb sub { |
|
|
208 | for (@{$_[0]}) { |
|
|
209 | printf "%s %d %g\n", |
|
|
210 | (4 == length $_->[0] ? inet_ntoa $_->[0] : Socket6::inet_ntop (&AF_INET6, $_->[0])), |
|
|
211 | $_->[2], |
|
|
212 | $_->[1]; |
|
|
213 | } |
|
|
214 | }; |
166 | |
215 | |
167 | Example: a single ping reply with payload of 1 from C<::1> gets passed |
216 | Example: a single ping reply with payload of 1 from C<::1> gets passed |
168 | like this: |
217 | like this: |
169 | |
218 | |
170 | [ [ |
219 | [ [ |
… | |
… | |
196 | |
245 | |
197 | =cut |
246 | =cut |
198 | |
247 | |
199 | our @CB; |
248 | our @CB; |
200 | |
249 | |
201 | sub register_cb(&) { |
250 | sub register_cb($) { |
202 | push @CB, $_[0]; |
251 | push @CB, $_[0]; |
203 | } |
252 | } |
204 | |
253 | |
205 | sub unregister_cb($) { |
254 | sub unregister_cb($) { |
206 | @CB = grep $_ != $_[0], @CB; |
255 | @CB = grep $_ != $_[0], @CB; |