From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 17 May 2003 06:07:07 +0000 (+0000)
Subject: apply Net::Ping patch that makes the fork()-based approach
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6dbac12b81c0a4e61d1a9c7a1f12e0ee3256cdda;p=p5sagit%2Fp5-mst-13.2.git

apply Net::Ping patch that makes the fork()-based approach
work better on windows (Marcus Holland-Moritz <mhx-perl@gmx.net>)

the code this affects is currently not enabled anywhere, but
could be enabled if the non-blocking approach runs into problems
on older windows versions

p4raw-id: //depot/perl@19536
---

diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm
index f50967c..05a3fd5 100644
--- a/lib/Net/Ping.pm
+++ b/lib/Net/Ping.pm
@@ -565,7 +565,9 @@ sub tcp_connect
   };
   my $do_connect = sub {
     $self->{"ip"} = $ip;
-    return ($ret = connect($self->{"fh"}, $saddr));
+    # ECONNREFUSED is 10061 on MSWin32. If we pass it as child error through $?,
+    # we'll get (10061 & 255) = 77, so we cannot check it in the parent process.
+    return ($ret = connect($self->{"fh"}, $saddr) || ($! == ECONNREFUSED && !$self->{"econnrefused"}));
   };
   my $do_connect_nb = sub {
     # Set O_NONBLOCK property on filehandle
@@ -667,7 +669,8 @@ sub tcp_connect
         exit 0;
       } else {
         # Pass the error status to the parent
-        exit $!;
+        # Make sure that $! <= 255
+        exit($! <= 255 ? $! : 255);
       }
     }
 
@@ -692,6 +695,8 @@ sub tcp_connect
         # within the timeout
         &{ $do_connect }();
       }
+      # $ret cannot be set by the child process
+      $ret = !$child_errno;
     } else {
       # Time must have run out.
       # Put that choking client out of its misery