IO-Socket-INET6-2.71000755000764000764 012161600653 14320 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/MANIFEST000444000764000764 52012161600653 15563 0ustar00shlomifshlomif000000000000Build.PL ChangeLog inc/Test/Run/Builder.pm lib/IO/Socket/INET6.pm Makefile.PL MANIFEST META.yml Module meta-data (added by MakeMaker) README t/blocking.t t/configure6.t t/host6.t t/io_multihomed6.t t/io_sock6.t t/io_udp6.t t/listen_port_only.t t/pod-coverage.t t/pod.t t/style-trailing-space.t META.json IO-Socket-INET6-2.71/Build.PL000444000764000764 216012161600653 15750 0ustar00shlomifshlomif000000000000use strict; use warnings; use lib "./inc"; use Test::Run::Builder; my $build = Test::Run::Builder->new( 'module_name' => "IO::Socket::INET6", dist_version_from => 'lib/IO/Socket/INET6.pm', dist_abstract => 'Object interface for AF_INET/AF_INET6 domain sockets', 'requires' => { 'Carp' => 0, 'Errno' => 0, 'Exporter' => 0, 'IO::Socket' => 0, 'Socket' => 0, 'Socket6' => "0.12", 'strict' => 0, 'warnings' => 0, }, build_requires => { 'Test::More' => 0, }, configure_requires => { 'Module::Build' => '0.36', }, 'license' => "perl", create_makefile_pl => 'traditional', meta_merge => { resources => { repository => "https://bitbucket.org/shlomif/perl-io-socket-inet6", }, keywords => [ "inet6", "input", "internet", "ipv6", "network", "networking", "output", "socket", "sockets", ], }, ); $build->create_build_script; IO-Socket-INET6-2.71/ChangeLog000444000764000764 1557312161600653 16262 0ustar00shlomifshlomif0000000000002013-06-23 Shlomi Fish * Correct typos. - https://rt.cpan.org/Public/Bug/Display.html?id=86344 * New Release IO-Socket-INET6-2.71 2013-05-21 Shlomi Fish * Fix a typo: - https://rt.cpan.org/Ticket/Display.html?id=73143 * Add t/style-trailing-space.t and got rid of trailing space. * New Release IO-Socket-INET6-2.70 2011-11-28 Shlomi Fish * Fix the imports on t/io_multihomed6.t . - Fixes https://rt.cpan.org/Ticket/Display.html?id=72769 again. * Update the link to the repository in Build.PL. * New Release IO-Socket-INET6-2.69 2011-11-28 Shlomi Fish * Solved symbol clashes in t/io_multihomed6.t . - Fixes https://rt.cpan.org/Ticket/Display.html?id=72769 * New Release IO-Socket-INET6-2.68 2011-01-21 Shlomi Fish * IO-Socket is doing some imports so we now do use IO::Socket (). - Fixed the rest of the imports. * Thanks to LeoNerd * New Release IO-Socket-INET6-2.67 2011-01-13 Shlomi Fish * Made the use Socket call import constants selectively, and not rely on @EXPORT's whims: - http://www.cpantesters.org/cpan/report/d6e547be-19b5-11e0-bbdc-e5c0d6c987b5 * New Release IO-Socket-INET6-2.66 2010-06-11 Shlomi Fish * Add a fix for t/io_multihomed6.t to make sure ok 3 will be printed before ok 4. due to many failures in the tests. Such as: - http://www.cpantesters.org/cpan/report/07413426-b19f-3f77-b713-d32bba55d77f * New Release IO-Socket-INET6-2.65 2010-06-08 Shlomi Fish * Applied a patch to fix t/io_multihomed6.t on old Perls / old Linux distributions: - https://rt.cpan.org/Ticket/Display.html?id=58198 - Thanks to Paul. * New Release IO-Socket-INET6-2.64 2010-05-29 Shlomi Fish * Applied a modified patch to t/io_multihomed6.t to correct the test on Fedora 10 and others: - https://rt.cpan.org/Public/Bug/Display.html?id=57676 * New Release IO-Socket-INET6-2.63 2010-05-20 Shlomi Fish * Solved "problems with multihomed and family order" - https://rt.cpan.org/Ticket/Display.html?id=57676 - Thanks to Steffen Ullrich * New Release IO-Socket-INET6-2.62 2010-03-25 Shlomi Fish * Fix the inet_pton / inet_ntop import warnings: - https://rt.cpan.org/Ticket/Display.html?id=55901 - Thanks to Todd Rinaldo for the patch. * Fix listening on :: or 0.0.0.0 - a random address instead of the specified would be used. Added test listen_port_only.t - Regression from 2.57: - https://rt.cpan.org/Ticket/Display.html?id=54656 - Thanks to Steffen Ullrich for the patch. * New Release IO-Socket-INET6-2.60 * Fixes to t/listen_port_only.t. * New Release IO-Socket-INET6-2.61 2010-03-19 Shlomi Fish * Syntax change to adapt for older Perls: - https://rt.cpan.org/Ticket/Display.html?id=54656 - Thanks to paul. * New Release IO-Socket-INET6-2.59 2010-03-18 Shlomi Fish * Applied a patch by Steffen Ullrich, fixing: https://rt.cpan.org/Ticket/Display.html?id=54656 * New Release IO-Socket-INET6-2.58 2009-11-23 Shlomi Fish * Applied a modified version of a patch by Matthew Horsfall in order to add t/blocking.t and deal with the blocking sockets properly. * New Release IO-Socket-INET6-2.57 2008-10-06 Shlomi Fish * Applied a modified version of a patch by Anicka Bernathova : {{{ Previously IO-Socket-INET6 tried to bind even when one side is AF_INET and the other AF_INET6 and this cannot work. The FAMILY_CHECK loop is meant to make sure both sides have the same family. }}} * New Release IO-Socket-INET6-2.56 2008-09-24 Shlomi Fish * Fixed: http://rt.cpan.org/Ticket/Display.html?id=39550 : Problem with connect to IPv4 w/o given domain on FreeBSD6.1 (and other BSD systems). (Thanks to Steffen Ullrich) * New Release IO-Socket-INET6-2.55 2008-02-22 Shlomi Fish * Added pack_sockaddr_in6_all to the imports from Socket6 to fix the "configure" sub in several cases. Added t/configure6.t to test it. * New Release IO-Socket-INET6-2.54 2008-02-21 Shlomi Fish * Converted to Build.PL and placed INET6.pm under lib/. * Added a "repository" URL to the POD. * Added the pod.t and pod-coverage.t files and we now have full POD coverage. * Added more dependencies to the Build.PL. * Added the credit of "Shlomi Fish". * Changed the email address of Rafael to the new one in the ChangeLog and README files. * Someone reported that sockflow() and peerflow() were broken. The reason for that was that unpack_sockaddr_in6_all was not imported from Socket6. This release fixes it (with tests in t/host6.t). * New Release IO-Socket-INET6-2.53 2008-02-05 Shlomi Fish * New Release IO-Socket-INET6-2.52 * Added a test for peerhost() too. * Fixed sockhost() with the fact that inet_ntop() was not imported. - Added a test. * Added "use warnings" to IO::Socket::INET6. * Added a modified version of my patch (with more comments) to patch the problems I found in IO-Socket-INET6. (generating warnings upon using and failed tests.). 2004-18-10 Rafael Martinez Torres * New Release INET6-2.51 . * Patch from David Town - peeraddr(), sockaddr() methods implemented. - peerhost(), peerport(), sockhost(), sockport() improved efficiency. - New optional parameters: Local(Peer)Flow,Local(Peer)Scopeid. (Only for IPv6) - Local hack for MSWin32 platforms. 2003-12-12 Rafael Martinez Torres * New Release INET6-2.01 . * Patch from Wouter de Jong - fixing the parser on regexp at sock_info() * Patch from Olaf M.Kolkman - Toggle the -w flag to avoid some warning messages around tests * fixing peerhost method. 2003-11-24 Rafael Martinez Torres * New Release INET6-2.00 . Protocol independent IPv4-IPv6. * New paramter: Domain => AF_UNSPEC(def.),AF_INET,AF_INET6 * Replace _get_addr by getnameinfo() (RFC3493 deprecates getipnodeby() ) * sockaddr,peeraddr methods eliminated, (non IP-independent) * Improved test. 2003-07-24 Rafael Martinez Torres * New Release INET6-1.28 * Makefile.PL includes prerequisites: (min.) Socket6 0.12 * Fix _get_addr in INET6.pm to use Socket6::getipnodebyname. 2003-06-24 Rafael Martinez Torres * New Release INET6-1.27. * t/io_sock_inet6.t: New file for 'make test'. 2003-06-14 Rafael Martinez Torres * Patch from Masahito Omote . - Fix IPv6 address and port splitt bug. - Fix _get_addr in INET6.pm to use Socket6::getaddrinfo. 2003-06-05 Rafael Martinez Torres * Initial CPAN release. IO-Socket-INET6-2.71/Makefile.PL000444000764000764 116312161600653 16430 0ustar00shlomifshlomif000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4005 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'IO::Socket::INET6', 'VERSION_FROM' => 'lib/IO/Socket/INET6.pm', 'PREREQ_PM' => { 'Carp' => 0, 'Errno' => 0, 'Exporter' => 0, 'IO::Socket' => 0, 'Socket' => 0, 'Socket6' => '0.12', 'Test::More' => 0, 'strict' => 0, 'warnings' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; IO-Socket-INET6-2.71/META.yml000444000764000764 202512161600653 15725 0ustar00shlomifshlomif000000000000--- abstract: 'Object interface for AF_INET/AF_INET6 domain sockets' author: - ' and currently maintained by the Perl Porters.' - 'Modified by Rafael Martinez Torres and' - 'Modified further by Shlomi Fish , while disclaiming' build_requires: Test::More: 0 configure_requires: Module::Build: 0.36 dynamic_config: 1 generated_by: 'Module::Build version 0.4005, CPAN::Meta::Converter version 2.131560' keywords: - inet6 - input - internet - ipv6 - network - networking - output - socket - sockets license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: IO-Socket-INET6 provides: IO::Socket::INET6: file: lib/IO/Socket/INET6.pm version: 2.71 requires: Carp: 0 Errno: 0 Exporter: 0 IO::Socket: 0 Socket: 0 Socket6: 0.12 strict: 0 warnings: 0 resources: license: http://dev.perl.org/licenses/ repository: https://bitbucket.org/shlomif/perl-io-socket-inet6 version: 2.71 IO-Socket-INET6-2.71/META.json000444000764000764 324212161600653 16077 0ustar00shlomifshlomif000000000000{ "abstract" : "Object interface for AF_INET/AF_INET6 domain sockets", "author" : [ " and currently maintained by the Perl Porters.", "Modified by Rafael Martinez Torres and", "Modified further by Shlomi Fish , while disclaiming" ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4005, CPAN::Meta::Converter version 2.131560", "keywords" : [ "inet6", "input", "internet", "ipv6", "network", "networking", "output", "socket", "sockets" ], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "IO-Socket-INET6", "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.36" } }, "runtime" : { "requires" : { "Carp" : "0", "Errno" : "0", "Exporter" : "0", "IO::Socket" : "0", "Socket" : "0", "Socket6" : "0.12", "strict" : "0", "warnings" : "0" } } }, "provides" : { "IO::Socket::INET6" : { "file" : "lib/IO/Socket/INET6.pm", "version" : "2.71" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://bitbucket.org/shlomif/perl-io-socket-inet6" } }, "version" : "2.71" } IO-Socket-INET6-2.71/README000444000764000764 223312161600653 15335 0ustar00shlomifshlomif000000000000IO::Socket::INET6 1. Abstract IO::Socket::INET6 provides an object interface to creating and using sockets in both AF_INET|AF_INET6 domain. It is built upon the IO::Socket interface and inherits all the methods defined by IO::Socket. WARNING: You should use this module mainly to program IPv6 domain. Most pobably future releases will not support AF_INET | AF_UNSPEC options, as the module seems to fail on some given corner cases. If you require IPv4, you are encouraged to use IO::Socket::INET from the application level. Be warned. 2. Install % perl Makefile.PL % make % make test # make install 3. AUTHOR and COPYRIGHT This program is based on IO::Socket::INET by Graham Barr and currently maintained by the Perl Porters. Modified by Rafael Martinez Torres and Euro6IX project. Further modified by Shlomi Fish . Copyright (c) 2003- Rafael Martinez Torres . Copyright (c) 2003- Euro6IX project. Copyright (c) 1996-8 Graham Barr . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. IO-Socket-INET6-2.71/lib000755000764000764 012161600653 15066 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/lib/IO000755000764000764 012161600653 15375 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/lib/IO/Socket000755000764000764 012161600653 16625 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/lib/IO/Socket/INET6.pm000444000764000764 4546112161600653 20177 0ustar00shlomifshlomif000000000000# IO::Socket::INET6.pm # # Copyright (c) 1997-8 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # Modified by Rafael Martinez-Torres # Euro6IX project (www.euro6ix.org) 2003. package IO::Socket::INET6; use strict; use warnings; our(@ISA, $VERSION); # Do it so we won't import any symbols from IO::Socket which it does export # by default: # # IO::Socket is stupidstupidstupid beyond belief. Despite being an # object class, it has an import method # So you have to use IO::Socket (); # Having done that, this test is now clean use IO::Socket (); use Socket (qw( AF_INET6 PF_INET6 SOCK_RAW SOCK_STREAM INADDR_ANY SOCK_DGRAM AF_INET SO_REUSEADDR SO_REUSEPORT AF_UNSPEC SO_BROADCAST sockaddr_in ) ); # IO::Socket and Socket already import stuff here - possibly AF_INET6 # and PF_INET6 so selectively import things from Socket6. use Socket6 ( qw(AI_PASSIVE getaddrinfo sockaddr_in6 unpack_sockaddr_in6_all pack_sockaddr_in6_all in6addr_any) ); use Carp; use Errno; @ISA = qw(IO::Socket); $VERSION = "2.71"; #Purpose: allow protocol independent protocol and original interface. my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; IO::Socket::INET6->register_domain( AF_INET6 ); my %socket_type = ( tcp => SOCK_STREAM, udp => SOCK_DGRAM, icmp => SOCK_RAW ); sub new { my $class = shift; unshift(@_, "PeerAddr") if @_ == 1; return $class->SUPER::new(@_); } # Parsing analysis: # addr,port,and proto may be syntactically related... sub _sock_info { my($addr,$port,$proto) = @_; my $origport = $port; my @proto = (); my @serv = (); if (defined $addr) { if (!Socket6::inet_pton(AF_INET6,$addr)) { if($addr =~ s,^\[([\da-fA-F:]+)\]:([\w\(\)/]+)$,$1,) { $port = $2; } elsif($addr =~ s,^\[(::[\da-fA-F.:]+)\]:([\w\(\)/]+)$,$1,) { $port = $2; } elsif($addr =~ s,^\[([\da-fA-F:]+)\],$1,) { $port = $origport; } elsif($addr =~ s,:([\w\(\)/]+)$,,) { $port = $1 } } } # $proto as "string". if(defined $proto && $proto =~ /\D/) { if(@proto = getprotobyname($proto)) { $proto = $proto[2] || undef; } else { $@ = "Bad protocol '$proto'"; return; } } if(defined $port) { my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef; my $pnum = ($port =~ m,^(\d+)$,)[0]; @serv = getservbyname($port, $proto[0] || "") if ($port =~ m,\D,); $port = $serv[2] || $defport || $pnum; unless (defined $port) { $@ = "Bad service '$origport'"; return; } $proto = (getprotobyname($serv[3]))[2] || undef if @serv && !$proto; } #printf "Selected port is $port and proto is $proto \n"; return ($addr || undef, $port || undef, $proto || undef, ); } sub _error { my $sock = shift; my $err = shift; { local($!); my $title = ref($sock).": "; $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); close($sock) if(defined fileno($sock)); } $! = $err; return undef; } sub configure { my($sock,$arg) = @_; $arg->{LocalAddr} = $arg->{LocalHost} if exists $arg->{LocalHost} && !exists $arg->{LocalAddr}; $arg->{PeerAddr} = $arg->{PeerHost} if exists $arg->{PeerHost} && !exists $arg->{PeerAddr}; my $family = $arg->{Domain}; # in case no local and peer is given we prefer AF_INET6 # because we are IO::Socket::INET6 $family ||= ! $arg->{LocalAddr} && ! $arg->{PeerAddr} && AF_INET6 || AF_UNSPEC; # parse Local* my ($laddr,$lport,$proto) = _sock_info( $arg->{LocalAddr}, $arg->{LocalPort}, $arg->{Proto} ) or return _error($sock, $!, "sock_info: $@"); $laddr ||= ''; $lport ||= 0; $proto ||= (getprotobyname('tcp'))[2]; # MSWin32 expects at least one of $laddr or $lport to be specified # and does not accept 0 for $lport if $laddr is specified. if ($^O eq 'MSWin32') { if ((!$laddr) && (!$lport)) { $laddr = ($family == AF_INET) ? '0.0.0.0' : '::'; $lport = ''; } elsif (!$lport) { $lport = ''; } } my $type = $arg->{Type} || $socket_type{(getprotobynumber($proto))[0]}; # parse Peer* my($rport,$raddr); unless(exists $arg->{Listen}) { ($raddr,$rport) = _sock_info( $arg->{PeerAddr}, $arg->{PeerPort}, $proto ) or return _error($sock, $!, "sock_info: $@"); } # find out all combinations of local and remote addr with # the same family my @lres = getaddrinfo($laddr,$lport,$family,$type,$proto,AI_PASSIVE); return _error($sock, $EINVAL, "getaddrinfo: $lres[0]") if @lres<5; my @rres; if ( defined $raddr ) { @rres = getaddrinfo($raddr,$rport,$family,$type,$proto); return _error($sock, $EINVAL, "getaddrinfo: $rres[0]") if @rres<5; } my @flr; if (@rres) { # Collect all combinations with the same family in lres and rres # the order we search should be defined by the order of @rres, # not @lres! for( my $r=0;$r<@rres;$r+=5 ) { for( my $l=0;$l<@lres;$l+=5) { my $fam_listen = $lres[$l]; next if $rres[$r] != $fam_listen; # must be same family push @flr,[ $fam_listen,$lres[$l+3],$rres[$r+3] ]; } } } else { for( my $l=0;$l<@lres;$l+=5) { my $fam_listen = $lres[$l]; my $lsockaddr = $lres[$l+3]; # collect only the binding side push @flr,[ $fam_listen,$lsockaddr ]; } } # try to bind and maybe connect # if multihomed try all combinations until success for my $flr (@flr) { my ($family,$lres,$rres) = @$flr; if ( $family == AF_INET6) { if ($arg->{LocalFlow} || $arg->{LocalScope}) { my @sa_in6 = unpack_sockaddr_in6_all($lres); $sa_in6[1] = $arg->{LocalFlow} || 0; $sa_in6[3] = _scope_ntohl($arg->{LocalScope}) || 0; $lres = pack_sockaddr_in6_all(@sa_in6); } } $sock->socket($family, $type, $proto) or return _error($sock, $!, "socket: $!"); if (defined $arg->{Blocking}) { defined $sock->blocking($arg->{Blocking}) or return _error($sock, $!, "sockopt: $!"); } if ($arg->{Reuse} || $arg->{ReuseAddr}) { $sock->sockopt(SO_REUSEADDR,1) or return _error($sock, $!, "sockopt: $!"); } if ($arg->{ReusePort}) { $sock->sockopt(SO_REUSEPORT,1) or return _error($sock, $!, "sockopt: $!"); } if ($arg->{Broadcast}) { $sock->sockopt(SO_BROADCAST,1) or return _error($sock, $!, "sockopt: $!"); } if ( $family == AF_INET ) { my ($p,$a) = sockaddr_in($lres); $sock->bind($lres) or return _error($sock, $!, "bind: $!") if ($a ne INADDR_ANY or $p!=0); } else { my ($p,$a) = sockaddr_in6($lres); $sock->bind($lres) or return _error($sock, $!, "bind: $!") if ($a ne in6addr_any or $p!=0); } if(exists $arg->{Listen}) { $sock->listen($arg->{Listen} || 5) or return _error($sock, $!, "listen: $!"); } # connect only if PeerAddr and thus $rres is given last if ! $rres; if ( $family == AF_INET6) { if ($arg->{PeerFlow} || $arg->{PeerScope}) { my @sa_in6 = unpack_sockaddr_in6_all($rres); $sa_in6[1] = $arg->{PeerFlow} || 0; $sa_in6[3] = _scope_ntohl($arg->{PeerScope}) || 0; $rres = pack_sockaddr_in6_all(@sa_in6); } } undef $@; last if $sock->connect($rres); return _error($sock, $!, $@ || "Timeout") if ! $arg->{MultiHomed}; } return $sock; } sub _scope_ntohl($) { # As of Socket6 0.17 the scope field is incorrectly put into # network byte order when it should be in host byte order # in the sockaddr_in6 structure. We correct for that here. if ((Socket6->VERSION <= 0.17) && (pack('s', 0x1234) ne pack('n', 0x1234))) { unpack('N', pack('V', $_[0])); } else { $_[0]; } } sub sockdomain { my $sock = shift; $sock->SUPER::sockdomain(@_) || AF_INET6; } sub accept { my $sock = shift; my ($new, $peer) = $sock->SUPER::accept(@_); return unless defined($new); ${*$new}{io_socket_domain} = ${*$sock}{io_socket_domain}; ${*$new}{io_socket_type} = ${*$sock}{io_socket_type}; ${*$new}{io_socket_proto} = ${*$sock}{io_socket_proto}; return wantarray ? ($new, $peer) : $new; } sub bind { @_ == 2 or croak 'usage: $sock->bind(NAME) '; my $sock = shift; return $sock->SUPER::bind( shift ); } sub connect { @_ == 2 or croak 'usage: $sock->connect(NAME) '; my $sock = shift; return $sock->SUPER::connect( shift ); } sub sockaddr { @_ == 1 or croak 'usage: $sock->sockaddr()'; my ($sock) = @_; return undef unless (my $name = $sock->sockname); ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[1] : (sockaddr_in6($name))[1]; } sub sockport { @_ == 1 or croak 'usage: $sock->sockport()'; my($sock) = @_; return undef unless (my $name = $sock->sockname); ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[0] : (sockaddr_in6($name))[0]; } sub sockhost { @_ == 1 or croak 'usage: $sock->sockhost()'; my ($sock) = @_; return undef unless (my $addr = $sock->sockaddr); Socket6::inet_ntop($sock->sockdomain, $addr); } sub sockflow { @_ == 1 or croak 'usage: $sock->sockflow()'; my ($sock) = @_; return undef unless (my $name = $sock->sockname); ($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[1] : 0; } sub sockscope { @_ == 1 or croak 'usage: $sock->sockscope()'; my ($sock) = @_; return undef unless (my $name = $sock->sockname); _scope_ntohl(($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[3] : 0); } sub peeraddr { @_ == 1 or croak 'usage: $sock->peeraddr()'; my ($sock) = @_; return undef unless (my $name = $sock->peername); ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[1] : (sockaddr_in6($name))[1]; } sub peerport { @_ == 1 or croak 'usage: $sock->peerport()'; my($sock) = @_; return undef unless (my $name = $sock->peername); ($sock->sockdomain == AF_INET) ? (sockaddr_in($name))[0] : (sockaddr_in6($name))[0]; } sub peerhost { @_ == 1 or croak 'usage: $sock->peerhost()'; my ($sock) = @_; return undef unless (my $addr = $sock->peeraddr); Socket6::inet_ntop($sock->sockdomain, $addr); } sub peerflow { @_ == 1 or croak 'usage: $sock->peerflow()'; my ($sock) = @_; return undef unless (my $name = $sock->peername); _scope_ntohl(($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[1] : 0); } sub peerscope { @_ == 1 or croak 'usage: $sock->peerscope()'; my ($sock) = @_; return undef unless (my $name = $sock->peername); ($sock->sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[3] : 0; } 1; __END__ =head1 NAME IO::Socket::INET6 - Object interface for AF_INET/AF_INET6 domain sockets =head1 SYNOPSIS use IO::Socket::INET6; =head1 DESCRIPTION C provides an object interface to creating and using sockets in either AF_INET or AF_INET6 domains. It is built upon the L interface and inherits all the methods defined by L. =head1 CONSTRUCTOR =over 4 =item new ( [ARGS] ) Creates an C object, which is a reference to a newly created symbol (see the C package). C optionally takes arguments, these arguments are in key-value pairs. In addition to the key-value pairs accepted by L, C provides. Domain Address family AF_INET | AF_INET6 | AF_UNSPEC (default) PeerAddr Remote host address [:] PeerHost Synonym for PeerAddr PeerPort Remote port or service [()] | PeerFlow Remote flow information PeerScope Remote address scope LocalAddr Local host bind address hostname[:port] LocalHost Synonym for LocalAddr LocalPort Local host bind port [()] | LocalFlow Local host flow information LocalScope Local host address scope Proto Protocol name (or number) "tcp" | "udp" | ... Type Socket type SOCK_STREAM | SOCK_DGRAM | ... Listen Queue size for listen ReuseAddr Set SO_REUSEADDR before binding Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr) ReusePort Set SO_REUSEPORT before binding Broadcast Set SO_BROADCAST before binding Timeout Timeout value for various operations MultiHomed Try all addresses for multi-homed hosts Blocking Determine if connection will be blocking mode If C is defined then a listen socket is created, else if the socket type, which is derived from the protocol, is SOCK_STREAM then connect() is called. Although it is not illegal, the use of C on a socket which is in non-blocking mode is of little use. This is because the first connect will never fail with a timeout as the connect call will not block. The C can be a hostname, the IPv6-address on the "2001:800:40:2a05::10" form , or the IPv4-address on the "213.34.234.245" form. The C can be a number or a symbolic service name. The service name might be followed by a number in parenthesis which is used if the service is not known by the system. The C specification can also be embedded in the C by preceding it with a ":", and closing the IPv6 address on brackets "[]" if necessary: "124.678.12.34:23","[2a05:345f::10]:23","any.server.com:23". If C is not given, AF_UNSPEC is assumed, that is, both AF_INET and AF_INET6 will be both considered when resolving DNS names. AF_INET6 has priority. If you guess you are in trouble not reaching the peer,(the service is not available via AF_INET6 but AF_INET) you can either try Multihomed (try any address/family until reach) or concrete your address C (AF_INET, AF_INET6). If C is not given and you specify a symbolic C port, then the constructor will try to derive C from the service name. As a last resort C "tcp" is assumed. The C parameter will be deduced from C if not specified. If the constructor is only passed a single argument, it is assumed to be a C specification. If C is set to 0, the connection will be in nonblocking mode. If not specified it defaults to 1 (blocking mode). Examples: $sock = IO::Socket::INET6->new(PeerAddr => 'www.perl.org', PeerPort => 'http(80)', Proto => 'tcp'); Suppose either you have no IPv6 connectivity or www.perl.org has no http service on IPv6. Then, (Trying all address/families until reach) $sock = IO::Socket::INET6->new(PeerAddr => 'www.perl.org', PeerPort => 'http(80)', Multihomed => 1 , Proto => 'tcp'); (Concrete to IPv4 protocol) $sock = IO::Socket::INET6->new(PeerAddr => 'www.perl.org', PeerPort => 'http(80)', Domain => AF_INET , Proto => 'tcp'); $sock = IO::Socket::INET6->new(PeerAddr => 'localhost:smtp(25)'); $sock = IO::Socket::INET6->new(Listen => 5, LocalAddr => 'localhost', LocalPort => 9000, Proto => 'tcp'); $sock = IO::Socket::INET6->new('[::1]:25'); $sock = IO::Socket::INET6->new(PeerPort => 9999, PeerAddr => Socket6::inet_ntop(AF_INET6,in6addr_broadcast), Proto => udp, LocalAddr => 'localhost', Broadcast => 1 ) or die "Can't bind : $@\n"; NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE As of VERSION 1.18 all IO::Socket objects have autoflush turned on by default. This was not the case with earlier releases. NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE =back =head2 METHODS =over 4 =item accept () See L. =item bind () See L. =item configure () This function exists in this module, but I (= Shlomi Fish) don't know what it does, or understand it. It's also not tested anywhere. I'll be happy to be enlightened. =item connect () See L. =item sockaddr () Return the address part of the sockaddr structure for the socket =item sockdomain() Returns the domain of the socket - AF_INET or AF_INET6 or whatever. =item sockport () Return the port number that the socket is using on the local host =item sockhost () Return the address part of the sockaddr structure for the socket in a text form ("2001:800:40:2a05::10" or "245.245.13.27") =item sockflow () Return the flow information part of the sockaddr structure for the socket =item sockscope () Return the scope identification part of the sockaddr structure for the socket =item peeraddr () Return the address part of the sockaddr structure for the socket on the peer host =item peerport () Return the port number for the socket on the peer host. =item peerhost () Return the address part of the sockaddr structure for the socket on the peer host in a text form ("2001:800:40:2a05::10" or "245.245.13.27") =item peerflow () Return the flow information part of the sockaddr structure for the socket on the peer host =item peerscope () Return the scope identification part of the sockaddr structure for the socket on the peer host =back =head1 REPOSITORY The Subversion repository for this module carrying complete version history and other information is: L =head1 SEE ALSO L,L, L =head1 AUTHOR This program is based on L by Graham Barr and currently maintained by the Perl Porters. Modified by Rafael Martinez Torres and Euro6IX project. Modified further by Shlomi Fish , while disclaiming all copyrights. =head1 COPYRIGHT Copyright (c) 2003- Rafael Martinez Torres . Copyright (c) 2003- Euro6IX project. Copyright (c) 1996-8 Graham Barr . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut IO-Socket-INET6-2.71/inc000755000764000764 012161600653 15071 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/inc/Test000755000764000764 012161600653 16010 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/inc/Test/Run000755000764000764 012161600653 16554 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/inc/Test/Run/Builder.pm000444000764000764 316712161600653 20644 0ustar00shlomifshlomif000000000000package Test::Run::Builder; use strict; use warnings; use Module::Build; use vars qw(@ISA); @ISA = (qw(Module::Build)); sub ACTION_runtest { my ($self) = @_; my $p = $self->{properties}; $self->depends_on('code'); local @INC = @INC; # Make sure we test the module in blib/ unshift @INC, (File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'), File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')); $self->do_test_run_tests; } sub ACTION_distruntest { my ($self) = @_; $self->depends_on('distdir'); my $start_dir = $self->cwd; my $dist_dir = $self->dist_dir; chdir $dist_dir or die "Cannot chdir to $dist_dir: $!"; # XXX could be different names for scripts $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile or die "Error executing 'Build.PL' in dist directory: $!"; $self->run_perl_script('Build') or die "Error executing 'Build' in dist directory: $!"; $self->run_perl_script('Build', [], ['runtest']) or die "Error executing 'Build test' in dist directory"; chdir $start_dir; } sub do_test_run_tests { my $self = shift; require Test::Run::CmdLine::Iface; my $test_run = Test::Run::CmdLine::Iface->new( { 'test_files' => [glob("t/*.t")], } # 'backend_params' => $self->_get_backend_params(), ); return $test_run->run(); } sub ACTION_tags { return system(qw( ctags -f tags --recurse --totals --exclude=blib/** --exclude=t/lib/** --exclude=.svn --exclude='*~' --languages=Perl --langmap=Perl:+.t )); } 1; IO-Socket-INET6-2.71/t000755000764000764 012161600653 14563 5ustar00shlomifshlomif000000000000IO-Socket-INET6-2.71/t/blocking.t000444000764000764 230212161600653 16672 0ustar00shlomifshlomif000000000000#!/usr/bin/perl use strict; use warnings; use Config; BEGIN { if (-d "lib" && -f "TEST") { my $reason; if ($Config{'extensions'} !~ /\bSocket\b/) { $reason = 'Socket extension unavailable'; } elsif ($Config{'extensions'} !~ /\bIO\b/) { $reason = 'IO extension unavailable'; } if ($reason) { print "1..0 # Skip: $reason\n"; exit 0; } } if ($^O eq 'MSWin32') { print "1..0 # Skip: accept() fails for IPv6 under MSWin32\n"; exit 0; } } use Test::More; plan tests => 2; use IO::Socket::INET6; my $listen = IO::Socket::INET6->new(Listen => 2, Proto => 'tcp', Timeout => 15, Blocking => 0, ) or die "$@"; # TEST is($listen->blocking(), 0, 'Non-blocking works on listeners'); my $port = $listen->sockport; if(my $pid = fork()) { # Connect to ourselves with a non-blocking socket my $sock = IO::Socket::INET6->new(PeerAddr => '::1', PeerPort => $port, Blocking => 0); # TEST is($sock->blocking(), 0, 'Non-blocking works on outbound connections'); undef($sock); } elsif (defined $pid) { my $sock = $listen->accept(); my $line = <$sock>; $listen->close; exit; } else { die $!; } IO-Socket-INET6-2.71/t/host6.t000444000764000764 273312161600653 16155 0ustar00shlomifshlomif000000000000#!/usr/bin/perl use strict; use warnings; use Config; BEGIN { if (-d "lib" && -f "TEST") { my $reason; if (! $Config{'d_fork'}) { $reason = 'no fork'; } elsif ($Config{'extensions'} !~ /\bSocket\b/) { $reason = 'Socket extension unavailable'; } elsif ($Config{'extensions'} !~ /\bIO\b/) { $reason = 'IO extension unavailable'; } if ($reason) { print "1..0 # Skip: $reason\n"; exit 0; } } if ($^O eq 'MSWin32') { print "1..0 # Skip: accept() fails for IPv6 under MSWin32\n"; exit 0; } } use Test::More; use IO::Socket::INET6; my $listen = IO::Socket::INET6->new(Listen => 2, Proto => 'tcp', # some systems seem to need as much as 10, # so be generous with the timeout Timeout => 15, ) or die "$@"; # TEST my $sockhost = $listen->sockhost(); my $port = $listen->sockport; if(my $pid = fork()) { my $sock = $listen->accept(); my $line = <$sock>; $listen->close; exit; } elsif (defined $pid) { plan tests => 4; # child, try various ways to connect my $sock = IO::Socket::INET6->new("[::1]:$port"); # TEST ok ($sockhost, "Checking for sockhost() success"); # TEST ok ($sock->peerhost(), "Checking for peerhost() success"); # TEST is ($sock->sockflow(), 0, "Checking for sockflow() success"); # TEST is ($sock->peerflow(), 0, "Checking for peerflow() success"); print {$sock} "H\n"; undef($sock); } else { die $!; } IO-Socket-INET6-2.71/t/style-trailing-space.t000444000764000764 74212161600653 21130 0ustar00shlomifshlomif000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::TrailingSpace"; if ($@) { plan skip_all => "Test::TrailingSpace required for trailing space test."; } else { plan tests => 1; } my $finder = Test::TrailingSpace->new( { root => '.', filename_regex => qr/(?:(?:\.(?:t|pm|pl|PL|yml|json|arc|vim))|README|Changes|LICENSE|MANIFEST|ChangeLog)\z/, }, ); # TEST $finder->no_trailing_space( "No trailing space was found." ); IO-Socket-INET6-2.71/t/io_sock6.t000444000764000764 1654612161600653 16655 0ustar00shlomifshlomif000000000000#!./perl -w use strict; BEGIN { unless(grep /blib/, @INC) { chdir 't' if -d 't'; @INC = '../lib'; } } use Config; BEGIN { if (-d "lib" && -f "TEST") { my $reason; if (! $Config{'d_fork'}) { $reason = 'no fork'; } elsif ($Config{'extensions'} !~ /\bSocket\b/) { $reason = 'Socket extension unavailable'; } elsif ($Config{'extensions'} !~ /\bIO\b/) { $reason = 'IO extension unavailable'; } if ($reason) { print "1..0 # Skip: $reason\n"; exit 0; } } if ($^O eq 'MSWin32') { print "1..0 # Skip: accept() fails for IPv6 under MSWin32\n"; exit 0; } } $| = 1; print "1..20\n"; eval { $SIG{ALRM} = sub { die; }; alarm 120; }; use IO::Socket::INET6; my $listen = IO::Socket::INET6->new(Listen => 2, Proto => 'tcp', # some systems seem to need as much as 10, # so be generous with the timeout Timeout => 15, ) or die "$@"; print "ok 1\n"; # Check if can fork with dynamic extensions (bug in CRT): if ($^O eq 'os2' and system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") { print "ok $_ # skipped: broken fork\n" for 2..5; exit 0; } my $port = $listen->sockport; my ($pid, $sock); if($pid = fork()) { $sock = $listen->accept() or die "accept failed: $!"; print "ok 2\n"; $sock->autoflush(1); print $sock->getline(); print $sock "ok 4\n"; $sock->close; waitpid($pid,0); print "ok 5\n"; } elsif(defined $pid) { $sock = IO::Socket::INET6->new(PeerPort => $port, Proto => 'tcp', PeerAddr => 'localhost' ) || IO::Socket::INET6->new(PeerPort => $port, Proto => 'tcp', PeerAddr => '::1' ) or die "$! (maybe your system does not have a localhost at all, 'localhost' or ::1)"; $sock->autoflush(1); print $sock "ok 3\n"; print $sock->getline(); $sock->close; exit; } else { die; } # Test various other ways to create INET sockets that should # also work. $listen = IO::Socket::INET6->new(Listen => '', Timeout => 15) or die "$@"; $port = $listen->sockport; if($pid = fork()) { SERVER_LOOP: while (1) { last SERVER_LOOP unless $sock = $listen->accept; while (<$sock>) { last SERVER_LOOP if /^quit/; last if /^done/; print; } $sock = undef; } $listen->close; } elsif (defined $pid) { # child, try various ways to connect $sock = IO::Socket::INET6->new("localhost:$port") || IO::Socket::INET6->new("[::1]:$port"); if ($sock) { print "not " unless $sock->connected; print "ok 6\n"; $sock->print("ok 7\n"); sleep(1); print "ok 8\n"; $sock->print("ok 9\n"); $sock->print("done\n"); $sock->close; } else { print "# $@\n"; print "not ok 6\n"; print "not ok 7\n"; print "not ok 8\n"; print "not ok 9\n"; } # some machines seem to suffer from a race condition here sleep(2); $sock = IO::Socket::INET6->new("[::1]:$port"); if ($sock) { $sock->print("ok 10\n"); $sock->print("done\n"); $sock->close; } else { print "# $@\n"; print "not ok 10\n"; } # some machines seem to suffer from a race condition here sleep(1); $sock = IO::Socket->new(Domain => AF_INET6, PeerAddr => "localhost:$port") || IO::Socket->new(Domain => AF_INET6, PeerAddr => "[::1]:$port"); if ($sock) { $sock->print("ok 11\n"); $sock->print("quit\n"); } else { print "not ok 11\n"; } $sock = undef; sleep(1); exit; } else { die; } # Then test UDP sockets # Test the numeric address directly because "localhost" usually maps # to an IPv4 address. my $server = IO::Socket->new( Domain => AF_INET6, Proto => 'udp', LocalAddr => '::1'); $port = $server->sockport; if ($^O eq 'mpeix') { print("ok 12 # skipped\n") } else { if ($pid = fork()) { my $buf; $server->recv($buf, 100); print $buf; } elsif (defined($pid)) { #child # Test the numeric address directly because "localhost" usually maps # to an IPv4 address. $sock = IO::Socket::INET6->new(Proto => 'udp', Domain => AF_INET6, PeerAddr => "[::1]:$port"); $sock->send("ok 12\n"); sleep(1); $sock->send("ok 12\n"); exit; } else { die; } } print "not " unless $server->blocking; print "ok 13\n"; if ( $^O eq 'qnx' ) { # QNX library bug: Can set non-blocking on socket, but # cannot return that status. print "ok 14 # skipped\n"; } else { $server->blocking(0); print "not " if $server->blocking; print "ok 14\n"; } ### TEST 15 ### Set up some data to be transfered between the server and ### the client. We'll use own source code ... # my @data; if( !open( SRC, "< $0")) { print "not ok 15 - $!"; } else { @data = ; close( SRC); } print "ok 15\n"; ### TEST 16 ### Start the server # $listen = IO::Socket::INET6->new( Listen => 2, Proto => 'tcp', Timeout => 15) || print "not "; print "ok 16\n"; die if( !defined( $listen)); my $serverport = $listen->sockport; my $server_pid = fork(); if( $server_pid) { ### TEST 17 Client/Server establishment # print "ok 17\n"; ### TEST 18 ### Get data from the server using a single stream # $sock = IO::Socket::INET6->new("localhost:$serverport") || IO::Socket::INET6->new("[::1]:$serverport"); if ($sock) { $sock->print("send\n"); my @array = (); while( <$sock>) { push( @array, $_); } $sock->print("done\n"); $sock->close; print "not " if( @array != @data); } else { print "not "; } print "ok 18\n"; ### TEST 19 ### Get data from the server using a stream, which is ### interrupted by eof calls. ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof ### did an getc followed by an ungetc in order to check for the streams ### end. getc(3) got replaced by the SOCKS funktion, which ended up in ### a recv(2) call on the socket, while ungetc(3) put back a character ### to an IO buffer, which never again was read. # if ($^O eq 'mpeix') { print "ok 19 # skipped: broken on MPE/iX\n"; } else { $sock = IO::Socket::INET6->new("localhost:$serverport") || IO::Socket::INET6->new("[::1]:$serverport"); if ($sock) { $sock->print("send\n"); my @array = (); while( !eof( $sock ) ){ while( <$sock>) { push( @array, $_); last; } } $sock->print("done\n"); $sock->close; print "not " if( @array != @data); } else { print "not "; } print "ok 19\n"; } ### TEST 20 ### Stop the server # $sock = IO::Socket::INET6->new("localhost:$serverport") || IO::Socket::INET6->new("[::1]:$serverport"); if ($sock) { $sock->print("done\n"); $sock->close; print "not " if( 1 != kill 0, $server_pid); } else { print "not "; } print "ok 20\n"; } elsif( defined( $server_pid)) { ### Child # SERVER_LOOP: while (1) { last SERVER_LOOP unless $sock = $listen->accept; while (<$sock>) { last SERVER_LOOP if /^quit/; last if /^done/; if( /^send/) { print $sock @data; last; } print; } $sock = undef; } $listen->close; } else { ### Fork failed # print "not ok 17\n"; die; } IO-Socket-INET6-2.71/t/listen_port_only.t000444000764000764 137212161600653 20513 0ustar00shlomifshlomif000000000000#!/usr/bin/perl use strict; use warnings; use IO::Socket::INET6; use Test::More; my ($server,$port); # try to create inet6 listener on some port, w/o given # LocalHost (should use :: then) CREATE_SERVER: for my $i (1 .. 100) { $port = int(rand(50000)+2000); $server = IO::Socket::INET6->new( LocalPort => $port, Listen => 10, ); if ($server) { last CREATE_SERVER; } } if (!$server) { plan skip_all => "failed to create inet6 listener"; } elsif ( $server->sockhost ne '::' ) { plan skip_all => "not listening on ::, maybe inet6 not available"; } else { plan tests => 1; my $client = IO::Socket::INET6->new( "[::1]:$port" ); # TEST ok($client, "Client was initialised - connected."); } IO-Socket-INET6-2.71/t/configure6.t000444000764000764 66412161600653 17142 0ustar00shlomifshlomif000000000000use strict; use warnings; use Test::More tests => 1; use IO::Socket::INET6; #funny IPv6 addresses my $srv = "dead:beef::1"; my $port = 6789; my $srvFlow = 4321; my $sck6 = IO::Socket::INET6->new( Domain => AF_INET6, Proto => 'tcp', LocalAddr => $srv, LocalPort => $port, LocalFlow => $srvFlow, Listen => 1, ReuseAddr => 1 ); # TEST ok(1, q{Testing that "sub configure" does not fail}); IO-Socket-INET6-2.71/t/pod-coverage.t000444000764000764 25412161600653 17441 0ustar00shlomifshlomif000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); IO-Socket-INET6-2.71/t/pod.t000444000764000764 21412161600653 15644 0ustar00shlomifshlomif000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); IO-Socket-INET6-2.71/t/io_multihomed6.t000444000764000764 1172112161600653 20053 0ustar00shlomifshlomif000000000000#!/usr/bin/env perl use strict; use warnings; BEGIN { unless(grep /blib/, @INC) { chdir 't' if -d 't'; unshift @INC,'../lib'; } } use Config; BEGIN { if(-d "lib" && -f "TEST") { my $reason; if (! $Config{'d_fork'}) { $reason = 'no fork'; } elsif ($Config{'extensions'} !~ /\bSocket\b/) { $reason = 'Socket extension unavailable'; } elsif ($Config{'extensions'} !~ /\bSocket6\b/) { $reason = 'Socket6 extension unavailable'; } elsif ($Config{'extensions'} !~ /\bIO\b/) { $reason = 'IO extension unavailable'; } if ($reason) { print "1..0 # SKIP $reason\n"; exit 0; } } if ($^O eq 'MSWin32') { print "1..0 # SKIP accept() fails for IPv6 under MSWin32\n"; exit 0; } } # check that localhost resolves to 127.0.0.1 and ::1 # otherwise the test will not work use Socket (qw( AF_INET6 PF_INET6 SOCK_RAW SOCK_STREAM INADDR_ANY SOCK_DGRAM AF_INET SO_REUSEADDR SO_REUSEPORT AF_UNSPEC SO_BROADCAST sockaddr_in unpack_sockaddr_in ) ); # IO::Socket and Socket already import stuff here - possibly AF_INET6 # and PF_INET6 so selectively import things from Socket6. use Socket6 ( qw(AI_PASSIVE getaddrinfo sockaddr_in6 unpack_sockaddr_in6 pack_sockaddr_in6_all in6addr_any inet_ntop ) ); { my %resolved_addresses; my @r = getaddrinfo('localhost',1); if (@r < 5) { print "1..0 # SKIP getaddrinfo('localhost',1) failed: $r[0]\n"; exit 0; } while (@r) { my @values = splice(@r,0,5); my ($fam,$addr) = @values[0,3]; $addr = ( ($fam == AF_INET) ? ( (unpack_sockaddr_in($addr))[1] ) : ( (unpack_sockaddr_in6($addr))[1] ) ); $resolved_addresses{inet_ntop($fam,$addr)}++; } if (! $resolved_addresses{'127.0.0.1'} || ! $resolved_addresses{'::1'}) { print "1..0 # SKIP localhost does not resolve to both 127.0.0.1 and ::1\n"; exit 0; } } # IO::Socket has an import method that is inherited by IO::Socket::INET6 , # and so we should instruct it not to import anything. use IO::Socket::INET6 (); $| = 1; print "1..8\n"; eval { $SIG{ALRM} = sub { die; }; alarm 60; }; # find out if the host prefers inet or inet6 by offering # both and checking where it connects my ($port,@srv); for my $addr ( '127.0.0.1','::1' ) { push @srv, IO::Socket::INET6->new( Listen => 2, LocalAddr => $addr, LocalPort => $port, ) or die "listen on $addr port $port: $!"; $port ||= $srv[-1]->sockport; } print "ok 1\n"; if (my $pid = fork()) { my $vec = ''; vec($vec,fileno($_),1) = 1 for(@srv); select($vec,undef,undef,5) or die $!; # connected to first, not second my ($first,$second) = vec($vec,fileno($srv[0]),1) ? @srv[0,1]:@srv[1,0]; my $cl = $first->accept or die $!; # listener should not work for next connect # so it needs to try second close($first); # make sure established connection works my $fam0 = ( $cl->sockdomain == AF_INET ) ? 'inet':'inet6'; print {$cl} "ok 2 # $fam0\n"; print $cl->getline(); # ok 3 # So we'll be sure ok 3 has already been printed. print {$cl} "Move on, will ya!\n"; close($cl); # ... ok 4 comes when client fails to connect to first # wait for connect on second and make sure it works $vec = ''; vec($vec,fileno($second),1) = 1; if ( select($vec,undef,undef,5)) { my $cl2 = $second->accept or die $!; my $fam1 = ( $cl2->sockdomain == AF_INET ) ? 'inet':'inet6'; print {$cl2} "ok 5 # $fam1\n"; print $cl2->getline(); # ok 6 close($cl2); # should be different families print "not " if $fam0 eq $fam1; print "ok 7\n"; } waitpid($pid,0); print "ok 8\n"; } elsif (defined $pid) { close($_) for (@srv); # should work because server is listening on inet and inet6 my $cl = IO::Socket::INET6->new( PeerPort => $port, PeerAddr => 'localhost', Timeout => 5, ) or die "$@"; print $cl->getline(); # ok 2 print {$cl} "ok 3\n"; # So we'll be sure ok 3 has already been printed. $cl->getline(); close($cl); # this should not work because listener is closed if ( $cl = IO::Socket::INET6->new( PeerPort => $port, PeerAddr => 'localhost', Timeout => 5, )) { print "not ok 4\n"; exit; } print "ok 4\n"; # but same thing with multihoming should work because server # is still listening on the other family $cl = IO::Socket::INET6->new( PeerPort => $port, PeerAddr => 'localhost', Timeout => 5, MultiHomed => 1, ) or do { print "not ok 5\n"; exit; }; print $cl->getline(); # ok 5 print {$cl} "ok 6\n"; exit; } else { die $!; # fork failed } IO-Socket-INET6-2.71/t/io_udp6.t000444000764000764 506712161600653 16462 0ustar00shlomifshlomif000000000000#!./perl BEGIN { unless(grep /blib/, @INC) { chdir 't' if -d 't'; @INC = '../lib'; } } use Config; BEGIN { if(-d "lib" && -f "TEST") { my $reason; if ($Config{'extensions'} !~ /\bSocket\b/) { $reason = 'Socket was not built'; } #if ($Config{'extensions'} !~ /\bSocket6\b/) { # $reason = 'Socket6 was not built'; #} elsif ($Config{'extensions'} !~ /\bIO\b/) { $reason = 'IO was not built'; } elsif ($^O eq 'apollo') { $reason = "unknown *FIXME*"; } undef $reason if $^O eq 'VMS' and $Config{d_socket}; if ($reason) { print "1..0 # Skip: $reason\n"; exit 0; } } } sub compare_addr { no utf8; my $a = shift; my $b = shift; if (length($a) != length $b) { my $min = (length($a) < length $b) ? length($a) : length $b; if ($min and substr($a, 0, $min) eq substr($b, 0, $min)) { printf "# Apparently: %d bytes junk at the end of %s\n# %s\n", abs(length($a) - length ($b)), $_[length($a) < length ($b) ? 1 : 0], "consider decreasing bufsize of recfrom."; substr($a, $min) = ""; substr($b, $min) = ""; } return 0; } # IO::Socket carps on errors if Perl's -w flag is # turned on. my $old_wflag = $^W; $^W = 0; my @a = getnameinfo($a,NI_NUMERICHOST | NI_NUMERICSERVER); my @b = getnameinfo($b,NI_NUMERICHOST | NI_NUMERICSERVER); $^W=$old_wflag; "$a[0]$a[1]" eq "$b[0]$b[1]"; } $| = 1; print "1..7\n"; # Make sure we don't import any extraneous symbols # which may clash and emit warnings. # # See: # http://qa.mandriva.com/show_bug.cgi?id=36889 use Socket (); use Socket6; use IO::Socket (); use IO::Socket::INET6 (); $udpa = IO::Socket::INET6->new(Proto => 'udp', LocalAddr => '::1') || IO::Socket::INET6->new(Proto => 'udp', LocalAddr => 'localhost') or die "$@ (maybe your system does not have a localhost at all, 'localhost' or ::1)"; print "ok 1\n"; $udpb = IO::Socket::INET6->new(Proto => 'udp', LocalAddr => '::1') || IO::Socket::INET6->new(Proto => 'udp', LocalAddr => 'localhost') or die "$@ (maybe your system does not have a localhost at all, 'localhost' or ::1)"; print "ok 2\n"; $udpa->send("ok 4\n",0,$udpb->sockname); print "not " unless compare_addr($udpa->peername,$udpb->sockname, 'peername', 'sockname'); print "ok 3\n"; my $where = $udpb->recv($buf="",5); print $buf; my @xtra = (); unless(compare_addr($where,$udpa->sockname, 'recv name', 'sockname')) { print "not "; @xtra = (0,$udpa->sockname); } print "ok 5\n"; $udpb->send("ok 6\n",@xtra); $udpa->recv($buf="",5); print $buf; print "not " if $udpa->connected; print "ok 7\n";