From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Wed, 15 Oct 2003 06:47:11 +0000 (+0000)
Subject: Add support for Linux abstract unix domain sockets to Socket.pm.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7513c55b67d9e188cba73297143ae84a4902129b;p=p5sagit%2Fp5-mst-13.2.git

Add support for Linux abstract unix domain sockets to Socket.pm.
Based on a idea by Alex Hudson. (Basically those are unix domain
sockets whose name has a '\0' as first character.)

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

diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs
index 040dda4..d2c0ae5 100644
--- a/ext/Socket/Socket.xs
+++ b/ext/Socket/Socket.xs
@@ -298,16 +298,17 @@ sockaddr_family(sockaddr)
 
 void
 pack_sockaddr_un(pathname)
-	char *	pathname
+	SV *	pathname
 	CODE:
 	{
 #ifdef I_SYS_UN
 	struct sockaddr_un sun_ad; /* fear using sun */
 	STRLEN len;
+	char * pathname_pv;
 
 	Zero( &sun_ad, sizeof sun_ad, char );
 	sun_ad.sun_family = AF_UNIX;
-	len = strlen(pathname);
+	pathname_pv = SvPV(pathname,len);
 	if (len > sizeof(sun_ad.sun_path))
 	    len = sizeof(sun_ad.sun_path);
 #  ifdef OS2	/* Name should start with \socket\ and contain backslashes! */
@@ -315,16 +316,17 @@ pack_sockaddr_un(pathname)
 	    int off;
 	    char *s, *e;
 
-	    if (pathname[0] != '/' && pathname[0] != '\\')
-		croak("Relative UNIX domain socket name '%s' unsupported", pathname);
+	    if (pathname_pv[0] != '/' && pathname_pv[0] != '\\')
+		croak("Relative UNIX domain socket name '%s' unsupported",
+			pathname_pv);
 	    else if (len < 8
-		     || pathname[7] != '/' && pathname[7] != '\\'
-		     || !strnicmp(pathname + 1, "socket", 6))
+		     || pathname_pv[7] != '/' && pathname_pv[7] != '\\'
+		     || !strnicmp(pathname_pv + 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 );
+	    Copy( pathname_pv, sun_ad.sun_path + off, len, char );
 
 	    s = sun_ad.sun_path + off - 1;
 	    e = s + len + 1;
@@ -333,7 +335,7 @@ pack_sockaddr_un(pathname)
 		    *s = '\\';
 	}
 #  else	/* !( defined OS2 ) */
-	Copy( pathname, sun_ad.sun_path, len, char );
+	Copy( pathname_pv, sun_ad.sun_path, len, char );
 #  endif
 	if (0) not_here("dummy");
 	ST(0) = sv_2mortal(newSVpvn((char *)&sun_ad, sizeof sun_ad));
@@ -372,7 +374,10 @@ unpack_sockaddr_un(sun_sv)
 			AF_UNIX);
 	}
 	e = (char*)addr.sun_path;
-	while (*e && e < (char*)addr.sun_path + sizeof addr.sun_path)
+	/* On Linux, the name of abstract unix domain sockets begins
+	 * with a '\0', so allow this. */
+	while ((*e || e == addr.sun_path && e[1] && sockaddrlen > 1)
+		&& e < (char*)addr.sun_path + sizeof addr.sun_path)
 	    ++e;
 	ST(0) = sv_2mortal(newSVpvn(addr.sun_path, e - (char*)addr.sun_path));
 #else
diff --git a/ext/Socket/t/Socket.t b/ext/Socket/t/Socket.t
index dba6cf3..b8d6ab0 100755
--- a/ext/Socket/t/Socket.t
+++ b/ext/Socket/t/Socket.t
@@ -14,7 +14,7 @@ BEGIN {
 	
 use Socket;
 
-print "1..16\n";
+print "1..17\n";
 
 $has_echo = $^O ne 'MSWin32';
 $alarmed = 0;
@@ -149,3 +149,21 @@ if (sockaddr_family(pack_sockaddr_in(100,inet_aton("10.250.230.10"))) == AF_INET
 
 eval { sockaddr_family("") };
 print (($@ =~ /^Bad arg length for Socket::sockaddr_family, length is 0, should be at least \d+/) ? "ok 16\n" : "not ok 16\n");
+
+if ($^O eq 'linux') {
+    # see if we can handle abstract sockets
+    my $test_abstract_socket = chr(0) . '/tmp/test-perl-socket';
+    my $addr = sockaddr_un ($test_abstract_socket);
+    my ($path) = sockaddr_un ($addr);
+    if ($test_abstract_socket eq $path) {
+        print "ok 17\n";
+    }
+    else {
+	$path =~ s/\0/\\0/g;
+	print "# got <$path>\n";
+        print "not ok 17\n";
+    }
+} else {
+    # doesn't have abstract socket support
+    print "ok 17 - skipped on this platform\n";
+}