[perl]支持ipv6-icmp ping

概述1.参照AnyEvent::Ping修改模块AnyEvent::Ping6   package AnyEvent::Ping6;#use 5.008_001;use 5.014; #need socket version of perl 5.14use strict;use warnings;our $VERSION = 0.001; #new version

1.参照AnyEvent::Ping修改模块AnyEvent::Ping6

 

package AnyEvent::Ping6;#use 5.008_001;use 5.014;  #need socket version of perl 5.14use 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 ipv6use 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 Replymy $ICMP_ECHOREPLY     = 129;     # Echo Reply of icmpv6my $ICMP_DEST_UNREACH  = 3;     # Destination Unreachablemy $ICMP_SOURCE_QUENCH = 4;     # Source Quenchmy $ICMP_REDIRECT      = 5;     # Redirect (change route)#my $ICMP_ECHO          = 8;     # Echo Requestmy $ICMP_ECHO          = 128;     # Echo Request of icmpv6my $ICMP_TIME_EXCEEDED = 11;    # Time Exceededsub 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,#$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,$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,$data;    $checksum = $self->_icmp_checksum($msg);    $msg = pack $ICMP_Ping,$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,$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 nameAnyEvent::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 DESCRIPTIONL<AnyEvent::Ping> is an asynchronous AnyEvent Pinger.=head1 ATTRIBUTESL<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 METHODSL<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 ALSOL<AnyEvent>,L<AnyEvent::FastPing>=head1 AUTHORSergey Zasenko,C<undef@cpan.org>.=head1 copYRIGHT AND liCENSEcopyright (C) 2012,Sergey ZasenkoThis program is free software,you can redistribute it and/or modify it underthe same terms as Perl 5.12.=cut

2.测试程序

#!/usr/bin/perluse 5.014;use AnyEvent;use AnyEvent::Ping6;    my $c = AnyEvent->condvar;    my $Ping = AnyEvent::Ping6->new;    $Ping->Ping('::1'," seconds\n";        $c->send;    });    $c->recv;

从5.14以后,perl核心的Socket已经可以支持ipv6.

原Socket6和IO::Socket::INET6逐渐废除

改用新的IO::Socket::IP模块

总结

以上是内存溢出为你收集整理的[perl]支持ipv6-icmp ping全部内容，希望文章能够帮你解决[perl]支持ipv6-icmp ping所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。