Bug#523846: libnet-server-perl: better patch

[sean finney]

Package: libnet-server-perl
Version: 0.97-1.1
Severity: normal

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

tags 523846 patch
thanks

hi,

i was doing some digging into this issue myself, and found that the patch
from the munin BR doesn't work (as mentioned in the munin BR, something more
needs to be done wrt unpacking the sockaddr_in's).

i stumbled across a more complete patch that someone else had thrown together,
though it was against a slightly older version of the codebase.  so i've
updated and massaged the code a bit, and have a patch that works for my
purposes (attached).  further comments can be found in the patch contents.


        sean

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)

iD8DBQFJ/rLtynjLPm522B0RAnjvAJ9k+HAsAqRGP3GpP1Ofh7KzwknK2gCcCb+/
sKozhCh0CVWdbarLJ1WDu+A=
=gzWu
-----END PGP SIGNATURE-----

#! /bin/sh /usr/share/dpatch/dpatch-run
## 03_ipv6-support.dpatch: ipv6 support in Net::Server
##
## DP: this patch was originally found at
## DP:   http://dev.fiqz.com/svn/fiqz/patches/perl-Net-Server-0.86-ipv6.patch
## DP:
## DP: it was then updated by sean finney <sean...@debian.org> to apply against
## DP: the latest version of Net-Server in debian, modified for new stricter 
## DP: perl syntax conventions, and a small bugfix to the original patch in
## DP: the last hunk.
@DPATCH@
diff -urNad libnet-server-perl-0.97~/lib/Net/Server/Proto/TCP.pm libnet-server-perl-0.97/lib/Net/Server/Proto/TCP.pm
--- libnet-server-perl-0.97~/lib/Net/Server/Proto/TCP.pm	2009-04-29 14:12:35.000000000 +0200
+++ libnet-server-perl-0.97/lib/Net/Server/Proto/TCP.pm	2009-04-29 14:12:40.000000000 +0200
@@ -24,9 +24,10 @@
 use strict;
 use vars qw($VERSION $AUTOLOAD @ISA);
 use IO::Socket ();
+use IO::Socket::INET6 ();
 
 $VERSION = $Net::Server::VERSION; # done until separated
-...@isa = qw(IO::Socket::INET);
+...@isa = qw(IO::Socket::INET6);
 
 sub object {
   my $type  = shift;
diff -urNad libnet-server-perl-0.97~/lib/Net/Server.pm libnet-server-perl-0.97/lib/Net/Server.pm
--- libnet-server-perl-0.97~/lib/Net/Server.pm	2009-04-29 14:12:35.000000000 +0200
+++ libnet-server-perl-0.97/lib/Net/Server.pm	2009-04-29 14:14:12.000000000 +0200
@@ -25,7 +25,8 @@
 
 use strict;
 use vars qw($VERSION);
-use Socket qw(inet_aton inet_ntoa AF_INET AF_UNIX SOCK_DGRAM SOCK_STREAM);
+use Socket qw(inet_aton inet_ntoa AF_INET AF_INET6 AF_UNIX SOCK_DGRAM SOCK_STREAM);
+use Socket6 ();
 use IO::Socket ();
 use IO::Select ();
 use POSIX ();
@@ -356,7 +357,7 @@
   push @{ $prop->{host} }, (($prop->{host}->[-1]) x (@{ $prop->{port} } - @{ $prop->{host}})); # augment hosts with as many as port
   foreach my $host (@{ $prop->{host} }) {
     $host = '*' if ! defined $host || ! length $host;;
-    $host = ($host =~ /^([\w\.\-\*\/]+)$/) ? $1 : $self->fatal("Unsecure host \"$host\"");
+    $host = ($host =~ /^([\[\]\:\w\.\-\*\/]+)$/) ? $1 : $self->fatal("Unsecure host \"$host\"");
   }
 
   $prop->{proto} = []               if ! defined $prop->{proto};
@@ -744,8 +745,8 @@
   my $sockname = getsockname( $sock );
   if( $sockname ){
     ($prop->{sockport}, $prop->{sockaddr})
-      = Socket::unpack_sockaddr_in( $sockname );
-    $prop->{sockaddr} = inet_ntoa( $prop->{sockaddr} );
+      = ((length($sockname) > 16) ? Socket6::unpack_sockaddr_in6( $sockname ) : Socket::unpack_sockaddr_in( $sockname ));
+    $prop->{sockaddr} = ((length($sockname) > 16) ? inet_ntop( AF_INET6, $prop->{sockaddr} ) : inet_ntoa( $prop->{sockaddr} ));
 
   }else{
     ### does this only happen from command line?
@@ -759,17 +760,17 @@
   if( $prop->{udp_true} ){
     $proto_type = 'UDP';
     ($prop->{peerport} ,$prop->{peeraddr})
-      = Socket::sockaddr_in( $prop->{udp_peer} );
+      = ((length($sockname) > 16) ? Socket6::unpack_sockaddr_in6( $prop->{udp_peer} ) : Socket::sockaddr_in( $prop->{udp_peer} ));
   }elsif( $prop->{peername} = getpeername( $sock ) ){
     ($prop->{peerport}, $prop->{peeraddr})
-      = Socket::unpack_sockaddr_in( $prop->{peername} );
+      = ((length($sockname) > 16) ? Socket6::unpack_sockaddr_in6( $prop->{peername} ) : Socket::unpack_sockaddr_in( $prop->{peername} ));
   }
 
   if( $prop->{peername} || $prop->{udp_true} ){
-    $prop->{peeraddr} = inet_ntoa( $prop->{peeraddr} );
+    $prop->{peeraddr} = ((length($sockname) > 16) ? inet_ntop( AF_INET6, $prop->{peeraddr} ) : inet_ntoa( $prop->{peeraddr} ));
 
     if( defined $prop->{reverse_lookups} ){
-      $prop->{peerhost} = gethostbyaddr( inet_aton($prop->{peeraddr}), AF_INET );
+      $prop->{peerhost} = ( (length($sockname) > 16) ? gethostbyaddr( inet_pton(AF_INET6, $prop->{peeraddr}), AF_INET6 ) : gethostbyaddr( inet_aton($prop->{peeraddr}), AF_INET ) );
     }
     $prop->{peerhost} = '' unless defined $prop->{peerhost};
 
@@ -1123,7 +1124,7 @@
       or $self->fatal("Can't dup socket [$!]");
 
     ### hold on to the socket copy until exec
-    $prop->{_HUP}->[$i] = IO::Socket::INET->new;
+    $prop->{_HUP}->[$i] = IO::Socket::INET6->new();
     $prop->{_HUP}->[$i]->fdopen($fd, 'w')
       or $self->fatal("Can't open to file descriptor [$!]");