OS/2 socket fixes.

To: Mailing list Perl5 <perl5-porters@perl.org>
Subject: [PATCH 5.005_57] Teach Socket and io_unix.t the syntax of OS/2
Message-ID: <19990529201813.B9489@monk.mps.ohio-state.edu>

p4raw-id: //depot/cfgperl@3508

diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs
index b2b1455..336e6c4 100644 (file)
--- a/ext/Socket/Socket.xs
+++ b/ext/Socket/Socket.xs
@@ -929,12 +929,37 @@ pack_sockaddr_un(pathname)
 #ifdef I_SYS_UN
        struct sockaddr_un sun_ad; /* fear using sun */
        STRLEN len;
+
        Zero( &sun_ad, sizeof sun_ad, char );
        sun_ad.sun_family = AF_UNIX;
        len = strlen(pathname);
        if (len > sizeof(sun_ad.sun_path))
            len = sizeof(sun_ad.sun_path);
+#  ifdef OS2   /* Name should start with \socket\ and contain backslashes! */
+       {
+           int off;
+           char *s, *e;
+
+           if (pathname[0] != '/' && pathname[0] != '\\')
+               croak("Relative UNIX domain socket name '%s' unsupported", pathname);
+           else if (len < 8 
+                    || pathname[7] != '/' && pathname[7] != '\\'
+                    || !strnicmp(pathname + 1, "socket", 6))
+               off = 7;
+           else
+               off = 0;                /* Preserve names starting with \socket\ */
+           Copy( "\\socket", sun_ad.sun_path, off, char);
+           Copy( pathname, sun_ad.sun_path + off, len, char );
+
+           s = sun_ad.sun_path + off - 1;
+           e = s + len + 1;
+           while (++s < e)
+               if (*s = '/')
+                   *s = '\\';
+       }
+#  else        /* !( defined OS2 ) */ 
        Copy( pathname, sun_ad.sun_path, len, char );
+#  endif
        ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
 #else
        ST(0) = (SV *) not_here("pack_sockaddr_un");

diff --git a/os2/os2ish.h b/os2/os2ish.h
index cfd13c8..6993dfc 100644 (file)
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -68,6 +68,13 @@
 
 #define BIT_BUCKET "/dev/nul"  /* Will this work? */
 
+/* Apparently TCPIPV4 defines may be included even with only IAK present */
+
+#if !defined(NO_TCPIPV4) && !defined(TCPIPV4)
+#  define TCPIPV4
+#  define TCPIPV4_FORCED               /* Just in case */
+#endif
+
 #if defined(I_SYS_UN) && !defined(TCPIPV4)
 /* It is not working without TCPIPV4 defined. */
 # undef I_SYS_UN

diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t
index 2dd32c9..e1c89c4 100644 (file)
--- a/t/lib/io_unix.t
+++ b/t/lib/io_unix.t
@@ -39,12 +39,12 @@ BEGIN {
 $PATH = "/tmp/sock-$$";
 
 # Test if we can create the file within the tmp directory
-if (-e $PATH or not open(TEST, ">$PATH")) {
-    print "1..0\n";
+if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
+    print "1..0 # Skip: cannot open '$PATH' for write\n";
     exit 0;
 }
 close(TEST);
-unlink($PATH) or die "Can't unlink $PATH: $!";
+unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
 
 # Start testing
 $| = 1;
@@ -67,7 +67,7 @@ if($pid = fork()) {
     $sock->close;
 
     waitpid($pid,0);
-    unlink($PATH) || warn "Can't unlink $PATH: $!";
+    unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
 
     print "ok 5\n";