| Subject: | pack_sockaddr_un silently truncates overload socket paths |
Originally:
https://rt.perl.org/Ticket/Display.html?id=128095
The failure in the ticket above appears to be caused by the socket name being
too long, unfortunately pack_sockaddr_un() doesn't provide any information to
indicate that the path is too long, silently truncating the path instead.
The attached patch modifies pack_sockaddr_un() to throw an exception if the path
is too long to fit in sun_path.
This will allow the failing test to be modified to skip the test if an exception
is thrown on pack_sockaddr_un().
An alternative might be to export a constant defined as sizeof(sun_ad.sun_path)
so the failing test (and other users) can test if the path is too long.
Tony
| Subject: | Socket-long-unix-path.patch |
diff -ru Socket-2.023-orig/Socket.pm Socket-2.023/Socket.pm
--- Socket-2.023-orig/Socket.pm 2016-08-02 23:52:02.000000000 +1000
+++ Socket-2.023/Socket.pm 2016-08-10 15:10:37.010247724 +1000
@@ -239,7 +239,8 @@
Takes one argument, a pathname. Returns the C<sockaddr_un> structure with that
path packed in with C<AF_UNIX> filled in. For C<PF_UNIX> sockets, this
structure is normally what you need for the arguments in bind(), connect(),
-and send().
+and send(). Will croak if path is undefined or is too long to fit in the
+C<sun_path> member of the C<sockaddr_un>.
=head2 ($path) = unpack_sockaddr_un $sockaddr
diff -ru Socket-2.023-orig/Socket.xs Socket-2.023/Socket.xs
--- Socket-2.023-orig/Socket.xs 2016-08-02 01:04:27.000000000 +1000
+++ Socket-2.023/Socket.xs 2016-08-10 15:09:01.621620458 +1000
@@ -824,7 +824,7 @@
sun_ad.sun_family = AF_UNIX;
pathname_pv = SvPV(pathname,len);
if (len > sizeof(sun_ad.sun_path))
- len = sizeof(sun_ad.sun_path);
+ croak("Path too long for $s", "Socket::pack_sockaddr_un");
# ifdef OS2 /* Name should start with \socket\ and contain backslashes! */
{
int off;
diff -ru Socket-2.023-orig/t/sockaddr.t Socket-2.023/t/sockaddr.t
--- Socket-2.023-orig/t/sockaddr.t 2016-08-02 23:52:02.000000000 +1000
+++ Socket-2.023/t/sockaddr.t 2016-08-10 15:14:42.315860092 +1000
@@ -10,7 +10,7 @@
sockaddr_family
sockaddr_un
);
-use Test::More tests => 44;
+use Test::More tests => 45;
# inet_aton, inet_ntoa
{
@@ -131,7 +131,7 @@
# sockaddr_un
SKIP: {
# see if we can handle abstract sockets
- skip "Abstract AF_UNIX paths unsupported", 5 unless $^O eq "linux";
+ skip "Abstract AF_UNIX paths unsupported", 6 unless $^O eq "linux";
my $test_abstract_socket = chr(0) . '/org/perl/hello'. chr(0) . 'world';
my $addr = sockaddr_un ($test_abstract_socket);
@@ -148,6 +148,9 @@
ok( !eval { unpack_sockaddr_un( undef ); 1 },
'unpack_sockaddr_un undef is fatal' );
+ ok( !eval { pack_sockaddr_un( "x" x 0x10000 ); 1 },
+ 'pack_sockaddr_un(very long path) is fatal' );
+
is( $warnings, 0, 'undefined values produced no warnings' );
}