From a636724dc81b1f27ddabe393baf4c6fcfc2f5029 Mon Sep 17 00:00:00 2001 From: Brian Fraser Date: Mon, 29 Apr 2013 00:23:56 -0300 Subject: [PATCH] Net::Ping: Handle getprotobyn{ame,umber} not being available --- dist/Net-Ping/lib/Net/Ping.pm | 10 +++++----- dist/Net-Ping/t/110_icmp_inst.t | 5 +++++ dist/Net-Ping/t/120_udp_inst.t | 5 +++++ dist/Net-Ping/t/130_tcp_inst.t | 5 +++++ dist/Net-Ping/t/140_stream_inst.t | 5 +++++ dist/Net-Ping/t/150_syn_inst.t | 5 +++++ dist/Net-Ping/t/450_service.t | 6 ++++++ dist/Net-Ping/t/500_ping_icmp.t | 5 +++++ dist/Net-Ping/t/510_ping_udp.t | 2 ++ dist/Net-Ping/t/520_icmp_ttl.t | 6 ++++++ 10 files changed, 49 insertions(+), 5 deletions(-) diff --git a/dist/Net-Ping/lib/Net/Ping.pm b/dist/Net-Ping/lib/Net/Ping.pm index 341f0c5..2766c9e 100644 --- a/dist/Net-Ping/lib/Net/Ping.pm +++ b/dist/Net-Ping/lib/Net/Ping.pm @@ -17,7 +17,7 @@ use Time::HiRes; @ISA = qw(Exporter); @EXPORT = qw(pingecho); -$VERSION = "2.42"; +$VERSION = "2.43"; # Constants @@ -135,7 +135,7 @@ sub new $self->{"seq"} = 0; # For counting packets if ($self->{"proto"} eq "udp") # Open a socket { - $self->{"proto_num"} = (getprotobyname('udp'))[2] || + $self->{"proto_num"} = eval { (getprotobyname('udp'))[2] } || croak("Can't udp protocol by name"); $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] || croak("Can't get udp echo port by name"); @@ -155,7 +155,7 @@ sub new elsif ($self->{"proto"} eq "icmp") { croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin'); - $self->{"proto_num"} = (getprotobyname('icmp'))[2] || + $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(); @@ -176,7 +176,7 @@ sub new } elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream") { - $self->{"proto_num"} = (getprotobyname('tcp'))[2] || + $self->{"proto_num"} = eval { (getprotobyname('tcp'))[2] } || croak("Can't get tcp protocol by name"); $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] || croak("Can't get tcp echo port by name"); @@ -184,7 +184,7 @@ sub new } elsif ($self->{"proto"} eq "syn") { - $self->{"proto_num"} = (getprotobyname('tcp'))[2] || + $self->{"proto_num"} = eval { (getprotobyname('tcp'))[2] } || croak("Can't get tcp protocol by name"); $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] || croak("Can't get tcp echo port by name"); diff --git a/dist/Net-Ping/t/110_icmp_inst.t b/dist/Net-Ping/t/110_icmp_inst.t index b36d32f..deddd8f 100644 --- a/dist/Net-Ping/t/110_icmp_inst.t +++ b/dist/Net-Ping/t/110_icmp_inst.t @@ -2,12 +2,17 @@ # Root access is required to actually perform icmp testing. use strict; +use Config; BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } use Test::More tests => 2; diff --git a/dist/Net-Ping/t/120_udp_inst.t b/dist/Net-Ping/t/120_udp_inst.t index ca10543..d86dd00 100644 --- a/dist/Net-Ping/t/120_udp_inst.t +++ b/dist/Net-Ping/t/120_udp_inst.t @@ -2,6 +2,7 @@ # I do not know of any servers that support udp echo anymore. use strict; +use Config; BEGIN { unless (eval "require Socket") { @@ -12,6 +13,10 @@ BEGIN { print "1..0 \# Skip: no echo port\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } use Test::More tests => 2; diff --git a/dist/Net-Ping/t/130_tcp_inst.t b/dist/Net-Ping/t/130_tcp_inst.t index 2810c8f..21f0181 100644 --- a/dist/Net-Ping/t/130_tcp_inst.t +++ b/dist/Net-Ping/t/130_tcp_inst.t @@ -1,6 +1,7 @@ # Test to make sure object can be instantiated for tcp protocol. use strict; +use Config; BEGIN { unless (eval "require Socket") { @@ -11,6 +12,10 @@ BEGIN { print "1..0 \# Skip: no echo port\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } use Test::More tests => 2; diff --git a/dist/Net-Ping/t/140_stream_inst.t b/dist/Net-Ping/t/140_stream_inst.t index cb1ba5f..860402e 100644 --- a/dist/Net-Ping/t/140_stream_inst.t +++ b/dist/Net-Ping/t/140_stream_inst.t @@ -1,6 +1,7 @@ # Test to make sure object can be instantiated for stream protocol. use strict; +use Config; BEGIN { unless (eval "require Socket") { @@ -11,6 +12,10 @@ BEGIN { print "1..0 \# Skip: no echo port\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } use Test::More tests => 2; diff --git a/dist/Net-Ping/t/150_syn_inst.t b/dist/Net-Ping/t/150_syn_inst.t index d32bc85..2012c96 100644 --- a/dist/Net-Ping/t/150_syn_inst.t +++ b/dist/Net-Ping/t/150_syn_inst.t @@ -1,6 +1,7 @@ # Test to make sure object can be instantiated for syn protocol. use strict; +use Config; BEGIN { unless (eval "require Socket") { @@ -11,6 +12,10 @@ BEGIN { print "1..0 \# Skip: no echo port\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } diff --git a/dist/Net-Ping/t/450_service.t b/dist/Net-Ping/t/450_service.t index 6c1d938..c16b30d 100644 --- a/dist/Net-Ping/t/450_service.t +++ b/dist/Net-Ping/t/450_service.t @@ -1,5 +1,7 @@ # Testing service_check method using tcp and syn protocols. +use Config; + BEGIN { unless (eval "require IO::Socket") { print "1..0 \# Skip: no IO::Socket\n"; @@ -9,6 +11,10 @@ BEGIN { print "1..0 \# Skip: no echo port\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } use strict; diff --git a/dist/Net-Ping/t/500_ping_icmp.t b/dist/Net-Ping/t/500_ping_icmp.t index 3050cc3..62855ff 100644 --- a/dist/Net-Ping/t/500_ping_icmp.t +++ b/dist/Net-Ping/t/500_ping_icmp.t @@ -2,12 +2,17 @@ # Root access is required. use strict; +use Config; BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } use Test::More tests => 2; diff --git a/dist/Net-Ping/t/510_ping_udp.t b/dist/Net-Ping/t/510_ping_udp.t index cb0ca1b..aa48e90 100644 --- a/dist/Net-Ping/t/510_ping_udp.t +++ b/dist/Net-Ping/t/510_ping_udp.t @@ -1,6 +1,7 @@ # Test to perform udp protocol testing. use strict; +use Config; sub isWindowsVista { return unless $^O eq 'MSWin32' or $^O eq "cygwin"; @@ -19,6 +20,7 @@ BEGIN {use_ok('Net::Ping')}; SKIP: { skip "No udp echo port", 1 unless getservbyname('echo', 'udp'); skip "udp ping blocked by Window's default settings", 1 if isWindowsVista(); + skip "No getprotobyname", 1 unless $Config{d_getpbyname}; my $p = new Net::Ping "udp"; is($p->ping("127.0.0.1"), 1); } diff --git a/dist/Net-Ping/t/520_icmp_ttl.t b/dist/Net-Ping/t/520_icmp_ttl.t index f553c63..75c8c49 100644 --- a/dist/Net-Ping/t/520_icmp_ttl.t +++ b/dist/Net-Ping/t/520_icmp_ttl.t @@ -1,11 +1,17 @@ # Test to perform icmp protocol testing. # Root access is required. +use Config; + BEGIN { unless (eval "require Socket") { print "1..0 \# Skip: no Socket\n"; exit; } + unless ($Config{d_getpbyname}) { + print "1..0 \# Skip: no getprotobyname\n"; + exit; + } } use Test::More qw(no_plan); -- 2.7.4