This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Socket from 2.030 to 2.031
authorRichard Leach <richardleach@users.noreply.github.com>
Mon, 18 Jan 2021 02:39:46 +0000 (02:39 +0000)
committerRichard Leach <richardleach@users.noreply.github.com>
Mon, 18 Jan 2021 02:39:46 +0000 (02:39 +0000)
Porting/Maintainers.pl
cpan/Socket/Makefile.PL
cpan/Socket/Socket.pm
cpan/Socket/Socket.xs
cpan/Socket/t/sockaddr.t
cpan/Socket/t/socketpair.t

index ab5ab5e..49cf75a 100755 (executable)
@@ -1002,7 +1002,7 @@ use File::Glob qw(:case);
     },
 
     'Socket' => {
-        'DISTRIBUTION' => 'PEVANS/Socket-2.030.tar.gz',
+        'DISTRIBUTION' => 'PEVANS/Socket-2.031.tar.gz',
         'FILES'        => q[cpan/Socket],
     },
 
index b69f50c..3250737 100644 (file)
@@ -170,8 +170,7 @@ my @names = (
        AF_WAN AF_X25
 
        AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN
-       AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST
-       AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED
+       AI_NUMERICHOST AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED
 
        EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY
        EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM
@@ -198,8 +197,7 @@ my @names = (
        MSG_MCAST MSG_NOSIGNAL MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL
        MSG_WIRE
 
-       NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES
-       NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV
+       NI_DGRAM NI_IDN NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV
 
        PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT
        PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6
index f156699..fe47ef6 100644 (file)
@@ -3,7 +3,7 @@ package Socket;
 use strict;
 { use v5.6.1; }
 
-our $VERSION = '2.030';
+our $VERSION = '2.031';
 
 =head1 NAME
 
@@ -110,7 +110,7 @@ level.
 
 =head2 IP_PMTUDISC_WANT, IP_PMTUDISC_DONT, ...
 
-Socket option value contants for C<IP_MTU_DISCOVER> socket option.
+Socket option value constants for C<IP_MTU_DISCOVER> socket option.
 
 =head2 IPTOS_LOWDELAY, IPTOS_THROUGHPUT, IPTOS_RELIABILITY, ...
 
@@ -837,6 +837,14 @@ BEGIN {
 *LF   = \LF();
 *CRLF = \CRLF();
 
+# The four deprecated addrinfo constants
+foreach my $name (qw( AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES )) {
+    no strict 'refs';
+    *$name = sub {
+       croak "The addrinfo constant $name is deprecated";
+    };
+}
+
 sub sockaddr_in {
     if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
        my($af, $port, @quad) = @_;
@@ -916,13 +924,9 @@ if( defined &getaddrinfo ) {
 
        # Constants we don't support. Export them, but croak if anyone tries to
        # use them
-       AI_IDN                      => 64,
-       AI_CANONIDN                 => 128,
-       AI_IDN_ALLOW_UNASSIGNED     => 256,
-       AI_IDN_USE_STD3_ASCII_RULES => 512,
-       NI_IDN                      => 32,
-       NI_IDN_ALLOW_UNASSIGNED     => 64,
-       NI_IDN_USE_STD3_ASCII_RULES => 128,
+       AI_IDN      => 64,
+       AI_CANONIDN => 128,
+       NI_IDN      => 32,
 
        # Error constants we'll never return, so it doesn't matter what value
        # these have, nor that we don't provide strings for them
@@ -992,7 +996,7 @@ sub fake_getaddrinfo
     # to talk AF_INET. If not we'd have to return no addresses at all. :)
     $flags &= ~(AI_V4MAPPED()|AI_ALL()|AI_ADDRCONFIG());
 
-    $flags & (AI_IDN()|AI_CANONIDN()|AI_IDN_ALLOW_UNASSIGNED()|AI_IDN_USE_STD3_ASCII_RULES()) and
+    $flags & (AI_IDN()|AI_CANONIDN()) and
        croak "Socket::getaddrinfo() does not support IDN";
 
     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
@@ -1090,7 +1094,7 @@ sub fake_getnameinfo
     my $flag_namereqd    = $flags & NI_NAMEREQD();    $flags &= ~NI_NAMEREQD();
     my $flag_dgram       = $flags & NI_DGRAM()   ;    $flags &= ~NI_DGRAM();
 
-    $flags & (NI_IDN()|NI_IDN_ALLOW_UNASSIGNED()|NI_IDN_USE_STD3_ASCII_RULES()) and
+    $flags & NI_IDN() and
        croak "Socket::getnameinfo() does not support IDN";
 
     $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
index e46c93e..31ffdf0 100644 (file)
@@ -764,20 +764,33 @@ inet_aton(host)
        char *  host
        CODE:
        {
+#ifdef HAS_GETADDRINFO
+       struct addrinfo *res;
+       struct addrinfo hints = {0};
+       hints.ai_family = AF_INET;
+       if (!getaddrinfo(host, NULL, &hints, &res)) {
+               ST(0) = sv_2mortal(newSVpvn(
+                       (char *)&(((struct sockaddr_in *)res->ai_addr)->sin_addr.s_addr),
+                       4));
+               freeaddrinfo(res);
+               XSRETURN(1);
+       }
+#else
        struct in_addr ip_address;
        struct hostent * phe;
-
        if ((*host != '\0') && inet_aton(host, &ip_address)) {
                ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)));
                XSRETURN(1);
        }
 #ifdef HAS_GETHOSTBYNAME
+       /* gethostbyname is not thread-safe */
        phe = gethostbyname(host);
        if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) {
                ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length));
                XSRETURN(1);
        }
-#endif
+#endif /* HAS_GETHOSTBYNAME */
+#endif /* HAS_GETADDRINFO */
        XSRETURN_UNDEF;
        }
 
@@ -794,10 +807,10 @@ inet_ntoa(ip_address_sv)
        ip_address = SvPVbyte(ip_address_sv, addrlen);
        if (addrlen == sizeof(addr) || addrlen == 4)
                addr.s_addr =
-                   (ip_address[0] & 0xFF) << 24 |
-                   (ip_address[1] & 0xFF) << 16 |
-                   (ip_address[2] & 0xFF) <<  8 |
-                   (ip_address[3] & 0xFF);
+                   (unsigned long)(ip_address[0] & 0xFF) << 24 |
+                   (unsigned long)(ip_address[1] & 0xFF) << 16 |
+                   (unsigned long)(ip_address[2] & 0xFF) <<  8 |
+                   (unsigned long)(ip_address[3] & 0xFF);
        else
                croak("Bad arg length for %s, length is %" UVuf
                       ", should be %" UVuf,
@@ -974,8 +987,12 @@ pack_sockaddr_in(port_sv, ip_address_sv)
        STRLEN addrlen;
        unsigned short port = 0;
        char * ip_address;
-       if (SvOK(port_sv))
+       if (SvOK(port_sv)) {
                port = SvUV(port_sv);
+               if (SvUV(port_sv) > 0xFFFF)
+                       warn("Port number above 0xFFFF, will be truncated to %d for %s",
+                               port, "Socket::pack_sockaddr_in");
+       }
        if (!SvOK(ip_address_sv))
                croak("Undefined address for %s", "Socket::pack_sockaddr_in");
        if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1))
@@ -1049,8 +1066,12 @@ pack_sockaddr_in6(port_sv, sin6_addr, scope_id=0, flowinfo=0)
        struct sockaddr_in6 sin6;
        char * addrbytes;
        STRLEN addrlen;
-       if (SvOK(port_sv))
+       if (SvOK(port_sv)) {
                port = SvUV(port_sv);
+               if (SvUV(port_sv) > 0xFFFF)
+                       warn("Port number above 0xFFFF, will be truncated to %d for %s",
+                               port, "Socket::pack_sockaddr_in6");
+       }
        if (!SvOK(sin6_addr))
                croak("Undefined address for %s", "Socket::pack_sockaddr_in6");
        if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1))
index 395d96a..b95d2c2 100644 (file)
@@ -12,7 +12,7 @@ use Socket qw(
     sockaddr_family
     sockaddr_un
 );
-use Test::More tests => 46;
+use Test::More tests => 50;
 
 # inet_aton, inet_ntoa
 {
@@ -83,8 +83,8 @@ SKIP: {
     is(sockaddr_family(scalar sockaddr_in(200,v10.30.50.70)), AF_INET,
         'sockaddr_in in scalar context packs');
 
-    my $warnings = 0;
-    local $SIG{__WARN__} = sub { $warnings++ };
+    my $warnings = "";
+    local $SIG{__WARN__} = sub { $warnings .= $_[0]; };
     ok( !eval { pack_sockaddr_in 0, undef; 1 },
         'pack_sockaddr_in undef addr is fatal' );
     ok( !eval { unpack_sockaddr_in undef; 1 },
@@ -93,14 +93,19 @@ SKIP: {
     ok( eval { pack_sockaddr_in undef, "\0\0\0\0"; 1 },
         'pack_sockaddr_in undef port is allowed' );
 
-    is( $warnings, 0, 'undefined values produced no warnings' );
+    is( $warnings, "", 'undefined values produced no warnings' );
+
+    ok( eval { pack_sockaddr_in 98765, "\0\0\0\0"; 1 },
+        'pack_sockaddr_in oversized port is allowed' );
+    like( $warnings, qr/^Port number above 0xFFFF, will be truncated to 33229 for Socket::pack_sockaddr_in at /,
+        'pack_sockaddr_in oversized port warning' );
 }
 
 # pack_sockaddr_in6, unpack_sockaddr_in6
 # sockaddr_in6
 SKIP: {
-    skip "No AF_INET6", 13 unless my $AF_INET6 = eval { Socket::AF_INET6() };
-    skip "Cannot pack_sockaddr_in6()", 13 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) };
+    skip "No AF_INET6", 15 unless my $AF_INET6 = eval { Socket::AF_INET6() };
+    skip "Cannot pack_sockaddr_in6()", 15 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) };
 
     ok(defined $sin6, 'pack_sockaddr_in6 defined');
 
@@ -119,8 +124,8 @@ SKIP: {
     is(sockaddr_family(scalar Socket::sockaddr_in6(0x1357, "02468ace13579bdf")), $AF_INET6,
         'sockaddr_in6 in scalar context packs' );
 
-    my $warnings = 0;
-    local $SIG{__WARN__} = sub { $warnings++ };
+    my $warnings = "";
+    local $SIG{__WARN__} = sub { $warnings .= $_[0]; };
     ok( !eval { Socket::pack_sockaddr_in6( 0, undef ); 1 },
         'pack_sockaddr_in6 undef addr is fatal' );
     ok( !eval { Socket::unpack_sockaddr_in6( undef ); 1 },
@@ -129,7 +134,12 @@ SKIP: {
     ok( eval { Socket::pack_sockaddr_in6( undef, "\0"x16 ); 1 },
         'pack_sockaddr_in6 undef port is allowed' );
 
-    is( $warnings, 0, 'undefined values produced no warnings' );
+    is( $warnings, "", 'undefined values produced no warnings' );
+
+    ok( eval { Socket::pack_sockaddr_in6( 98765, "\0"x16 ); 1 },
+        'pack_sockaddr_in6 oversized port is allowed' );
+    like( $warnings, qr/^Port number above 0xFFFF, will be truncated to 33229 for Socket::pack_sockaddr_in6 at /,
+        'pack_sockaddr_in6 oversized port warning' );
 }
 
 # sockaddr_un on abstract paths
index 29c5f74..a803302 100644 (file)
@@ -68,8 +68,9 @@ if( !$Config{d_alarm} ) {
 } elsif( !$can_fork ) {
     plan skip_all => "fork() not implemented on this platform";
 } else {
+    my ($lefth, $righth);
     # This should fail but not die if there is real socketpair
-    eval {socketpair LEFT, RIGHT, -1, -1, -1};
+    eval {socketpair $lefth, $righth, -1, -1, -1};
     if ($@ =~ /^Unsupported socket function "socketpair" called/ ||
        $! =~ /^The operation requested is not supported./) { # Stratus VOS
        plan skip_all => 'No socketpair (real or emulated)';
@@ -86,90 +87,95 @@ if( !$Config{d_alarm} ) {
 # But we'll install an alarm handler in case any of the races below fail.
 $SIG{ALRM} = sub {die "Unexpected alarm during testing"};
 
-ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC),
-    "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)")
-    or print STDERR "# \$\! = $!\n";
-
-if ($has_perlio) {
-    binmode(LEFT,  ":bytes");
-    binmode(RIGHT, ":bytes");
-}
-
 my @left = ("hello ", "world\n");
 my @right = ("perl ", "rules!"); # Not like I'm trying to bias any survey here.
 
-foreach (@left) {
-    # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left");
-    is (syswrite (LEFT, $_), length $_, "syswrite to left");
-}
-foreach (@right) {
-    # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right");
-    is (syswrite (RIGHT, $_), length $_, "syswrite to right");
-}
-
-# stream socket, so our writes will become joined:
-my ($buffer, $expect);
-$expect = join '', @right;
-undef $buffer;
-is (read (LEFT, $buffer, length $expect), length $expect, "read on left");
-is ($buffer, $expect, "content what we expected?");
-$expect = join '', @left;
-undef $buffer;
-is (read (RIGHT, $buffer, length $expect), length $expect, "read on right");
-is ($buffer, $expect, "content what we expected?");
-
-ok (shutdown(LEFT, SHUT_WR), "shutdown left for writing");
-# This will hang forever if eof is buggy, and alarm doesn't interrupt system
-# Calls. Hence the child process minder.
-SKIP: {
-    skip "SCO Unixware / OSR have a bug with shutdown",2 if $^O =~ /^(?:svr|sco)/;
-    local $SIG{ALRM} = sub { warn "EOF on right took over 3 seconds" };
-    local $TODO = "Known problems with unix sockets on $^O"
-       if $^O eq 'hpux'   || $^O eq 'super-ux';
-    alarm 3;
-    $! = 0;
-    ok (eof RIGHT, "right is at EOF");
-    local $TODO = "Known problems with unix sockets on $^O"
-       if $^O eq 'unicos' || $^O eq 'unicosmk';
-    is ($!, '', 'and $! should report no error');
-    alarm 60;
-}
+my @gripping = (chr 255, chr 127);
 
-my $err = $!;
-$SIG{PIPE} = 'IGNORE';
-{
-    local $SIG{ALRM} =
-       sub { warn "syswrite to left didn't fail within 3 seconds" };
-    alarm 3;
-    # Split the system call from the is() - is() does IO so
-    # (say) a flush may do a seek which on a pipe may disturb errno
-    my $ans = syswrite (LEFT, "void");
-    $err = $!;
-    is ($ans, undef, "syswrite to shutdown left should fail");
-    alarm 60;
-}
 {
-    # This may need skipping on some OSes - restoring value saved above
-    # should help
-    $! = $err;
-    ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN')
-       or printf STDERR "# \$\! = %d (%s)\n", $err, $err;
-}
+    my ($lefth, $righth);
 
-my @gripping = (chr 255, chr 127);
-foreach (@gripping) {
-    is (syswrite (RIGHT, $_), length $_, "syswrite to right");
-}
+    ok (socketpair ($lefth, $righth, AF_UNIX, SOCK_STREAM, PF_UNSPEC),
+       "socketpair (\$lefth, \$righth, AF_UNIX, SOCK_STREAM, PF_UNSPEC)")
+       or print STDERR "# \$\! = $!\n";
+
+    if ($has_perlio) {
+       binmode($lefth,  ":bytes");
+       binmode($righth, ":bytes");
+    }
+
+    foreach (@left) {
+       # is (syswrite ($lefth, $_), length $_, "write " . _qq ($_) . " to left");
+       is (syswrite ($lefth, $_), length $_, "syswrite to left");
+    }
+    foreach (@right) {
+       # is (syswrite ($righth, $_), length $_, "write " . _qq ($_) . " to right");
+       is (syswrite ($righth, $_), length $_, "syswrite to right");
+    }
+
+    # stream socket, so our writes will become joined:
+    my ($buffer, $expect);
+    $expect = join '', @right;
+    undef $buffer;
+    is (read ($lefth, $buffer, length $expect), length $expect, "read on left");
+    is ($buffer, $expect, "content what we expected?");
+    $expect = join '', @left;
+    undef $buffer;
+    is (read ($righth, $buffer, length $expect), length $expect, "read on right");
+    is ($buffer, $expect, "content what we expected?");
+
+    ok (shutdown($lefth, SHUT_WR), "shutdown left for writing");
+    # This will hang forever if eof is buggy, and alarm doesn't interrupt system
+    # Calls. Hence the child process minder.
+    SKIP: {
+       skip "SCO Unixware / OSR have a bug with shutdown",2 if $^O =~ /^(?:svr|sco)/;
+       local $SIG{ALRM} = sub { warn "EOF on right took over 3 seconds" };
+       local $TODO = "Known problems with unix sockets on $^O"
+           if $^O eq 'hpux'   || $^O eq 'super-ux';
+       alarm 3;
+       $! = 0;
+       ok (eof $righth, "right is at EOF");
+       local $TODO = "Known problems with unix sockets on $^O"
+           if $^O eq 'unicos' || $^O eq 'unicosmk';
+       is ($!, '', 'and $! should report no error');
+       alarm 60;
+    }
+
+    my $err = $!;
+    $SIG{PIPE} = 'IGNORE';
+    {
+       local $SIG{ALRM} =
+           sub { warn "syswrite to left didn't fail within 3 seconds" };
+       alarm 3;
+       # Split the system call from the is() - is() does IO so
+       # (say) a flush may do a seek which on a pipe may disturb errno
+       my $ans = syswrite ($lefth, "void");
+       $err = $!;
+       is ($ans, undef, "syswrite to shutdown left should fail");
+       alarm 60;
+    }
+    {
+       # This may need skipping on some OSes - restoring value saved above
+       # should help
+       $! = $err;
+       ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN')
+           or printf STDERR "# \$\! = %d (%s)\n", $err, $err;
+    }
+
+    foreach (@gripping) {
+       is (syswrite ($righth, $_), length $_, "syswrite to right");
+    }
 
-ok (!eof LEFT, "left is not at EOF");
+    ok (!eof $lefth, "left is not at EOF");
 
-$expect = join '', @gripping;
-undef $buffer;
-is (read (LEFT, $buffer, length $expect), length $expect, "read on left");
-is ($buffer, $expect, "content what we expected?");
+    $expect = join '', @gripping;
+    undef $buffer;
+    is (read ($lefth, $buffer, length $expect), length $expect, "read on left");
+    is ($buffer, $expect, "content what we expected?");
 
-ok (close LEFT, "close left");
-ok (close RIGHT, "close right");
+    ok (close $lefth, "close left");
+    ok (close $righth, "close right");
+}
 
 
 # And now datagrams
@@ -177,44 +183,49 @@ ok (close RIGHT, "close right");
 # guarantee that the stack won't drop a UDP packet, even if it is for localhost.
 
 SKIP: {
-    skip "No usable SOCK_DGRAM for socketpair", 24 if ($^O =~ /^(MSWin32|os2)\z/);
     skip "alarm doesn't interrupt I/O on this Perl", 24 if "$]" < 5.008;
+
+    my $success = socketpair my $lefth, my $righth, AF_UNIX, SOCK_DGRAM, PF_UNSPEC;
+
+    skip "No useable SOCK_DGRAM for socketpair", 24 if !$success and
+       ($!{EAFNOSUPPORT} or $!{EOPNOTSUPP} or $!{EPROTONOSUPPORT} or $!{EPROTOTYPE});
+    # Maybe this test is redundant now?
+    skip "No usable SOCK_DGRAM for socketpair", 24 if ($^O =~ /^(MSWin32|os2)\z/);
     local $TODO = "socketpair not supported on $^O" if $^O eq 'nto';
 
-    ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC),
-       "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)")
+    ok ($success, "socketpair (\$left, \$righth, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)")
        or print STDERR "# \$\! = $!\n";
 
     if ($has_perlio) {
-       binmode(LEFT,  ":bytes");
-       binmode(RIGHT, ":bytes");
+       binmode($lefth,  ":bytes");
+       binmode($righth, ":bytes");
     }
 
     foreach (@left) {
-       # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left");
-       is (syswrite (LEFT, $_), length $_, "syswrite to left");
+       # is (syswrite ($lefth, $_), length $_, "write " . _qq ($_) . " to left");
+       is (syswrite ($lefth, $_), length $_, "syswrite to left");
     }
     foreach (@right) {
-       # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right");
-       is (syswrite (RIGHT, $_), length $_, "syswrite to right");
+       # is (syswrite ($righth, $_), length $_, "write " . _qq ($_) . " to right");
+       is (syswrite ($righth, $_), length $_, "syswrite to right");
     }
 
     # stream socket, so our writes will become joined:
-    my ($total);
+    my ($total, $buffer);
     $total = join '', @right;
-    foreach $expect (@right) {
+    foreach my $expect (@right) {
        undef $buffer;
-       is (sysread (LEFT, $buffer, length $total), length $expect, "read on left");
+       is (sysread ($lefth, $buffer, length $total), length $expect, "read on left");
        is ($buffer, $expect, "content what we expected?");
     }
     $total = join '', @left;
-    foreach $expect (@left) {
+    foreach my $expect (@left) {
        undef $buffer;
-       is (sysread (RIGHT, $buffer, length $total), length $expect, "read on right");
+       is (sysread ($righth, $buffer, length $total), length $expect, "read on right");
        is ($buffer, $expect, "content what we expected?");
     }
 
-    ok (shutdown(LEFT, 1), "shutdown left for writing");
+    ok (shutdown($lefth, 1), "shutdown left for writing");
 
     # eof uses buffering. eof is indicated by a sysread of zero.
     # but for a datagram socket there's no way it can know nothing will ever be
@@ -227,7 +238,7 @@ SKIP: {
        print "# Approximate forever as 3 seconds. Wait 'forever'...\n";
        alarm 3;
        undef $buffer;
-       is (sysread (RIGHT, $buffer, 1), undef,
+       is (sysread ($righth, $buffer, 1), undef,
            "read on right should be interrupted");
        is ($alarmed, 1, "alarm should have fired");
     }
@@ -235,18 +246,18 @@ SKIP: {
     alarm 30;
 
     foreach (@gripping) {
-       is (syswrite (RIGHT, $_), length $_, "syswrite to right");
+       is (syswrite ($righth, $_), length $_, "syswrite to right");
     }
 
     $total = join '', @gripping;
-    foreach $expect (@gripping) {
+    foreach my $expect (@gripping) {
        undef $buffer;
-       is (sysread (LEFT, $buffer, length $total), length $expect, "read on left");
+       is (sysread ($lefth, $buffer, length $total), length $expect, "read on left");
        is ($buffer, $expect, "content what we expected?");
     }
 
-    ok (close LEFT, "close left");
-    ok (close RIGHT, "close right");
+    ok (close $lefth, "close left");
+    ok (close $righth, "close right");
 
 } # end of DGRAM SKIP