1# Test to perform ICMPv6 protocol testing.
2# Root access is required.
3# In the core test suite it calls itself via sudo -n (no password) to test it.
4
5use strict;
6use Config;
7use Net::Ping;
8use Test::More;
9use Cwd;
10use File::Spec;
11
12BEGIN {
13  unless (eval "require Socket") {
14    plan skip_all => 'no Socket';
15  }
16  unless ($Config{d_getpbyname}) {
17    plan skip_all => 'no getprotobyname';
18  }
19}
20
21my $is_devel = $ENV{PERL_CORE} || -d ".git" ? 1 : 0;
22if (0 && !Net::Ping::_isroot()) {
23    my $file = __FILE__;
24    my $lib = $ENV{PERL_CORE} ? '-I../../lib' : '-Mblib';
25    # -n prevents from asking for a password. rather fail then
26    # A technical problem is with leak-detectors, like asan, which
27    # require PERL_DESTRUCT_LEVEL=2 to be set in the root env.
28    my $env = "PERL_DESTRUCT_LEVEL=2";
29    if ($ENV{TEST_PING6_HOST}) {
30      $env .= " TEST_PING6_HOST=$ENV{TEST_PING6_HOST}";
31    }
32    if ($ENV{PERL_CORE} && $Config{ldlibpthname}) {
33      my $up = File::Spec->updir();
34      my $dir = Cwd::abs_path(File::Spec->catdir($up, $up));
35      $env .= " $Config{ldlibpthname}=\"$dir\"";
36    }
37    if ($is_devel and
38        system("sudo -n $env \"$^X\" $lib $file") == 0) {
39      exit;
40    } else {
41      plan skip_all => 'no sudo/failed';
42    }
43}
44
45
46SKIP: {
47  skip "icmpv6 ping requires root privileges.", 1
48    if !Net::Ping::_isroot() or $^O eq 'MSWin32';
49  my $p = new Net::Ping "icmpv6";
50  # message_type can't be used
51  eval {
52    $p->message_type();
53  };
54  like($@, qr/message type only supported on 'icmp' protocol/, "message_type() API only concern 'icmp' protocol");
55  my $rightip = "2001:4860:4860::8888"; # pingable ip of google's dnsserver
56  # for a firewalled ipv6 network try an optional local ipv6 host
57  $rightip = $ENV{TEST_PING6_HOST} if $ENV{TEST_PING6_HOST};
58  my $wrongip = "2001:4860:4860::1234"; # non existing ip
59  # diag "Pinging existing IPv6 ";
60  my $result = $p->ping($rightip);
61  if ($result == 1) {
62    ok($result, "icmpv6 ping $rightip");
63    # diag "Pinging wrong IPv6 ";
64    ok(!$p->ping($wrongip), "icmpv6 ping $wrongip");
65  } else {
66  TODO: {
67      local $TODO = "icmpv6 firewalled?";
68      is($result, 1, "icmpv6 ping $rightip");
69    }
70  }
71}
72
73done_testing;
74