1.参照AnyEvent::Ping修改模块AnyEvent::Ping6
package AnyEvent::Ping6;
#use 5.008_001;
use 5.014; #need socket version of perl 5.14
use strict;
use warnings;
our $VERSION = 0.001; #new version num
#use Socket qw/SOCK_RAW SOCK_NONBLOCK PF_INET6 AF_INET6 SOCK_STREAM pack_sockaddr_in6 inet_pton/; #support ipv6
use Time::HiRes 'time';
use IO::Socket::IP qw/SOCK_RAW PF_INET6 AF_INET6 pack_sockaddr_in6 inet_pton/;
#use IO::Socket::INET qw/sockaddr_in inet_aton/;
use List::Util ();
use AnyEvent::Handle;
require Carp;
#my $ICMP_PING = 'ccnnnA*';
my $ICMP_PING = 'CcnnnA*'; #C means unsigned char,supporting 128,129.
#my $ICMP_ECHOREPLY = 0; # Echo Reply
my $ICMP_ECHOREPLY = 129; # Echo Reply of icmpv6
my $ICMP_DEST_UNREACH = 3; # Destination Unreachable
my $ICMP_SOURCE_QUENCH = 4; # Source Quench
my $ICMP_REDIRECT = 5; # Redirect (change route)
#my $ICMP_ECHO = 8; # Echo Request
my $ICMP_ECHO = 128; # Echo Request of icmpv6
my $ICMP_TIME_EXCEEDED = 11; # Time Exceeded
sub new {
my ($class, %args) = @_;
my $interval = $args{interval};
$interval = 0.2 unless defined $interval;
my $timeout = $args{timeout};
$timeout = 5 unless defined $timeout;
my $self = bless {interval => $interval, timeout => $timeout}, $class;
# Create RAW socket
my $socket = IO::Socket::IP->new(
Family => PF_INET6,
Proto => 58, #IPPROTO_ICMPV6 = 58
Type => SOCK_RAW,
Blocking => 0
) or Carp::croak "Unable to create icmp socket : $!";
$self->{_socket} = $socket;
# Create Poll object
$self->{_poll_read} = AnyEvent->io(
fh => $socket,
poll => 'r',
cb => sub { $self->_on_read },
);
# Ping tasks
$self->{_tasks} = [];
$self->{_tasks_out} = [];
return $self;
}
sub interval { @_ > 1 ? $_[0]->{interval} = $_[1] : $_[0]->{interval} }
sub timeout { @_ > 1 ? $_[0]->{timeout} = $_[1] : $_[0]->{timeout} }
sub error { $_[0]->{error} }
sub ping {
my ($self, $host, $times, $cb) = @_;
my $socket = $self->{_socket};
#my $ip = inet_aton($host);
my $ip = inet_pton(AF_INET6,$host); #ipv6 addr,16bytes
my $request = {
host => $host,
times => $times,
results => [],
cb => $cb,
identifier => int(rand 0x10000), #may collision?
#destination => scalar sockaddr_in(0, $ip),
destination => scalar pack_sockaddr_in6(0, $ip), #$sockaddr = pack_sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]]
};
push @{$self->{_tasks}}, $request;
push @{$self->{_tasks_out}}, $request;
$self->_add_write_poll;
return $self;
}
sub _add_write_poll {
my $self = shift;
return if exists $self->{_poll_write};
$self->{_poll_write} = AnyEvent->io(
fh => $self->{_socket},
poll => 'w',
cb => sub { $self->_send_requests },
);
}
sub _send_requests {
my $self = shift;
foreach my $request (@{$self->{_tasks_out}}) {
$self->_send_request($request);
}
$self->{_tasks_out} = [];
delete $self->{_poll_write};
}
sub _on_read {
my $self = shift;
my $socket = $self->{_socket};
$socket->sysread(my $chunk, 4194304, 0);
#ipv4
#my $icmp_msg = substr $chunk, 20;
#ipv6 参考ping.py.v6少了20byte的头
my $icmp_msg = substr $chunk, 0;
my ($type, $identifier, $sequence, $data);
#$type = unpack 'c', $icmp_msg;
$type = unpack 'C', $icmp_msg;
#print ("====got type=$type.\n");
if ($type == $ICMP_ECHOREPLY) {
($type, $identifier, $sequence, $data) =
(unpack $ICMP_PING, $icmp_msg)[0, 3, 4, 5];
}
elsif ($type == $ICMP_DEST_UNREACH || $type == $ICMP_TIME_EXCEEDED) {
($identifier, $sequence) = unpack('nn', substr($chunk, 52));
}
else {
# Don't mind
return;
}
# Find our task
my $request =
List::Util::first { $identifier == $_->{identifier} }
@{$self->{_tasks}};
return unless $request;
# Is it response to our latest message?
return unless $sequence == @{$request->{results}} + 1;
if ($type == $ICMP_ECHOREPLY) {
# Check data
if ($data eq $request->{data}) {
$self->_store_result($request, 'OK');
}
else {
$self->_store_result($request, 'MALFORMED');
}
}
elsif ($type == $ICMP_DEST_UNREACH) {
$self->_store_result($request, 'DEST_UNREACH');
}
elsif ($type == $ICMP_TIME_EXCEEDED) {
$self->_store_result($request, 'TIMEOUT');
}
}
sub _store_result {
my ($self, $request, $result) = @_;
my $results = $request->{results};
# Clear request specific data
delete $request->{timer};
push @$results, [$result, time - $request->{start}];
if (@$results == $request->{times} || $result eq 'ERROR') {
# Cleanup
my $tasks = $self->{_tasks};
for my $i (0 .. scalar @$tasks) {
if ($tasks->[$i] == $request) {
splice @$tasks, $i, 1;
last;
}
}
# Testing done
$request->{cb}->($results);
undef $request;
}
# Perform another check
else {
# Setup interval timer before next request
my $w;
$w = AnyEvent->timer(
after => $self->interval,
cb => sub {
undef $w;
push @{$self->{_tasks_out}}, $request;
$self->_add_write_poll;
}
);
}
}
sub _send_request {
my ($self, $request) = @_;
my $checksum = 0x0000;
my $identifier = $request->{identifier};
my $sequence = @{$request->{results}} + 1;
my $data = 'abcdef'; #test payload.should store starttime better.
my $msg = pack $ICMP_PING,
$ICMP_ECHO, 0x00, $checksum,
$identifier, $sequence, $data;
$checksum = $self->_icmp_checksum($msg);
$msg = pack $ICMP_PING,
$ICMP_ECHO, 0x00, $checksum,
$identifier, $sequence, $data;
$request->{data} = $data;
$request->{start} = time;
$request->{timer} = AnyEvent->timer(
after => $self->timeout,
cb => sub {
$self->_store_result($request, 'TIMEOUT');
}
);
my $socket = $self->{_socket};
$socket->send($msg, 0, $request->{destination}) or
$self->_store_result($request, "ERROR($!)");
}
sub _icmp_checksum {
my ($self, $msg) = @_;
my $res = 0;
foreach my $int (unpack "n*", $msg) {
$res += $int;
}
# Add possible odd byte
$res += unpack('C', substr($msg, -1, 1)) << 8
if length($msg) % 2;
# Fold high into low
$res = ($res >> 16) + ($res & 0xffff);
# Two times
$res = ($res >> 16) + ($res & 0xffff);
return ~$res;
}
1;
__END__
=head1 NAME
AnyEvent::Ping - ping hosts with AnyEvent
=head1 SYNOPSIS
use AnyEvent;
use AnyEvent::Ping;
my $c = AnyEvent->condvar;
my $ping = AnyEvent::Ping->new;
$ping->ping('google.com', 1, sub {
my $result = shift;
print "Result: ", $result->[0][0],
" in ", $result->[0][1], " seconds\n";
$c->send;
});
$c->recv;
=head1 DESCRIPTION
L<AnyEvent::Ping> is an asynchronous AnyEvent pinger.
=head1 ATTRIBUTES
L<AnyEvent::Ping> implements the following attributes.
=head2 C<interval>
my $interval = $ping->interval;
$ping->interval(1);
Interval between pings, defaults to 0.2 seconds.
=head2 C<timeout>
my $timeout = $ping->timeout;
$ping->timeout(3);
Maximum response time, defaults to 5 seconds.
=head2 C<error>
my $error = $ping->error;
Last error message.
=head1 METHODS
L<AnyEvent::Ping> implements the following methods.
=head2 C<ping>
$ping->ping($ip, $n => sub {
my $result = shift;
});
Perform a ping of a given $ip address $n times.
=head1 SEE ALSO
L<AnyEvent>, L<AnyEvent::FastPing>
=head1 AUTHOR
Sergey Zasenko, C<undef@cpan.org>.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2012, Sergey Zasenko
This program is free software, you can redistribute it and/or modify it under
the same terms as Perl 5.12.
=cut
2.测试程序
#!/usr/bin/perl
use 5.014;
use AnyEvent;
use AnyEvent::Ping6;
my $c = AnyEvent->condvar;
my $ping = AnyEvent::Ping6->new;
$ping->ping('::1', 1, sub {
my $result = shift;
print "Result: ", $result->[0][0],
" in ", $result->[0][1], " seconds\n";
$c->send;
});
$c->recv;
从5.14以后,perl核心的Socket已经可以支持ipv6.
原Socket6和IO::Socket::INET6逐渐废除
改用新的IO::Socket::IP模块