Front page | perl.perl5.porters |
Postings from October 2003
Re: Bug: sockaddr_un() and abstract unix domain sockets
Thread Previous
|
Thread Next
From:
Rafael Garcia-Suarez
Date:
October 14, 2003 08:51
Subject:
Re: Bug: sockaddr_un() and abstract unix domain sockets
Message ID:
20031014174505.5697e996.rgarciasuarez@free.fr
Alex Hudson wrote:
>
> Attempting to write some IPC code this weekend was slightly stymied, by
> the need to connect to an abstract unix domain socket using Perl - it
> doesn't appear to work.
>
> Abstract unix domain sockets are like unix domain sockets, but don't
> exist on the filesystem fully (although they do appear to inherit
> permissions). They exist on Linux versions 2.2+. The following test I
> wrote appears to show my problem on 5.8.1:
[snip]
> Hopefully that shows roughly what the problem is. The special
> incantation to make something 'abstract' is to put the 'abstract' byte
> at the start of the filename - hence the chr(0) line. sockaddr_un fails
> to understand this, and passes back something which isn't valid.
(First time I hear about this.) Thanks ; your proposed patch breaks the
Socket.pm interface, so it's not suitable for inclusion into perl ;
however, I rewrote it as pasted below (and kept your test case :) Does
it work for you ?
Without further comments I'm going to apply it.
Index: ext/Socket/Socket.xs
===================================================================
--- ext/Socket/Socket.xs (revision 2694)
+++ ext/Socket/Socket.xs (working copy)
@@ -297,17 +297,18 @@ sockaddr_family(sockaddr)
ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
void
-pack_sockaddr_un(pathname)
- char * pathname
+pack_sockaddr_un(pathname_sv)
+ SV * pathname_sv
CODE:
{
#ifdef I_SYS_UN
struct sockaddr_un sun_ad; /* fear using sun */
STRLEN len;
+ char * pathname;
Zero( &sun_ad, sizeof sun_ad, char );
sun_ad.sun_family = AF_UNIX;
- len = strlen(pathname);
+ pathname = SvPV(pathname_sv,len);
if (len > sizeof(sun_ad.sun_path))
len = sizeof(sun_ad.sun_path);
# ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
@@ -372,7 +373,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
Index: ext/Socket/t/Socket.t
===================================================================
--- ext/Socket/t/Socket.t (revision 2694)
+++ ext/Socket/t/Socket.t (working copy)
@@ -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
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";
+}
End.
Thread Previous
|
Thread Next