diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 98567005df..38d664ec62 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -866,7 +866,7 @@ our %Modules = ( }, 'Net::Ping' => { - 'DISTRIBUTION' => 'RURBAN/Net-Ping-2.75.tar.gz', + 'DISTRIBUTION' => 'RURBAN/Net-Ping-2.76.tar.gz', 'FILES' => q[dist/Net-Ping], 'EXCLUDED' => [ qr{^\.[awc]}, diff --git a/dist/Net-Ping/Changes b/dist/Net-Ping/Changes index 3562df1a12..37c2db5db6 100644 --- a/dist/Net-Ping/Changes +++ b/dist/Net-Ping/Changes @@ -1,5 +1,11 @@ CHANGES ------- +2.76 2025-09-08 08:39:55 rurban + Features + - use SOCK_DRGAM for ICMP under linux, which requires no root. + (Owen DeLong GH #33) + Minor + - Improve make release 2.75 2022-09-01 12:44:03 rurban Minor - Modernized the synopsis (PR #31) diff --git a/dist/Net-Ping/lib/Net/Ping.pm b/dist/Net-Ping/lib/Net/Ping.pm index b4c8f2f80b..2b1e51b113 100644 --- a/dist/Net-Ping/lib/Net/Ping.pm +++ b/dist/Net-Ping/lib/Net/Ping.pm @@ -22,7 +22,7 @@ use Time::HiRes; @ISA = qw(Exporter); @EXPORT = qw(pingecho); @EXPORT_OK = qw(wakeonlan); -$VERSION = "2.76"; +$VERSION = "2.77"; # Globals @@ -227,13 +227,18 @@ sub new } elsif ($self->{proto} eq "icmp") { - croak("icmp ping requires root privilege") if !_isroot(); + croak("icmp ping requires root privilege") if !_isroot() and $^O ne "linux"; $self->{proto_num} = eval { (getprotobyname('icmp'))[2] } || croak("Can't get icmp protocol by name"); $self->{pid} = $$ & 0xffff; # Save lower 16 bits of pid $self->{fh} = FileHandle->new(); - socket($self->{fh}, PF_INET, SOCK_RAW, $self->{proto_num}) || - croak("icmp socket error - $!"); + if ($^O eq "linux" and !_isroot()) { + socket($self->{fh}, PF_INET, SOCK_DGRAM, $self->{proto_num}) || + croak("icmp socket error - $!"); + } else { + socket($self->{fh}, PF_INET, SOCK_RAW, $self->{proto_num}) || + croak("icmp socket error - $!"); + } $self->_setopts(); if ($self->{'ttl'}) { setsockopt($self->{fh}, IPPROTO_IP, IP_TTL, pack("I*", $self->{'ttl'})) @@ -250,8 +255,13 @@ sub new croak("Can't get ipv6-icmp protocol by name"); # 58 $self->{pid} = $$ & 0xffff; # Save lower 16 bits of pid $self->{fh} = FileHandle->new(); - socket($self->{fh}, $AF_INET6, SOCK_RAW, $self->{proto_num}) || - croak("icmp socket error - $!"); + if ($^O eq 'linux' and !_isroot()) { + socket($self->{fh}, $AF_INET6, SOCK_DGRAM, $self->{proto_num}) || + croak("icmp socket error - $!"); + } else { + socket($self->{fh}, $AF_INET6, SOCK_RAW, $self->{proto_num}) || + croak("icmp socket error - $!"); + } $self->_setopts(); if ($self->{'gateway'}) { my $g = $self->{gateway}; @@ -715,8 +725,13 @@ sub ping_icmp $timeout = $self->{timeout} if !defined $timeout and $self->{timeout}; $timestamp_msg = $self->{message_type} && $self->{message_type} eq 'timestamp' ? 1 : 0; - socket($self->{fh}, $ip->{family}, SOCK_RAW, $self->{proto_num}) || - croak("icmp socket error - $!"); + if ($^O eq 'linux' and !_isroot()) { + socket($self->{fh}, $ip->{family}, SOCK_DGRAM, $self->{proto_num}) || + croak("icmp socket error - $!"); + } else { + socket($self->{fh}, $ip->{family}, SOCK_RAW, $self->{proto_num}) || + croak("icmp socket error - $!"); + } if (defined $self->{local_addr} && !CORE::bind($self->{fh}, _pack_sockaddr_in(0, $self->{local_addr}))) { @@ -2366,11 +2381,13 @@ enabled. X The L method used with the icmp protocol. +Under Linux under a non-root account this uses now SOCK_DGRAM. =item $p->ping_icmpv6([$host, $timeout, $family]) X The L method used with the icmpv6 protocol. +Under Linux under a non-root account this uses now SOCK_DGRAM. =item $p->ping_stream([$host, $timeout, $family]) X diff --git a/dist/Net-Ping/t/000_load.t b/dist/Net-Ping/t/000_load.t index 87f55d93d9..4bf05c6b38 100644 --- a/dist/Net-Ping/t/000_load.t +++ b/dist/Net-Ping/t/000_load.t @@ -12,5 +12,5 @@ BEGIN { use_ok( 'Net::Ping' ) || print "No Net::Ping!\n"; } -note( "Testing Net::Ping $Net::Ping::VERSION, Perl $], $^X" ); +diag( "Testing Net::Ping $Net::Ping::VERSION, Perl $] on $^O, $^X" ); diff --git a/dist/Net-Ping/t/010_pingecho.t b/dist/Net-Ping/t/010_pingecho.t index 0c3c815ddf..f6f3c2f270 100644 --- a/dist/Net-Ping/t/010_pingecho.t +++ b/dist/Net-Ping/t/010_pingecho.t @@ -2,6 +2,7 @@ use warnings; use strict; use Config; + BEGIN { unless (my $port = getservbyname('echo', 'tcp')) { print "1..0 \# Skip: no echo port\n"; @@ -19,6 +20,7 @@ BEGIN {use_ok('Net::Ping')}; TODO: { local $TODO = "Not working on os390 smoker; may be a permissions problem" if $^O eq 'os390'; + $TODO = "Not working on freebsd" if $^O eq 'freebsd'; my $result = pingecho("127.0.0.1"); is($result, 1, "pingecho 127.0.0.1 works"); } diff --git a/dist/Net-Ping/t/450_service.t b/dist/Net-Ping/t/450_service.t index 421e7ca43a..e4d2c38c70 100644 --- a/dist/Net-Ping/t/450_service.t +++ b/dist/Net-Ping/t/450_service.t @@ -78,7 +78,7 @@ is($p->ping("127.0.0.1"), 1, 'first port is reachable'); $p->{port_num} = $port2; { - local $TODO = "Believed not to work on $^O" if $^O =~ /^(?:MSWin32|os390|cygwin)$/; + local $TODO = "Believed not to work on $^O" if $^O =~ /^(?:hpux|MSWin32|os390|cygwin|freebsd)$/; is($p->ping("127.0.0.1"), 1, 'second port is reachable'); } @@ -133,7 +133,7 @@ SKIP: { { local $TODO = "Believed not to work on $^O" - if $^O =~ /^(?:MSWin32|os390|cygwin)$/; + if $^O =~ /^(?:hpux|MSWin32|os390|cygwin|freebsd)$/; is($p->ack(), '127.0.0.1', 'IP should be reachable'); } } diff --git a/dist/Net-Ping/t/500_ping_icmp.t b/dist/Net-Ping/t/500_ping_icmp.t index e3557115bc..8b4566e638 100644 --- a/dist/Net-Ping/t/500_ping_icmp.t +++ b/dist/Net-Ping/t/500_ping_icmp.t @@ -19,13 +19,14 @@ BEGIN { } my $is_devel = $ENV{PERL_CORE} || -d ".git" ? 1 : 0; +$ENV{TEST_PING_HOST} = "127.0.0.1" if $ENV{NO_NETWORK_TESTING}; # Note this rawsocket test code is considered anti-social in p5p and was removed in # their variant. -# See http://nntp.perl.org/group/perl.perl5.porters/240707 +# See https://www.nntp.perl.org/group/perl.perl5.porters/2016/11/msg240707.html # Problem is that ping_icmp needs root perms, and previous bugs were # never caught. So I rather execute it via sudo in the core test suite # and on devel CPAN dirs, than not at all and risk further bitrot of this API. -if ( 0 && !Net::Ping::_isroot()) { # disable in blead via 7bfdd8260c +if (!Net::Ping::_isroot()) { my $file = __FILE__; my $lib = $ENV{PERL_CORE} ? '-I../../lib' : '-Mblib'; if ($is_devel and $Config{ccflags} =~ /fsanitize=address/ and $^O eq 'linux') { @@ -54,7 +55,7 @@ if ( 0 && !Net::Ping::_isroot()) { # disable in blead via 7bfdd8260c SKIP: { skip "icmp ping requires root privileges.", 2 - if !Net::Ping::_isroot() or $^O eq 'MSWin32'; + if ($^O ne 'Linux' and !Net::Ping::_isroot()) or $^O eq 'MSWin32'; my $p = new Net::Ping "icmp"; is($p->message_type(), 'echo', "default icmp message type is 'echo'"); # message_type fails on wrong message type diff --git a/dist/Net-Ping/t/501_ping_icmpv6.t b/dist/Net-Ping/t/501_ping_icmpv6.t index d59d4beef4..9b5b8b8f98 100644 --- a/dist/Net-Ping/t/501_ping_icmpv6.t +++ b/dist/Net-Ping/t/501_ping_icmpv6.t @@ -19,7 +19,8 @@ BEGIN { } my $is_devel = $ENV{PERL_CORE} || -d ".git" ? 1 : 0; -if (0 && !Net::Ping::_isroot()) { +$ENV{TEST_PING6_HOST} = "::1" if $ENV{NO_NETWORK_TESTING}; +if (!Net::Ping::_isroot()) { my $file = __FILE__; my $lib = $ENV{PERL_CORE} ? '-I../../lib' : '-Mblib'; # -n prevents from asking for a password. rather fail then @@ -59,7 +60,7 @@ SKIP: { my $rightip = "2001:4860:4860::8888"; # pingable ip of google's dnsserver # for a firewalled ipv6 network try an optional local ipv6 host $rightip = $ENV{TEST_PING6_HOST} if $ENV{TEST_PING6_HOST}; - my $wrongip = "2001:4860:4860::1234"; # non existing ip + my $wrongip = "2001:db8::"; # non existing ip # diag "Pinging existing IPv6 "; my $result = $p->ping($rightip); if ($result == 1) {