From: Jan Dubois Date: Mon, 18 Apr 2005 20:16:24 +0000 (-0700) Subject: [PATCH] Run ICMP ping tests on Windows as long as we have admin privs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d706fb2bbfd21eac5cd2efc341a42f1caed2490;p=p5sagit%2Fp5-mst-13.2.git [PATCH] Run ICMP ping tests on Windows as long as we have admin privs From: "Jan Dubois" Date: Mon, 18 Apr 2005 20:16:24 -0700 Message-Id: <200504190311.j3J3BM4p001792@smtp3.ActiveState.com> Subject: RE: [PATCH] Run ICMP ping tests on Windows as long as we have admin privs From: "Jan Dubois" Date: Tue, 19 Apr 2005 01:49:51 -0700 Message-Id: <200504190844.j3J8inkW032630@smtp3.ActiveState.com> (There was no reply from Rob Brown in over a month, so commit to blead for now. I'll email him again...) p4raw-id: //depot/perl@24688 --- diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 4f44106..05fd69d 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -16,7 +16,7 @@ use Carp; @ISA = qw(Exporter); @EXPORT = qw(pingecho); -$VERSION = "2.31"; +$VERSION = "2.31_01"; sub SOL_IP { 0; }; sub IP_TOS { 1; }; diff --git a/lib/Net/Ping/t/110_icmp_inst.t b/lib/Net/Ping/t/110_icmp_inst.t index cdb7219..14a7f12 100644 --- a/lib/Net/Ping/t/110_icmp_inst.t +++ b/lib/Net/Ping/t/110_icmp_inst.t @@ -17,7 +17,7 @@ ok 1; if (($> and $^O ne 'VMS' and $^O ne 'cygwin') or ($^O eq 'MSWin32' - and Win32::IsWinNT()) + and !IsAdminUser()) or ($^O eq 'VMS' and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) { skip "icmp ping requires root privileges.", 1; @@ -27,3 +27,10 @@ if (($> and $^O ne 'VMS' and $^O ne 'cygwin') my $p = new Net::Ping "icmp"; ok !!$p; } + +sub IsAdminUser { + return unless $^O eq 'MSWin32'; + return unless eval { require Win32 }; + return unless defined &Win32::IsAdminUser; + return Win32::IsAdminUser(); +} diff --git a/lib/Net/Ping/t/500_ping_icmp.t b/lib/Net/Ping/t/500_ping_icmp.t index 6b6c3ef..a4612b2 100644 --- a/lib/Net/Ping/t/500_ping_icmp.t +++ b/lib/Net/Ping/t/500_ping_icmp.t @@ -17,7 +17,7 @@ ok 1; if (($> and $^O ne 'VMS' and $^O ne 'cygwin') or ($^O eq 'MSWin32' - and Win32::IsWinNT()) + and !IsAdminUser()) or ($^O eq 'VMS' and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) { skip "icmp ping requires root privileges.", 1; @@ -27,3 +27,10 @@ if (($> and $^O ne 'VMS' and $^O ne 'cygwin') my $p = new Net::Ping "icmp"; ok $p->ping("127.0.0.1"); } + +sub IsAdminUser { + return unless $^O eq 'MSWin32'; + return unless eval { require Win32 }; + return unless defined &Win32::IsAdminUser; + return Win32::IsAdminUser(); +}