From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Sat, 29 May 1999 20:18:13 +0000 (-0400)
Subject: OS/2 socket fixes.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=202975e60ee076fd8796877b28774137051a97c4;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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";