=== modified file 'lib/IO/Socket/IP.pm'
--- lib/IO/Socket/IP.pm 2012-02-15 23:09:32 +0000
+++ lib/IO/Socket/IP.pm 2012-02-17 00:10:30 +0000
@@ -15,6 +15,7 @@
use Socket 1.97 qw(
getaddrinfo getnameinfo
+ sockaddr_family
AF_INET
AI_PASSIVE
IPPROTO_TCP IPPROTO_UDP
@@ -627,6 +628,22 @@
return ( $host, $service );
}
+sub _unpack_sockaddr
+{
+ my ( $addr ) = @_;
+ my $family = sockaddr_family $addr;
+
+ if( $family == AF_INET ) {
+ return ( Socket::unpack_sockaddr_in $addr )[1];
+ }
+ elsif( defined $AF_INET6 and $family == $AF_INET6 ) {
+ return ( Socket::unpack_sockaddr_in6 $addr )[1];
+ }
+ else {
+ croak "Unrecognised address family $family";
+ }
+}
+
=head2 ( $host, $service ) = $sock->sockhost_service( $numeric )
Returns the hostname and service name of the local address (that is, the
@@ -652,7 +669,7 @@
=head2 $addr = $sock->sockhost
-Return the numeric form of the local address
+Return the numeric form of the local address as a textual representation
=head2 $port = $sock->sockport
@@ -674,6 +691,14 @@
sub sockhostname { my $self = shift; ( $self->_get_host_service( $self->sockname, 0, NIx_NOSERV ) )[0] }
sub sockservice { my $self = shift; ( $self->_get_host_service( $self->sockname, 0, NIx_NOHOST ) )[1] }
+=head2 $addr = $sock->sockaddr
+
+Return the local address as a binary octet string
+
+=cut
+
+sub sockaddr { my $self = shift; _unpack_sockaddr $self->sockname }
+
=head2 ( $host, $service ) = $sock->peerhost_service( $numeric )
Returns the hostname and service name of the peer address (that is, the
@@ -697,7 +722,7 @@
=head2 $addr = $sock->peerhost
-Return the numeric form of the peer address
+Return the numeric form of the peer address as a textual representation
=head2 $port = $sock->peerport
@@ -719,6 +744,14 @@
sub peerhostname { my $self = shift; ( $self->_get_host_service( $self->peername, 0, NIx_NOSERV ) )[0] }
sub peerservice { my $self = shift; ( $self->_get_host_service( $self->peername, 0, NIx_NOHOST ) )[1] }
+=head2 $addr = $peer->peeraddr
+
+Return the peer address as a binary octet string
+
+=cut
+
+sub peeraddr { my $self = shift; _unpack_sockaddr $self->peername }
+
# This unbelievably dodgy hack works around the bug that IO::Socket doesn't do
# it
#
https://rt.cpan.org/Ticket/Display.html?id=61577
=== modified file 't/01local-client-v4.t'
--- t/01local-client-v4.t 2011-03-16 12:38:26 +0000
+++ t/01local-client-v4.t 2012-02-17 00:10:30 +0000
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 16;
+use Test::More tests => 20;
use IO::Socket::IP;
@@ -45,6 +45,10 @@
is( $socket->peerhost, "127.0.0.1", "\$socket->peerhost for $socktype" );
is( $socket->peerport, $testserver->sockport, "\$socket->peerport for $socktype" );
+ # Unpack just so it pretty prints without wrecking the terminal if it fails
+ is( unpack("H*", $socket->sockaddr), "7f000001", "\$socket->sockaddr for $socktype" );
+ is( unpack("H*", $socket->peeraddr), "7f000001", "\$socket->peeraddr for $socktype" );
+
# Can't easily test the non-numeric versions without relying on the system's
# ability to resolve the name "localhost"
}
=== modified file 't/02local-server-v4.t'
--- t/02local-server-v4.t 2011-03-16 12:38:26 +0000
+++ t/02local-server-v4.t 2012-02-17 00:10:30 +0000
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 26;
+use Test::More tests => 30;
use IO::Socket::IP;
@@ -51,4 +51,8 @@
is( $testclient->sockport, $socket->peerport, "\$testclient->sockport for $socktype" );
is( $testclient->peerport, $socket->sockport, "\$testclient->peerport for $socktype" );
+
+ # Unpack just so it pretty prints without wrecking the terminal if it fails
+ is( unpack("H*", $testclient->sockaddr), "7f000001", "\$testclient->sockaddr for $socktype" );
+ is( unpack("H*", $testclient->peeraddr), "7f000001", "\$testclient->peeraddr for $socktype" );
}
=== modified file 't/04local-client-v6.t'
--- t/04local-client-v6.t 2012-02-03 17:14:46 +0000
+++ t/04local-client-v6.t 2012-02-17 00:10:30 +0000
@@ -12,7 +12,7 @@
eval { IO::Socket::IP->new( LocalHost => "::1" ) } or
plan skip_all => "Unable to bind to ::1";
-plan tests => 16;
+plan tests => 20;
# Unpack just ip6_addr and port because other fields might not match end to end
sub unpack_sockaddr_in6_addrport {
@@ -60,6 +60,10 @@
is( $socket->peerhost, "::1", "\$socket->peerhost for $socktype" );
is( $socket->peerport, $testport, "\$socket->peerport for $socktype" );
+ # Unpack just so it pretty prints without wrecking the terminal if it fails
+ is( unpack("H*", $socket->sockaddr), "0000"x7 . "0001", "\$socket->sockaddr for $socktype" );
+ is( unpack("H*", $socket->peeraddr), "0000"x7 . "0001", "\$socket->peeraddr for $socktype" );
+
# Can't easily test the non-numeric versions without relying on the system's
# ability to resolve the name "localhost"
}
=== modified file 't/05local-server-v6.t'
--- t/05local-server-v6.t 2012-02-03 17:14:46 +0000
+++ t/05local-server-v6.t 2012-02-17 00:10:30 +0000
@@ -12,7 +12,7 @@
eval { IO::Socket::IP->new( LocalHost => "::1" ) } or
plan skip_all => "Unable to bind to ::1";
-plan tests => 26;
+plan tests => 30;
# Unpack just ip6_addr and port because other fields might not match end to end
sub unpack_sockaddr_in6_addrport {
@@ -64,4 +64,8 @@
is( $testclient->sockport, $peerport, "\$testclient->sockport for $socktype" );
is( $testclient->peerport, $sockport, "\$testclient->peerport for $socktype" );
+
+ # Unpack just so it pretty prints without wrecking the terminal if it fails
+ is( unpack("H*", $testclient->sockaddr), "0000"x7 . "0001", "\$testclient->sockaddr for $socktype" );
+ is( unpack("H*", $testclient->peeraddr), "0000"x7 . "0001", "\$testclient->peeraddr for $socktype" );
}
