<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># IO::Socket::INET6.pm
#
# Copyright (c) 1997-8 Graham Barr &lt;gbarr@pobox.com&gt;. 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 &lt;rafael.martinez@novagnet.com&gt;
# 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:
# 
# &lt;LeoNerd&gt; IO::Socket is stupidstupidstupid beyond belief. Despite being an
# object class, it has an import method
# &lt;LeoNerd&gt; So you have to use IO::Socket ();
# &lt;LeoNerd&gt; 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.69";
#Purpose: allow protocol independent protocol and original interface.

my $EINVAL = exists(&amp;Errno::EINVAL) ? Errno::EINVAL() : 1;

IO::Socket::INET6-&gt;register_domain( AF_INET6 );


my %socket_type = ( tcp  =&gt; SOCK_STREAM,
		    udp  =&gt; SOCK_DGRAM,
		    icmp =&gt; SOCK_RAW
		  );

sub new {
    my $class = shift;
    unshift(@_, "PeerAddr") if @_ == 1;
    return $class-&gt;SUPER::new(@_);
}

#Parsing analisis:
# addr,port,and proto may be sintactically 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  &amp;&amp; $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 &amp;&amp; !$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-&gt;{LocalAddr} = $arg-&gt;{LocalHost}
        if exists $arg-&gt;{LocalHost} &amp;&amp; !exists $arg-&gt;{LocalAddr};
    $arg-&gt;{PeerAddr} = $arg-&gt;{PeerHost}
        if exists $arg-&gt;{PeerHost} &amp;&amp; !exists $arg-&gt;{PeerAddr};

    my $family = $arg-&gt;{Domain};
    # in case no local and peer is given we prefer AF_INET6
    # because we are IO::Socket::INET6
    $family ||= ! $arg-&gt;{LocalAddr} &amp;&amp; ! $arg-&gt;{PeerAddr} &amp;&amp; AF_INET6 
        || AF_UNSPEC;

    # parse Local*
    my ($laddr,$lport,$proto) = _sock_info(
        $arg-&gt;{LocalAddr},
        $arg-&gt;{LocalPort},
        $arg-&gt;{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) &amp;&amp; (!$lport)) {
            $laddr = ($family == AF_INET) ? '0.0.0.0' : '::';
            $lport = '';
        } elsif (!$lport) {
            $lport = '';
        }
    } 

    my $type = $arg-&gt;{Type} || $socket_type{(getprotobynumber($proto))[0]};

    # parse Peer*
    my($rport,$raddr); 
    unless(exists $arg-&gt;{Listen}) {
        ($raddr,$rport) = _sock_info(
            $arg-&gt;{PeerAddr},
            $arg-&gt;{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&lt;5;
    my @rres;
    if ( defined $raddr ) {
        @rres = getaddrinfo($raddr,$rport,$family,$type,$proto);
        return _error($sock, $EINVAL, "getaddrinfo: $rres[0]") if @rres&lt;5;
    }

    my @flr;
    if (@rres) {
        # collect all combinations whith 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&lt;@rres;$r+=5 ) {
            for( my $l=0;$l&lt;@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&lt;@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-&gt;{LocalFlow} || $arg-&gt;{LocalScope}) {
                my @sa_in6 = unpack_sockaddr_in6_all($lres);
                $sa_in6[1] = $arg-&gt;{LocalFlow}  || 0;
                $sa_in6[3] = _scope_ntohl($arg-&gt;{LocalScope}) || 0;
                $lres = pack_sockaddr_in6_all(@sa_in6);
            }
        }

        $sock-&gt;socket($family, $type, $proto) or
            return _error($sock, $!, "socket: $!");

        if (defined $arg-&gt;{Blocking}) {
            defined $sock-&gt;blocking($arg-&gt;{Blocking}) or
                return _error($sock, $!, "sockopt: $!");
        }

        if ($arg-&gt;{Reuse} || $arg-&gt;{ReuseAddr}) {
            $sock-&gt;sockopt(SO_REUSEADDR,1) or
                return _error($sock, $!, "sockopt: $!");
        }

        if ($arg-&gt;{ReusePort}) {
            $sock-&gt;sockopt(SO_REUSEPORT,1) or
                return _error($sock, $!, "sockopt: $!");
        }

        if ($arg-&gt;{Broadcast}) {
            $sock-&gt;sockopt(SO_BROADCAST,1) or
                return _error($sock, $!, "sockopt: $!");
        }

        if ( $family == AF_INET ) {
            my ($p,$a) = sockaddr_in($lres);
            $sock-&gt;bind($lres) or return _error($sock, $!, "bind: $!")
                if ($a ne INADDR_ANY  or $p!=0);
        } else {
            my ($p,$a) = sockaddr_in6($lres);
            $sock-&gt;bind($lres) or return _error($sock, $!, "bind: $!")
                if ($a ne in6addr_any  or $p!=0);
        }

        if(exists $arg-&gt;{Listen}) {
            $sock-&gt;listen($arg-&gt;{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-&gt;{PeerFlow} || $arg-&gt;{PeerScope}) {
                my @sa_in6 = unpack_sockaddr_in6_all($rres);
                $sa_in6[1] = $arg-&gt;{PeerFlow}  || 0;
                $sa_in6[3] = _scope_ntohl($arg-&gt;{PeerScope}) || 0;
                $rres = pack_sockaddr_in6_all(@sa_in6);
            }
        }
    
        undef $@;
        last if $sock-&gt;connect($rres);

        return _error($sock, $!, $@ || "Timeout")
            if ! $arg-&gt;{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-&gt;VERSION &lt;= 0.17) &amp;&amp; (pack('s', 0x1234) ne pack('n', 0x1234)))
    {
        unpack('N', pack('V', $_[0]));
    } else {
        $_[0];
    }
}

sub sockdomain
{
   my $sock = shift;
   $sock-&gt;SUPER::sockdomain(@_) || AF_INET6;
} 

sub accept
{
    my $sock = shift;

    my ($new, $peer) = $sock-&gt;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-&gt;bind(NAME) ';
    my $sock = shift;
    return $sock-&gt;SUPER::bind( shift );
}

sub connect {
    @_ == 2 or
       croak 'usage: $sock-&gt;connect(NAME) ';
    my $sock = shift;
    return $sock-&gt;SUPER::connect( shift );
}

sub sockaddr {
    @_ == 1 or croak 'usage: $sock-&gt;sockaddr()';
    my ($sock) = @_;
    return undef unless (my $name = $sock-&gt;sockname);
    ($sock-&gt;sockdomain == AF_INET) ? (sockaddr_in($name))[1] : (sockaddr_in6($name))[1];
}

sub sockport {
    @_ == 1 or croak 'usage: $sock-&gt;sockport()';
    my($sock) = @_;
    return undef unless (my $name = $sock-&gt;sockname);
    ($sock-&gt;sockdomain == AF_INET) ? (sockaddr_in($name))[0] : (sockaddr_in6($name))[0];
}

sub sockhost {
    @_ == 1 or croak 'usage: $sock-&gt;sockhost()';
    my ($sock) = @_;
    return undef unless (my $addr = $sock-&gt;sockaddr);
    Socket6::inet_ntop($sock-&gt;sockdomain, $addr);
}

sub sockflow
{
    @_ == 1 or croak 'usage: $sock-&gt;sockflow()';
    my ($sock) = @_;
    return undef unless (my $name = $sock-&gt;sockname);
    ($sock-&gt;sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[1] : 0; 
}

sub sockscope
{
    @_ == 1 or croak 'usage: $sock-&gt;sockscope()';
    my ($sock) = @_;
    return undef unless (my $name = $sock-&gt;sockname);
    _scope_ntohl(($sock-&gt;sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[3] : 0);
}

sub peeraddr {
    @_ == 1 or croak 'usage: $sock-&gt;peeraddr()';
    my ($sock) = @_;
    return undef unless (my $name = $sock-&gt;peername);
    ($sock-&gt;sockdomain == AF_INET) ? (sockaddr_in($name))[1] : (sockaddr_in6($name))[1];
}

sub peerport {
    @_ == 1 or croak 'usage: $sock-&gt;peerport()';
    my($sock) = @_;
    return undef unless (my $name = $sock-&gt;peername);
    ($sock-&gt;sockdomain == AF_INET) ? (sockaddr_in($name))[0] : (sockaddr_in6($name))[0];
}

sub peerhost {
    @_ == 1 or croak 'usage: $sock-&gt;peerhost()';
    my ($sock) = @_;
    return undef unless (my $addr = $sock-&gt;peeraddr);
    Socket6::inet_ntop($sock-&gt;sockdomain, $addr);
}

sub peerflow
{
    @_ == 1 or croak 'usage: $sock-&gt;peerflow()';
    my ($sock) = @_;
    return undef unless (my $name = $sock-&gt;peername);
    _scope_ntohl(($sock-&gt;sockdomain == AF_INET6) ? (unpack_sockaddr_in6_all($name))[1] : 0);
}

sub peerscope
{
    @_ == 1 or croak 'usage: $sock-&gt;peerscope()';
    my ($sock) = @_;
    return undef unless (my $name = $sock-&gt;peername);
    ($sock-&gt;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&lt;IO::Socket::INET6&gt; provides an object interface to creating and using sockets
in either AF_INET or AF_INET6 domains. It is built upon the L&lt;IO::Socket&gt; interface and
inherits all the methods defined by L&lt;IO::Socket&gt;.

=head1 CONSTRUCTOR

=over 4

=item new ( [ARGS] )

Creates an C&lt;IO::Socket::INET6&gt; object, which is a reference to a
newly created symbol (see the C&lt;Symbol&gt; package). C&lt;new&gt;
optionally takes arguments, these arguments are in key-value pairs.

In addition to the key-value pairs accepted by L&lt;IO::Socket&gt;,
C&lt;IO::Socket::INET6&gt; provides.


    Domain	Address family               AF_INET | AF_INET6 | AF_UNSPEC (default)
    PeerAddr	Remote host address          &lt;hostname&gt;[:&lt;port&gt;]
    PeerHost	Synonym for PeerAddr
    PeerPort	Remote port or service       &lt;service&gt;[(&lt;no&gt;)] | &lt;no&gt;
    PeerFlow    Remote flow information
    PeerScope   Remote address scope 
    LocalAddr	Local host bind	address      hostname[:port]
    LocalHost	Synonym for LocalAddr
    LocalPort	Local host bind	port         &lt;service&gt;[(&lt;no&gt;)] | &lt;no&gt;
    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&lt;Listen&gt; 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&lt;MultiHomed&gt; 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&lt;PeerAddr&gt; 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&lt;PeerPort&gt; 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&lt;PeerPort&gt; specification can also be embedded in the C&lt;PeerAddr&gt;
by preceding it with a ":", and closing the IPv6 address on bracktes "[]" if
necessary: "124.678.12.34:23","[2a05:345f::10]:23","any.server.com:23".

If C&lt;Domain&gt; 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 is prioritary.
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&lt;family&gt; (AF_INET, AF_INET6).

If C&lt;Proto&gt; is not given and you specify a symbolic C&lt;PeerPort&gt; port,
then the constructor will try to derive C&lt;Proto&gt; from the service
name.  As a last resort C&lt;Proto&gt; "tcp" is assumed.  The C&lt;Type&gt;
parameter will be deduced from C&lt;Proto&gt; if not specified.

If the constructor is only passed a single argument, it is assumed to
be a C&lt;PeerAddr&gt; specification.

If C&lt;Blocking&gt; 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-&gt;new(PeerAddr =&gt; 'www.perl.org',
                                 PeerPort =&gt; 'http(80)',
                                 Proto    =&gt; '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-&gt;new(PeerAddr =&gt; 'www.perl.org',
                                 PeerPort =&gt; 'http(80)',
				 Multihomed =&gt; 1 ,
                                 Proto    =&gt; 'tcp');

(Concrete to IPv4 protocol)

   $sock = IO::Socket::INET6-&gt;new(PeerAddr =&gt; 'www.perl.org',
                                 PeerPort =&gt; 'http(80)',
				 Domain =&gt; AF_INET ,
                                 Proto    =&gt; 'tcp');


   $sock = IO::Socket::INET6-&gt;new(PeerAddr =&gt; 'localhost:smtp(25)');

   $sock = IO::Socket::INET6-&gt;new(Listen    =&gt; 5,
                                 LocalAddr =&gt; 'localhost',
                                 LocalPort =&gt; 9000,
                                 Proto     =&gt; 'tcp');

   $sock = IO::Socket::INET6-&gt;new('[::1]:25');

   $sock = IO::Socket::INET6-&gt;new(PeerPort  =&gt; 9999,
                                 PeerAddr  =&gt; Socket6::inet_ntop(AF_INET6,in6addr_broadcast),
                                 Proto     =&gt; udp,    
                                 LocalAddr =&gt; 'localhost',
                                 Broadcast =&gt; 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&lt;IO::Socket::INET&gt;.

=item bind ()

See L&lt;IO::Socket::INET&gt;.

=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&lt;IO::Socket::INET&gt;.

=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&lt;http://svn.berlios.de/svnroot/repos/web-cpan/IO-Socket-INET6/&gt;

=head1 SEE ALSO

L&lt;Socket&gt;,L&lt;Socket6&gt;, L&lt;IO::Socket&gt;

=head1 AUTHOR

This program is based on L&lt;IO::Socket::INET&gt; by Graham Barr
&lt;gbarr@pobox.com&gt; and currently maintained by the Perl Porters.

Modified by Rafael Martinez Torres &lt;rafael.martinez@novagnet.com&gt; and
Euro6IX project.

Modified further by Shlomi Fish &lt;shlomif@iglu.org.il&gt;, while disclaiming
all copyrights.

=head1 COPYRIGHT

Copyright (c) 2003- Rafael Martinez Torres &lt;rafael.martinez@novagnet.com&gt;.

Copyright (c) 2003- Euro6IX project.

Copyright (c) 1996-8 Graham Barr &lt;gbarr@pobox.com&gt;.

All rights reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
</pre></body></html>