… | |
… | |
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.12'; |
31 | our $VERSION = '1.15'; |
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 | |
… | |
… | |
43 | |
42 | |
44 | our $THR_REQ_FH; open $THR_REQ_FH, ">&=$THR_REQ_FD" or die "FATAL: cannot fdopen"; |
43 | 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"; |
44 | our $THR_RES_FH; open $THR_RES_FH, "<&=$THR_RES_FD" or die "FATAL: cannot fdopen"; |
46 | |
45 | |
47 | our $THR_REQ_W; |
46 | our $THR_REQ_W; |
48 | our $THR_RES_W = AnyEvent->io (fh => $THR_RES_FH, poll => 'r', cb => sub { |
47 | our $THR_RES_W = AE::io $THR_RES_FH, 0, sub { |
49 | my $sv = _read_res |
48 | my $sv = _read_res |
50 | or return; |
49 | or return; |
51 | |
50 | |
52 | $sv->(); |
51 | $sv->(); |
53 | }); |
52 | }; |
54 | |
53 | |
55 | our $THR_REQ_BUF; |
54 | our $THR_REQ_BUF; |
56 | |
55 | |
57 | sub _send_req($) { |
56 | sub _send_req($) { |
58 | $THR_REQ_BUF .= $_[0]; |
57 | $THR_REQ_BUF .= $_[0]; |
59 | |
58 | |
60 | $THR_REQ_W ||= AnyEvent->io (fh => $THR_REQ_FH, poll => 'w', cb => sub { |
59 | $THR_REQ_W ||= AE::io $THR_REQ_FH, 1, sub { |
61 | my $len = syswrite $THR_REQ_FH, $THR_REQ_BUF; |
60 | my $len = syswrite $THR_REQ_FH, $THR_REQ_BUF; |
62 | substr $THR_REQ_BUF, 0, $len, ""; |
61 | substr $THR_REQ_BUF, 0, $len, ""; |
63 | |
62 | |
64 | undef $THR_REQ_W unless length $THR_REQ_BUF; |
63 | undef $THR_REQ_W unless length $THR_REQ_BUF; |
65 | }); |
64 | }; |
66 | } |
65 | } |
67 | |
66 | |
68 | =item AnyEvent::FastPing::ipv4_supported |
67 | =item AnyEvent::FastPing::ipv4_supported |
69 | |
68 | |
70 | Returns true if IPv4 is supported in this module and on this system. |
69 | Returns true if IPv4 is supported in this module and on this system. |
… | |
… | |
144 | |
143 | |
145 | sub icmp_ping($$$&) { |
144 | sub icmp_ping($$$&) { |
146 | _send_req _req_icmp_ping @_; |
145 | _send_req _req_icmp_ping @_; |
147 | } |
146 | } |
148 | |
147 | |
149 | our $ICMP4_FH; |
148 | our $ICMP4_FH; our $ICMP4_W = $ICMP4_FD >= 0 && (open $ICMP4_FH, "<&=$ICMP4_FD") && AE::io $ICMP4_FH, 0, \&_recv_icmp4; |
150 | our $ICMP4_W = (open $ICMP4_FH, "<&=$ICMP4_FD") && AnyEvent->io (fh => $ICMP4_FH, poll => 'r', cb => \&_recv_icmp4); |
149 | our $ICMP6_FH; our $ICMP6_W = $ICMP6_FD >= 0 && (open $ICMP6_FH, "<&=$ICMP6_FD") && AE::io $ICMP6_FH, 0, \&_recv_icmp6; |
151 | our $ICMP6_FH; |
|
|
152 | our $ICMP6_W = (open $ICMP6_FH, "<&=$ICMP6_FD") && AnyEvent->io (fh => $ICMP6_FH, poll => 'r', cb => \&_recv_icmp6); |
|
|
153 | |
150 | |
154 | =item AnyEvent::FastPing::register_cb \&cb |
151 | =item AnyEvent::FastPing::register_cb \&cb |
155 | |
152 | |
156 | Register a callback that is called for every received ping reply |
153 | 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 |
154 | (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 |
158 | entry for each received packet (replies are being batched for greater |
162 | efficiency). Each packet is represented by an arrayref with three members: |
159 | 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 |
160 | 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 |
161 | length), the payload as passed to C<icmp_ping> and the round trip time in |
165 | seconds. |
162 | seconds. |
|
|
163 | |
|
|
164 | Example: register a callback which simply dumps the received data. Since |
|
|
165 | the coderef is created on the fly via sub, it would be hard to unregister |
|
|
166 | this callback again :) |
|
|
167 | |
|
|
168 | AnyEvent::FastPing::register_cb sub { |
|
|
169 | for (@{$_[0]}) { |
|
|
170 | printf "%s %d %g\n", |
|
|
171 | (4 == length $_->[0] ? inet_ntoa $_->[0] : Socket6::inet_ntop (&AF_INET6, $_->[0])), |
|
|
172 | $_->[2], |
|
|
173 | $_->[1]; |
|
|
174 | } |
|
|
175 | }; |
166 | |
176 | |
167 | Example: a single ping reply with payload of 1 from C<::1> gets passed |
177 | Example: a single ping reply with payload of 1 from C<::1> gets passed |
168 | like this: |
178 | like this: |
169 | |
179 | |
170 | [ [ |
180 | [ [ |
… | |
… | |
196 | |
206 | |
197 | =cut |
207 | =cut |
198 | |
208 | |
199 | our @CB; |
209 | our @CB; |
200 | |
210 | |
201 | sub register_cb(&) { |
211 | sub register_cb($) { |
202 | push @CB, $_[0]; |
212 | push @CB, $_[0]; |
203 | } |
213 | } |
204 | |
214 | |
205 | sub unregister_cb($) { |
215 | sub unregister_cb($) { |
206 | @CB = grep $_ != $_[0], @CB; |
216 | @CB = grep $_ != $_[0], @CB; |