Attachment #300015 for bug #370355





use strict;
use vars qw($VERSION $AUTOLOAD @ISA $have_inet6 $io_socket_module);
use IO::Socket;

BEGIN {
  eval {
    require Socket6; import Socket6;
    require IO::Socket::INET6;
    $io_socket_module = 'IO::Socket::INET6';
    $have_inet6 = 1;
  } or do {
    require IO::Socket::INET;
    $io_socket_module = 'IO::Socket::INET';
  };
  @ISA = ( $io_socket_module );
}

eval {
  require IO::Socket::SSL; import IO::Socket::SSL;
  # we could add IO::Socket::SSL to a local copy of @ISA just before calling
  # start_SSL and do away with the $io_socket_module trick later, but this
  # causes perl 5.12.2 to crash, so do it the way it likes it
  unshift(@ISA, qw(IO::Socket::SSL));  1;
} or do {
  warn "Module IO::Socket::SSL is required for SSL: $@";
};

$VERSION = $Net::Server::VERSION; # done until separated
@ISA = qw(IO::Socket::SSL);

# additional protocol specific arguments
my @ssl_args = qw(
    SSL_use_cert
    SSL_verify_mode
    SSL_key_file
    SSL_cert_file
    SSL_ca_path
    SSL_ca_file
    SSL_cipher_list
    SSL_passwd_cb
    SSL_max_getline_length
    SSL_error_callback
);

sub object {

  my $host;

  local($1,$2);
  ### allow for things like "[::1]:80" or "[host.example.com]:80"
  if( $port =~ m/^\[([^\]]*)\]:(\w+)$/ ){
    ($host,$port) = ($1,$2);

  ### allow for things like "host.example.com:80"
  }elsif( $port =~ m/^([\w\.\-\*\/]+):(\w+)$/ ){
    ($host,$port) = ($1,$2);

  ### allow for things like "80" or "http"
  }elsif( $port =~ /^(\w+)$/ ){
    ($host,$port) = ($default_host,$1);

  }

  ### collect bind addresses along with their address family for all hosts
  my @bind_tuples;
  if( $host =~ /^\d{1,3}(?:\.\d{1,3}){3}\z/ ){
    push(@bind_tuples, [AF_INET,$host,$port]);
  }elsif( $host =~ /:/ ){
    die "No IO::Socket::INET6, cannot bind to [$host]:$port"  if !$have_inet6;
    push(@bind_tuples, [AF_INET6,$host,$port]);
  }elsif( !$have_inet6 ){
    push(@bind_tuples, [AF_INET,$host,$port]);
  }elsif( $have_inet6 && $host =~ /\*/ ){
    push(@bind_tuples, [AF_INET6,$host,$port], [AF_INET,$host,$port]);
  }else{  # we do have IO::Socket::INET6, it handles inet6 as well as inet
    # obtain a list of IP addresses for $host, resolve port name
    my @res1 = getaddrinfo($host, $port,
                           AF_UNSPEC, SOCK_STREAM, 0, AI_PASSIVE);
    die "Unresolvable [$host]:$port: $res1[0]"  if @res1 < 5;
    while (@res1 >= 5) {
      my($afam, $socktype, $proto, $saddr, $canonname);
      ($afam, $socktype, $proto, $saddr, $canonname, @res1) = @res1;
      my @res2 = getnameinfo($saddr, NI_NUMERICHOST | NI_NUMERICSERV);
      die "getnameinfo failed on [$host]:$port: $res2[0]"  if @res2 < 2;
      my($hostip,$portnum) = @res2;
      $server->log(4,"Resolved [$host]:$port -> [$hostip]:$portnum, AF $afam");
      push(@bind_tuples, [$afam,$hostip,$portnum]);
    }
  }

  my @sockets_list;
  ### create a socket for each specified bind address and family
  foreach my $tuple ( @bind_tuples ){
    my $afamily;  # address family (AF_* constants)
    my $pfamily;  # socket protocol family (PF_* constants)
    ($afamily,$host,$port) = @$tuple;
    my $sock;
    if( $have_inet6 ){
      # Using IO::Socket::INET6 to handle both the IPv4 and IPv6.
      # Constants PF_INET/PF_INET6 (protocol family) usually happen to have
      # the same value as AF_INET/AF_INET6 (address family) constants.
      # Still, better safe than sorry:
      $pfamily = $afamily == AF_INET  ? PF_INET
               : $afamily == AF_INET6 ? PF_INET6 : $afamily;
      $server->log(3,"Using IO::Socket::INET6 for [$host]:$port, PF $pfamily");
      $sock = IO::Socket::INET6->new(Domain => $pfamily);  # inet or inet6
    }else{
      $pfamily = PF_INET;
      $server->log(3,"Using IO::Socket::INET for [$host]:$port, PF $pfamily");
      $sock = IO::Socket::INET->new();  # inet socket (IPv4 only)
    }

    if ($sock) {
      ### create the handle under this package
      bless $sock, $class;

      $sock->NS_host($host);
      $sock->NS_port($port);
      $sock->NS_proto('SSL');
      $sock->NS_family($pfamily);  # socket protocol family

      for my $key (@ssl_args) {
        my $val = defined($prop->{$key}) ? $prop->{$key} : $server->can($key) ? $server->$key($host, $port, 'SSL') : undef;
        $sock->$key($val);
      }
      push @sockets_list, $sock;
    }
  }

  ### returns any number of sockets,
  ### one for each protocol family (PF_INET or PF_INET6) and each bind address
  return !wantarray ? $sockets_list[0] : @sockets_list;
}

sub log_connect {
  my $sock = shift;
  my $server  = shift;
  my $host    = $sock->NS_host; 
  my $port    = $sock->NS_port;
  my $proto   = $sock->NS_proto;
  my $pfamily = $sock->NS_family || 0;
  $server->log(2,"Binding to $proto port $port on host $host, PF $pfamily\n");
}

### bind the first time
sub connect {
  my $sock    = shift;
  my $server  = shift;
  my $prop    = $server->{server};

  my $host    = $sock->NS_host;
  my $port    = $sock->NS_port;
  my $pfamily = $sock->NS_family || 0;
  my %args = ();
  $args{LocalPort} = $port;                  # what port to bind on
  $args{Proto}     = 'tcp';                  # what procol to use
  $args{LocalAddr} = $host if $host !~ /\*/; # what local address (* is all)
  $args{Listen}    = $prop->{listen};        # how many connections for kernel to queue
  $args{Reuse}     = 1;  # allow us to rebind the port on a restart

  ### add in any ssl specific properties
  foreach ( keys %$prop ){
    next unless /^SSL_/;
    $args{$_} = $prop->{$_};
  }

  ### connect to the sock
  $sock->SUPER::configure(\%args)
    or $server->fatal("Can't connect to SSL port $port on $host [$!]");

  $server->fatal("Back sock [$!]!".caller())
    unless $sock;

  my %args;
  $args{LocalPort} = $port;
  $args{Proto}     = 'tcp';
  $args{LocalAddr} = $host if $host !~ /\*/;  # * is all
  $args{Domain}    = $pfamily  if $have_inet6 && $pfamily;
  $args{Listen}    = $prop->{listen};
  $args{Reuse}     = 1;

  ### bind to the sock using the underlying IO Socket module
  { local @ISA = ( $io_socket_module );
    $sock->SUPER::configure(\%args)
      or $server->fatal("Can't bind to SSL port $port on $host [$!]");
    $server->fatal("Bad sock [$!]!".caller())  if !$sock;
  }
}

### connect on a sig -HUP
sub reconnect {
  my ($sock, $fd, $server) = @_;
  my $fd   = shift;
  my $server = shift;

  $sock->fdopen( $fd, 'w' )
    or $server->fatal("Error opening to file descriptor ($fd) [$!]");

  my $host    = $sock->NS_host; 
  my $port    = $sock->NS_port;
  my $proto   = $sock->NS_proto;
  my $pfamily = $sock->NS_family || 0;

  $server->log(3,"Reassociating file descriptor $fd ".
                 "with socket $proto on [$host]:port, PF $pfamily\n");

  ### fdopen cannot be used on a IO::Socket::SSL object!!!
  ### use fdopen() from the underlying IO Socket package
  { local @ISA = ( $io_socket_module );
    $sock->fdopen( $fd, 'w' )
      or $server->fatal("Error opening to file descriptor ($fd) [$!]");
  }
}


sub accept {
  my $sock = shift;
  my $client;

  ### fdopen (in reconnect) cannot be used on an IO::Socket::SSL object,
  ### which is why we accept first and upgrade to SSL later

  ### accept() with the underlying IO Socket package, upgrade to SSL later
  { local @ISA = ( $io_socket_module );
    $client = $sock->SUPER::accept();
  }

  if( defined $client ){
    $client->NS_proto( $sock->NS_proto );
    $client->NS_family( $sock->NS_family );
    $client->NS_host( $sock->NS_host );
    $client->NS_port( $sock->NS_port );

    ### must bless the upgraded SSL object into our package
    ### to be able to reference its NS_* properties later
    __PACKAGE__->start_SSL($client,
      SSL_error_trap => sub { my($sock,$msg) = @_;
                              die "Error upgrading socket to SSL: $msg" },
      SSL_server => 1,
      map { defined $sock->$_() ? ($_,$sock->$_()) : () } @ssl_args,
    ) or die "Upgrading socket to SSL failed: ".IO::Socket::SSL::errstr();

  }
  return $client;
}

              $sock->NS_port,
              $sock->NS_proto,
              !$have_inet6 || !$sock->NS_family ? () : $sock->NS_family,
              );
}

  my $sock = shift;
  my $t = "Ref = \"" .ref($sock) . "\"\n";
  foreach my $prop ( qw(NS_proto NS_port NS_host NS_family) ){
    $t .= "  $prop = \"" .$sock->$prop()."\"\n";
  }

  }

  if( $prop =~ /^(NS_proto|NS_port|NS_host|NS_family|SSL_\w+)$/ ){
    no strict 'refs';
    * { __PACKAGE__ ."::". $prop } = sub {


This original SSL module was experimental.  It has been superceeded by
Net::Server::Proto::SSLEAY. If anybody has any successes or ideas for
improvement under SSL, please email <paul@seamons.com>.

Protocol module for Net::Server.  This module implements a





use strict;
use vars qw($VERSION $AUTOLOAD @ISA $have_inet6);
use IO::Socket::INET;
use Fcntl ();
use Errno ();
use Socket ();
use IO::Socket;

BEGIN {
  eval {
    require Socket6; import Socket6;
    require IO::Socket::INET6;
    @ISA = qw(IO::Socket::INET6);
    $have_inet6 = 1;
  } or do {
    require IO::Socket::INET;
    @ISA = qw(IO::Socket::INET);
  };
  eval { require Net::SSLeay };
  $@ && warn "Module Net::SSLeay is required for SSLeay.";
  # Net::SSLeay gets mad if we call these multiple times - the question is - who will call them multiple times?
  for my $sub (qw(load_error_strings SSLeay_add_ssl_algorithms ENGINE_load_builtin_engines ENGINE_register_all_complete randomize)) {
    Net::SSLeay->can($sub)->();
  }
}

$VERSION = $Net::Server::VERSION; # done until separated

# additional protocol specific arguments
my @ssl_args = qw(
    SSL_use_cert
    SSL_verify_mode
    SSL_key_file
    SSL_cert_file
    SSL_ca_path
    SSL_ca_file
    SSL_cipher_list
    SSL_passwd_cb
    SSL_max_getline_length
    SSL_error_callback
);

sub object {
  my $type  = shift;
  my $class = ref($type) || $type || __PACKAGE__;

  my ($default_host,$port,$server) = @_;
  my $host;
  my $prop = $server->{'server'};

  local($1,$2);
  ### allow for things like "[::1]:80" or "[host.example.com]:80"
  if( $port =~ m/^\[([^\]]*)\]:(\w+)$/ ){
    ($host,$port) = ($1,$2);

  ### allow for things like "host.example.com:80"
  }elsif( $port =~ m/^([\w\.\-\*\/]+):(\w+)$/ ){
    ($host,$port) = ($1,$2);

  ### allow for things like "80" or "http"
  }elsif( $port =~ /^(\w+)$/ ){
    ($host,$port) = ($default_host,$1);

  ### don't know that style of port
  }else{
    $server->fatal("Undeterminate port \"$port\" under ".__PACKAGE__);
  }

  ### collect bind addresses along with their address family for all hosts
  my @bind_tuples;
  if( $host =~ /^\d{1,3}(?:\.\d{1,3}){3}\z/ ){
    push(@bind_tuples, [AF_INET,$host,$port]);
  }elsif( $host =~ /:/ ){
    die "No IO::Socket::INET6, cannot bind to [$host]:$port"  if !$have_inet6;
    push(@bind_tuples, [AF_INET6,$host,$port]);
  }elsif( !$have_inet6 ){
    push(@bind_tuples, [AF_INET,$host,$port]);
  }elsif( $have_inet6 && $host =~ /\*/ ){
    push(@bind_tuples, [AF_INET6,$host,$port], [AF_INET,$host,$port]);
  }else{  # we do have IO::Socket::INET6, it handles inet6 as well as inet
    # obtain a list of IP addresses for $host, resolve port name
    my @res1 = getaddrinfo($host, $port,
                           AF_UNSPEC, SOCK_STREAM, 0, AI_PASSIVE);
    die "Unresolvable [$host]:$port: $res1[0]"  if @res1 < 5;
    while (@res1 >= 5) {
      my($afam, $socktype, $proto, $saddr, $canonname);
      ($afam, $socktype, $proto, $saddr, $canonname, @res1) = @res1;
      my @res2 = getnameinfo($saddr, NI_NUMERICHOST | NI_NUMERICSERV);
      die "getnameinfo failed on [$host]:$port: $res2[0]"  if @res2 < 2;
      my($hostip,$portnum) = @res2;
      $server->log(4,"Resolved [$host]:$port -> [$hostip]:$portnum, AF $afam");
      push(@bind_tuples, [$afam,$hostip,$portnum]);
    }
  }

  my @sockets_list;
  ### create a socket for each specified bind address and family
  foreach my $tuple ( @bind_tuples ){
    my $afamily;  # address family (AF_* constants)
    my $pfamily;  # socket protocol family (PF_* constants)
    ($afamily,$host,$port) = @$tuple;
    my $sock;
    if( $have_inet6 ){
      # Using IO::Socket::INET6 to handle both the IPv4 and IPv6.
      # Constants PF_INET/PF_INET6 (protocol family) usually happen to have
      # the same value as AF_INET/AF_INET6 (address family) constants.
      # Still, better safe than sorry:
      $pfamily = $afamily == AF_INET  ? PF_INET
               : $afamily == AF_INET6 ? PF_INET6 : $afamily;
      $server->log(3,"Using IO::Socket::INET6 for [$host]:$port, PF $pfamily");
      $sock = IO::Socket::INET6->new(Domain => $pfamily);  # inet or inet6
    }else{
      $pfamily = PF_INET;
      $server->log(3,"Using IO::Socket::INET for [$host]:$port, PF $pfamily");
      $sock = IO::Socket::INET->new();  # inet socket (IPv4 only)
    }

    if ($sock) {
      bless $sock, $class;

      $sock->NS_host($host);
      $sock->NS_port($port);
      $sock->NS_proto('SSLEAY');
      $sock->NS_family($pfamily);  # socket protocol family

      for my $key (@ssl_args) {
        my $val = defined($prop->{$key}) ? $prop->{$key} : $server->can($key) ? $server->$key($host, $port, 'SSLEAY') : undef;
        $sock->$key($val);
      }
      push @sockets_list, $sock;
    }
  }

  ### returns any number of sockets,
  ### one for each protocol family (PF_INET or PF_INET6) and each bind address
  return !wantarray ? $sockets_list[0] : @sockets_list;
}

sub log_connect {
  my $sock = shift;
  my $server  = shift;
  my $host    = $sock->NS_host; 
  my $port    = $sock->NS_port;
  my $proto   = $sock->NS_proto;
  my $pfamily = $sock->NS_family || 0;
  $server->log(2,"Binding to $proto port $port on host $host, PF $pfamily\n");
}

###----------------------------------------------------------------###

### bind the first time
sub connect {
  my $sock    = shift;
  my $server  = shift;
  my $prop    = $server->{server};

  my $host    = $sock->NS_host;
  my $port    = $sock->NS_port;
  my $pfamily = $sock->NS_family || 0;

  my %args;
  $args{LocalPort} = $port;
  $args{Proto}     = 'tcp';
  $args{LocalAddr} = $host if $host !~ /\*/;  # * is all
  $args{Domain}    = $pfamily  if $have_inet6 && $pfamily;
  $args{Listen}    = $prop->{listen};
  $args{Reuse}     = 1;

  $sock->SUPER::configure(\%args)
    or $server->fatal("Can't bind to SSL port $port on $host [$!]");
  $server->fatal("Bad sock [$!]!".caller())  if !$sock;

  my $actual_port = $sock->sockport;
  # $port may be a service name, compare as strings
  if( $actual_port && (!defined $port || $actual_port ne $port) ){
    $sock->NS_port($actual_port);
    if( $port =~ /^0*\z/ ){
      $server->log(2,"Bound to auto-assigned port $actual_port");
    }else{
      $server->log(3,"Bound to service \"$port\", port number $actual_port");
    }
  }

  $sock->bind_SSL($server);
}

### reassociate sockets with inherited file descriptors on a sig -HUP
sub reconnect {
  my ($sock, $fd, $server) = @_;

  my $host    = $sock->NS_host; 
  my $port    = $sock->NS_port;
  my $proto   = $sock->NS_proto;
  my $pfamily = $sock->NS_family || 0;

  $server->log(3,"Reassociating file descriptor $fd ".
                 "with socket $proto on [$host]:port, PF $pfamily\n");
  my $resp = $sock->fdopen( $fd, 'w' )
    or $server->fatal("Error opening to file descriptor ($fd) [$!]");
  $sock->bind_SSL($server);
  return $resp;
}

sub bind_SSL {
  my ($sock, $server) = @_;
  my $ctx = Net::SSLeay::CTX_new();  $sock->SSLeay_check_fatal("SSLeay bind_SSL CTX_new");

  Net::SSLeay::CTX_set_options($ctx, Net::SSLeay::OP_ALL());  $sock->SSLeay_check_fatal("SSLeay bind_SSL CTX_set_options");

  # 0x1:  SSL_MODE_ENABLE_PARTIAL_WRITE
  # 0x10: SSL_MODE_RELEASE_BUFFERS (ignored before OpenSSL v1.0.0)
  Net::SSLeay::CTX_set_mode($ctx, 0x11);  $sock->SSLeay_check_fatal("SSLeay bind_SSL CTX_set_mode");

  # Load certificate. This will prompt for a password if necessary.
  my $file_key  = $sock->SSL_key_file  || die "SSLeay missing SSL_key_file.\n";
  my $file_cert = $sock->SSL_cert_file || die "SSLeay missing SSL_cert_file.\n";
  Net::SSLeay::CTX_use_RSAPrivateKey_file($ctx, $file_key,  Net::SSLeay::FILETYPE_PEM());  $sock->SSLeay_check_fatal("SSLeay bind_SSL CTX_use_RSAPrivateKey_file");
  Net::SSLeay::CTX_use_certificate_file(  $ctx, $file_cert, Net::SSLeay::FILETYPE_PEM());  $sock->SSLeay_check_fatal("SSLeay bind_SSL CTX_use_certificate_file");
  $sock->SSLeay_context($ctx);
}

sub close {
  my $sock = shift;
  if ($sock->SSLeay_is_client) {
    Net::SSLeay::free($sock->SSLeay);
  } else {
    Net::SSLeay::CTX_free($sock->SSLeay_context);
  }
  $sock->SSLeay_check_fatal("SSLeay close free");
  return $sock->SUPER::close(@_);
}

sub accept {
  my $sock = shift;
  my $client = $sock->SUPER::accept;
  if (defined $client) {
    $client->NS_proto( $sock->NS_proto );
    $client->NS_family( $sock->NS_family );
    $client->NS_host( $sock->NS_host );
    $client->NS_port( $sock->NS_port );
    $client->SSLeay_context( $sock->SSLeay_context );
    $client->SSLeay_is_client(1);
  }

  return $client;
}


}

sub sysread {
    my ($client, $buf, $size, $offset) = @_;
    warn "sysread is not supported by Net::Server::Proto::SSLEAY";
    # not quite right, usable only for testing:
    my ($ok, $read) = $client->read_until($size, $/, 1);
    substr($_[1], $offset || 0, defined($buf) ? length($buf) : 0, $read);
    # should return the number of bytes actually read, 0 at end of file, or
    # undef if there was an error (in the latter case $! should also be set)
    return length $read;
}

sub getline {
    my $client = shift;

}

sub sysread  { die "sysread is not supported by Net::Server::Proto::SSLEAY" }
sub syswrite { die "syswrite is not supported by Net::Server::Proto::SSLEAY" }


sub hup_string {
    my $sock = shift;
    return join("|",
                $sock->NS_host,
                $sock->NS_port,
                $sock->NS_proto,
                !$have_inet6 || !$sock->NS_family ? () : $sock->NS_family,
              );
}


    my $sock = shift;
    my $t = "Ref = \"" .ref($sock) . "\"\n";
    foreach my $prop ( qw(NS_proto NS_port NS_host NS_family SSLeay_context SSLeay_is_client) ){
        $t .= "  $prop = \"" .$sock->$prop()."\"\n";
    }

    my $prop = $AUTOLOAD =~ /::([^:]+)$/ ? $1 : die "Missing property in AUTOLOAD.";
    die "Unknown method or property [$prop]"
        if $prop !~ /^(NS_proto|NS_port|NS_host|NS_family|SSLeay_context|SSLeay_is_client|SSL_\w+)$/;

    no strict 'refs';





use strict;
use vars qw($VERSION $AUTOLOAD @ISA $have_inet6);
use IO::Socket;

BEGIN {
  eval {
    require Socket6; import Socket6;
    require IO::Socket::INET6;
    @ISA = qw(IO::Socket::INET6);
    $have_inet6 = 1;
  } or do {
    require IO::Socket::INET;
    @ISA = qw(IO::Socket::INET);
  };
}

$VERSION = $Net::Server::VERSION; # done until separated
@ISA = qw(IO::Socket::INET);

sub object {

  my $host;

  local($1,$2);
  ### allow for things like "[::1]:80" or "[host.example.com]:80"
  if( $port =~ m/^\[([^\]]*)\]:(\w+)$/ ){
    ($host,$port) = ($1,$2);

  ### allow for things like "host.example.com:80"
  }elsif( $port =~ m/^([\w\.\-\*\/]+):(\w+)$/ ){
    ($host,$port) = ($1,$2);

  ### allow for things like "80" or "http"
  }elsif( $port =~ /^(\w+)$/ ){
    ($host,$port) = ($default_host,$1);

  }

  ### collect bind addresses along with their address family for all hosts
  my @bind_tuples;
  if( $host =~ /^\d{1,3}(?:\.\d{1,3}){3}\z/ ){
    push(@bind_tuples, [AF_INET,$host,$port]);
  }elsif( $host =~ /:/ ){
    die "No IO::Socket::INET6, cannot bind to [$host]:$port"  if !$have_inet6;
    push(@bind_tuples, [AF_INET6,$host,$port]);
  }elsif( !$have_inet6 ){
    push(@bind_tuples, [AF_INET,$host,$port]);
  }elsif( $have_inet6 && $host =~ /\*/ ){
    push(@bind_tuples, [AF_INET6,$host,$port], [AF_INET,$host,$port]);
  }else{  # we do have IO::Socket::INET6, it handles inet6 as well as inet
    # obtain a list of IP addresses for $host, resolve port name
    my @res1 = getaddrinfo($host, $port,
                           AF_UNSPEC, SOCK_STREAM, 0, AI_PASSIVE);
    die "Unresolvable [$host]:$port: $res1[0]"  if @res1 < 5;
    while (@res1 >= 5) {
      my($afam, $socktype, $proto, $saddr, $canonname);
      ($afam, $socktype, $proto, $saddr, $canonname, @res1) = @res1;
      my @res2 = getnameinfo($saddr, NI_NUMERICHOST | NI_NUMERICSERV);
      die "getnameinfo failed on [$host]:$port: $res2[0]"  if @res2 < 2;
      my($hostip,$portnum) = @res2;
      $server->log(4,"Resolved [$host]:$port -> [$hostip]:$portnum, AF $afam");
      push(@bind_tuples, [$afam,$hostip,$portnum]);
    }
  }

  my @sockets_list;
  ### create a socket for each specified bind address and family
  foreach my $tuple ( @bind_tuples ){
    my $afamily;  # address family (AF_* constants)
    my $pfamily;  # socket protocol family (PF_* constants)
    ($afamily,$host,$port) = @$tuple;
    my $sock;
    if( $have_inet6 ){
      # Using IO::Socket::INET6 to handle both the IPv4 and IPv6.
      # Constants PF_INET/PF_INET6 (protocol family) usually happen to have
      # the same value as AF_INET/AF_INET6 (address family) constants.
      # Still, better safe than sorry:
      $pfamily = $afamily == AF_INET  ? PF_INET
               : $afamily == AF_INET6 ? PF_INET6 : $afamily;
      $server->log(3,"Using IO::Socket::INET6 for [$host]:$port, PF $pfamily");
      $sock = IO::Socket::INET6->new(Domain => $pfamily);  # inet or inet6
    }else{
      $pfamily = PF_INET;
      $server->log(3,"Using IO::Socket::INET for [$host]:$port, PF $pfamily");
      $sock = IO::Socket::INET->new();  # inet socket (IPv4 only)
    }

    if ($sock) {
      ### create the handle under this package
      bless $sock, $class;

      ### store some properties
      $sock->NS_host($host);
      $sock->NS_port($port);
      $sock->NS_proto('TCP');
      $sock->NS_family($pfamily);  # socket protocol family
      push @sockets_list, $sock;
    }
  }

  ### returns any number of sockets,
  ### one for each protocol family (PF_INET or PF_INET6) and each bind address
  return !wantarray ? $sockets_list[0] : @sockets_list;
}

sub log_connect {
  my $sock = shift;
  my $server  = shift;
  my $host    = $sock->NS_host; 
  my $port    = $sock->NS_port;
  my $proto   = $sock->NS_proto;
  my $pfamily = $sock->NS_family || 0;
  $server->log(2,"Binding to $proto port $port on host $host, PF $pfamily\n");
}

### bind the first time
sub connect {
  my $sock    = shift;
  my $server  = shift;
  my $prop    = $server->{server};

  my $host    = $sock->NS_host;
  my $port    = $sock->NS_port;
  my $pfamily = $sock->NS_family || 0;

  my %args;
  my $port  = $sock->NS_port;

  my %args = ();
  $args{LocalPort} = $port;                  # what port to bind on
  $args{Proto}     = 'tcp';                  # what procol to use
  $args{LocalAddr} = $host if $host !~ /\*/; # what local address (* is all)
  $args{Domain}    = $pfamily  if $have_inet6 && $pfamily;
  $args{Listen}    = $prop->{listen};        # how many connections for kernel to queue
  $args{Reuse}     = 1;  # allow us to rebind the port on a restart

  ### bind the sock
  $sock->SUPER::configure(\%args)
    or $server->fatal("Can't bind to TCP port $port on $host [$!]");
  $server->fatal("Bad sock [$!]!".caller())  if !$sock;

  my $actual_port = $sock->sockport;
  # $port may be a service name, compare as strings
  if( $actual_port && (!defined $port || $actual_port ne $port) ){
    $sock->NS_port($actual_port);
    if( $port =~ /^0*\z/ ){
      $server->log(2,"Bound to auto-assigned port $actual_port");
    }else{
      $server->log(3,"Bound to service \"$port\", port number $actual_port");
    }
  }

  $server->fatal("Back sock [$!]!".caller())
    unless $sock;

}

### reassociate sockets with inherited file descriptors on a sig -HUP
sub reconnect {
  my ($sock, $fd, $server) = @_;
  my $fd   = shift;
  my $server = shift;

  my $host    = $sock->NS_host; 
  my $port    = $sock->NS_port;
  my $proto   = $sock->NS_proto;
  my $pfamily = $sock->NS_family || 0;

  $server->log(3,"Reassociating file descriptor $fd ".
                 "with socket $proto on [$host]:port, PF $pfamily\n");
  $sock->fdopen( $fd, 'w' )
    or $server->fatal("Error opening to file descriptor ($fd) [$!]");

}



  ### pass items on
  if( defined $client ){
    $client->NS_proto( $sock->NS_proto );
    $client->NS_family( $sock->NS_family );
    $client->NS_host( $sock->NS_host );
    $client->NS_port( $sock->NS_port );
  }


              $sock->NS_port,
              $sock->NS_proto,
              !$have_inet6 || !$sock->NS_family ? () : $sock->NS_family,
              );
}

  my $sock = shift;
  my $t = "Ref = \"" .ref($sock) . "\"\n";
  foreach my $prop ( qw(NS_proto NS_port NS_host NS_family) ){
    $t .= "  $prop = \"" .$sock->$prop()."\"\n";
  }

  }

  if( $prop =~ /^(NS_proto|NS_port|NS_host|NS_family|NS_recv_len|NS_recv_flags)$/ ){
    no strict 'refs';
    * { __PACKAGE__ ."::". $prop } = sub {




  my $class = ref($type) || $type || __PACKAGE__;

  my $sock = $class->SUPER::object( @_ );

  $sock->NS_proto('UDP');

  ### set a few more parameters
  my($default_host,$port,$server) = @_;
  my $prop = $server->{server};

    && $prop->{udp_broadcast};

  my @sockets_list = $class->SUPER::object( @_ );
  $sock->NS_recv_flags( $prop->{udp_recv_flags} );

  foreach my $sock ( @sockets_list ){
    $sock->NS_proto('UDP');
    $sock->NS_recv_len(   $prop->{udp_recv_len} );
    $sock->NS_recv_flags( $prop->{udp_recv_flags} );
  }

  ### returns any number of sockets,
  ### one for each protocol family (PF_INET or PF_INET6) and each bind address
  return !wantarray ? $sockets_list[0] : @sockets_list;
}


### bind the first time
### doesn't support the listen or the reuse option
sub connect {
  my $sock    = shift;
  my $server  = shift;
  my $prop    = $server->{server};

  my $host    = $sock->NS_host;
  my $port    = $sock->NS_port;
  my $pfamily = $sock->NS_family || 0;

  my %args;
  $args{LocalPort} = $port;                  # what port to bind on
  $args{Proto}     = 'udp';                  # what procol to use
  $args{LocalAddr} = $host if $host !~ /\*/; # what local address (* is all)
  $args{Domain} = $pfamily  if $Net::Server::Proto::TCP::have_inet6 && $pfamily;
  $args{Reuse}     = 1;  # allow us to rebind the port on a restart
  $args{Broadcast} = 1 if $prop->{udp_broadcast};

  ### bind to the sock
  $sock->SUPER::configure(\%args)
    or $server->fatal("Can't bind to UDP port $port on $host [$!]");

  $server->fatal("Bad sock [$!]!".caller())
    unless $sock;


Lines 69-73 Link Here

(-)Net-Server-0.99.ori/lib/Net/Server/Proto.pm (-7 / +22 lines)
69		69
70		70
71	### return an object of that procol class	71	### returns any number of objects (socket),
		72	### one for each protocol family (PF_INET or PF_INET6) and each bind address
72	return $proto_class->object($default_host,$port,$server);	73	return $proto_class->object($default_host,$port,$server);
73		74
Lines 84-88 Link Here
84	=head1 SYNOPSIS	85	=head1 SYNOPSIS
85		86
86	# Net::Server::Proto and its accompianying modules are not	87	# Net::Server::Proto and its accompanying modules are not
87	# intended to be used outside the scope of Net::Server.	88	# intended to be used outside the scope of Net::Server.
88		89
Lines 103-107 Link Here
103		104
104	### Net::Server::Proto will attempt to interface with	105	### Net::Server::Proto will attempt to interface with
105	### sub modules named simillar to Net::Server::Proto::TCP	106	### sub modules named similar to Net::Server::Proto::TCP
106	### Individual sub modules will be loaded by	107	### Individual sub modules will be loaded by
107	### Net::Server::Proto as they are needed.	108	### Net::Server::Proto as they are needed.
Lines 225-232 Link Here
225	The port is the most important argument passed to the sub	226	The port is the most important argument passed to the sub
226	module classes and to Net::Server::Proto itself. For tcp,	227	module classes and to Net::Server::Proto itself. For tcp,
227	udp, and ssl style ports, the form is generally	228	udp, and ssl style ports, the form is generally host:port/protocol
228	host:port/protocol, host\|port\|protocol, host/port, or port.	229	or [host]:port/protocol, host\|port\|protocol, host/port, or port.
229	For unix the form is generally socket_file\|type\|unix or	230	If I<host> is a numerical IPv6 address it must be enclosed in square
230	socket_file.	231	brackets to avoid ambiguity in parsing a port number, e.g.: "[::1]:80".
		232	For unix sockets the form is generally socket_file\|type\|unix or socket_file.
		233
		234	A socket protocol family PF_INET or PF_INET6 is derived from a specified
		235	address family of the binding address. A PF_INET socket can only accept
		236	IPv4 connections. A PF_INET6 socket accepts IPv6 connections, but may also
		237	accept IPv4 connections, depending on OS and its settings. For example,
		238	on FreeBSD systems setting a sysctl net.inet6.ip6.v6only to 0 will allow
		239	IPv4 connections to a PF_INET6 socket.
		240
		241	The Net::Server::Proto::object method returns a list of objects corresponding
		242	to created sockets. For Unix and INET sockets the list typically contains
		243	just one element, but may return multiple objects when multiple protocol
		244	families are allowed or when a host name resolves to multiple local
		245	binding addresses.
231		246
232	You can see what Net::Server::Proto parsed out by looking at	247	You can see what Net::Server::Proto parsed out by looking at

Lines 26-30 Link Here

(-)Net-Server-0.99.ori/lib/Net/Server.pm (-32 / +58 lines)
26	use strict;	26	use strict;
27	use vars qw($VERSION);	27	use vars qw($VERSION);
28	use Socket qw(inet_aton inet_ntoa AF_INET AF_UNIX SOCK_DGRAM SOCK_STREAM);	28	use Socket qw(AF_INET AF_UNIX SOCK_DGRAM SOCK_STREAM);
29	use IO::Socket ();	29	use IO::Socket ();
30	use IO::Select ();	30	use IO::Select ();
Lines 356-361 Link Here
356	push @{ $prop->{host} }, (($prop->{host}->[-1]) x (@{ $prop->{port} } - @{ $prop->{host}})); # augment hosts with as many as port	356	push @{ $prop->{host} }, (($prop->{host}->[-1]) x (@{ $prop->{port} } - @{ $prop->{host}})); # augment hosts with as many as port
357	foreach my $host (@{ $prop->{host} }) {	357	foreach my $host (@{ $prop->{host} }) {
358	$host = '*' if ! defined $host \|\| ! length $host;;	358	local $1;
359	$host = ($host =~ /^([\w\.\-\*\/]+)$/) ? $1 : $self->fatal("Unsecure host \"$host\"");	359	if (!defined $host \|\| $host eq '' \|\| $host eq '*') {
		360	$host = '*';
		361	} elsif ($host =~ /^\[([\w\/.:-]+)\]$/ \|\| $host =~ /^([\w\/.:-]+)$/) {
		362	$host = $1;
		363	} else {
		364	$self->fatal("Unsecure host \"$host\"");
		365	}
360	}	366	}
361		367
Lines 377-386 Link Here
377	my $host = $prop->{host}->[$i];	383	my $host = $prop->{host}->[$i];
378	my $proto = $prop->{proto}->[$i];	384	my $proto = $prop->{proto}->[$i];
379	if ($port ne 0 && $bound{"$host/$port/$proto"}++) {	385	if ($port ne "0" && $bound{"$host/$port/$proto"}++) {
380	$self->log(2, "Duplicate configuration (".(uc $proto)." port $port on host $host - skipping");	386	$self->log(2, "Duplicate configuration (".(uc $proto)." port $port on host $host - skipping");
381	next;	387	next;
382	}	388	}
383	my $obj = $self->proto_object($host, $port, $proto) \|\| next;	389	my @obj_list = $self->proto_object($host, $port, $proto);
384	push @{ $prop->{sock} }, $obj;	390	for my $obj (@obj_list) {
		391	push @{ $prop->{sock} }, $obj if $obj;
		392	}
385	}	393	}
386	if (! @{ $prop->{sock} }) {	394	if (! @{ $prop->{sock} }) {
Lines 397-401 Link Here
397	}	405	}
398		406
399	### method for invoking procol specific bindings	407	### method for invoking procol specific bindings;
		408	### returns any number of sockets,
		409	### one for each protocol family (PF_INET or PF_INET6) and each bind address
400	sub proto_object {	410	sub proto_object {
401	my $self = shift;	411	my $self = shift;
Lines 440-445 Link Here
440	}	450	}
441		451
442	### if more than one port we'll need to select on it	452	### if more than one socket we'll need to select on it;
443	if( @{ $prop->{port} } > 1 \|\| $prop->{multi_port} ){	453	### note there may be more than one socket per port,
		454	### one for each protocol family (PF_INET and PF_INET6)
		455	if( @{ $prop->{sock} } > 1 \|\| $prop->{multi_port} ){
444	$prop->{multi_port} = 1;	456	$prop->{multi_port} = 1;
445	$prop->{select} = IO::Select->new();	457	$prop->{select} = IO::Select->new();
Lines 748-752 Link Here
748	return;	760	return;
749	} elsif ($self->isa('Net::Server::INET')) {	761	} elsif ($self->isa('Net::Server::INET')) {
750	$prop->{sockaddr} = $ENV{'REMOTE_HOST'} \|\| '0.0.0.0';	762	# since we do not know a socket protocol family, we are unable
		763	# to choose between '0.0.0.0' and '::' as an unspecified address
		764	$prop->{sockaddr} = $ENV{'REMOTE_HOST'} \|\| '0.0.0.0'; # or is is a '::' ?
751	$prop->{peeraddr} = '0.0.0.0';	765	$prop->{peeraddr} = '0.0.0.0';
752	$prop->{sockhost} = $prop->{peerhost} = 'inetd.server';	766	$prop->{sockhost} = $prop->{peerhost} = 'inetd.server';
Lines 756-767 Link Here
756		770
757	### read information about this connection	771	### read information about this connection
758	my $sockname = getsockname( $sock );	772	my $sockname = $sock->sockname;
759	if( $sockname ){	773	if( $sockname ){
760	($prop->{sockport}, $prop->{sockaddr})	774	$prop->{sockaddr} = $sock->sockhost;
761	= Socket::unpack_sockaddr_in( $sockname );	775	$prop->{sockport} = $sock->sockport;
762	$prop->{sockaddr} = inet_ntoa( $prop->{sockaddr} );
763
764	}else{	776	}else{
765	### does this only happen from command line?	777	### does this only happen from command line?
		778	# since we do not know a socket protocol family, we are unable
		779	# to choose between '0.0.0.0' and '::' as an unspecified address
766	$prop->{sockaddr} = $ENV{'REMOTE_HOST'} \|\| '0.0.0.0';	780	$prop->{sockaddr} = $ENV{'REMOTE_HOST'} \|\| '0.0.0.0';
767	$prop->{sockhost} = 'inet.test';	781	$prop->{sockhost} = 'inet.test';
Lines 773-788 Link Here
773	if( $prop->{udp_true} ){	787	if( $prop->{udp_true} ){
774	$proto_type = 'UDP';	788	$proto_type = 'UDP';
775	($prop->{peerport} ,$prop->{peeraddr})	789	($prop->{peerport}, $prop->{peeraddrn}) =
776	= Socket::sockaddr_in( $prop->{udp_peer} );	790	$sock->sockdomain == AF_INET ? Socket::sockaddr_in($prop->{udp_peer})
777	}elsif( $prop->{peername} = getpeername( $sock ) ){	791	: Socket6::sockaddr_in6($prop->{udp_peer});
778	($prop->{peerport}, $prop->{peeraddr})	792	$prop->{peeraddr} = Socket6->UNIVERSAL::can('inet_ntop')
779	= Socket::unpack_sockaddr_in( $prop->{peername} );	793	? Socket6::inet_ntop($sock->sockdomain, $prop->{peeraddrn})
780	}	794	: inet_ntoa( $prop->{peeraddrn} );
781		795	}elsif( $prop->{peername} = $sock->peername ){
782	if( $prop->{peername} \|\| $prop->{udp_true} ){	796	$prop->{peeraddrn} = $sock->peeraddr; # binary
783	$prop->{peeraddr} = inet_ntoa( $prop->{peeraddr} );	797	$prop->{peeraddr} = $sock->peerhost; # ascii
784		798	$prop->{peerport} = $sock->peerport;
785	if( defined $prop->{reverse_lookups} ){	799	}
786	$prop->{peerhost} = gethostbyaddr( inet_aton($prop->{peeraddr}), AF_INET );	800
		801	if( $prop->{peeraddrn} ){
		802	if( !defined $prop->{reverse_lookups} ){
		803	# no reverse DNS resolving
		804	}elsif( Socket6->UNIVERSAL::can('getnameinfo') ){
		805	my @res = Socket6::getnameinfo( $prop->{peeraddrn}, 0 );
		806	$prop->{peerhost} = $res[0] if @res > 1;
		807	}else{
		808	$prop->{peerhost} = gethostbyaddr( $prop->{peeraddrn}, AF_INET );
787	}	809	}
788	$prop->{peerhost} = '' unless defined $prop->{peerhost};	810	$prop->{peerhost} = '' unless defined $prop->{peerhost};
Lines 790-793 Link Here
790	}else{	812	}else{
791	### does this only happen from command line?	813	### does this only happen from command line?
		814	# since we do not know a socket protocol family, we are unable
		815	# to choose between '0.0.0.0' and '::' as an unspecified address
792	$prop->{peeraddr} = '0.0.0.0';	816	$prop->{peeraddr} = '0.0.0.0';
793	$prop->{peerhost} = 'inet.test';	817	$prop->{peerhost} = 'inet.test';
Lines 796-801 Link Here
796		820
797	$self->log(3,$self->log_time	821	$self->log(3,$self->log_time
798	." CONNECT $proto_type Peer: \"$prop->{peeraddr}:$prop->{peerport}\""	822	." CONNECT $proto_type Peer: \"[$prop->{peeraddr}]:$prop->{peerport}\""
799	." Local: \"$prop->{sockaddr}:$prop->{sockport}\"\n");	823	." Local: \"[$prop->{sockaddr}]:$prop->{sockport}\"\n");
800		824
801	}	825	}
Lines 1141-1149 Link Here
1141	foreach my $sock ( @{ $prop->{sock} } ){	1165	foreach my $sock ( @{ $prop->{sock} } ){
1142		1166
1143	### duplicate the sock	1167	### duplicate the socket descriptor
1144	my $fd = POSIX::dup($sock->fileno)	1168	my $fd = POSIX::dup($sock->fileno)
1145	or $self->fatal("Can't dup socket [$!]");	1169	or $self->fatal("Can't dup socket [$!]");
1146		1170
1147	### hold on to the socket copy until exec	1171	### hold on to the socket copy until exec;
		1172	### just temporary: any socket domain will do,
		1173	### forked process will decide to use IO::Socket::INET6 if necessary
1148	$prop->{_HUP}->[$i] = IO::Socket::INET->new;	1174	$prop->{_HUP}->[$i] = IO::Socket::INET->new;
1149	$prop->{_HUP}->[$i]->fdopen($fd, 'w')	1175	$prop->{_HUP}->[$i]->fdopen($fd, 'w')
Lines 1153-1157 Link Here
1153	$prop->{_HUP}->[$i]->fcntl( Fcntl::F_SETFD(), my $flags = "" );	1179	$prop->{_HUP}->[$i]->fcntl( Fcntl::F_SETFD(), my $flags = "" );
1154		1180
1155	### save host,port,proto, and file descriptor	1181	### save file descriptor and host\|port\|proto\|family
1156	push @fd, $fd .'\|'. $sock->hup_string;	1182	push @fd, $fd .'\|'. $sock->hup_string;
1157		1183




bound at server startup.  May be of the form
C<host:port/proto>, C<host:port>, C<port/proto>, or C<port>,
where I<host> represents a hostname residing on the local box,
where I<port> represents either the number of the port (eg. "80")
or the service designation (eg. "http"), and where I<proto>
represents the protocol to be used. See L<Net::Server::Proto>.

An explicit I<host> given in a port specification overrides
a default binding address (a C<host> setting, see below).
The I<host> part may be enclosed in square brackets, but when it is
a numerical IPv6 address it B<must> be enclosed in square brackets
to avoid ambiguity in parsing a port number, e.g.: "[::1]:80".

If you are working with unix sockets, you may also specify
C<socket_file|unix> or C<socket_file|type|unix> where type is SOCK_DGRAM
or SOCK_STREAM.  If the protocol is not specified, I<proto> will
default to the C<proto> specified in the arguments.  If C<proto> is not
specified there it will default to "tcp".  If I<host> is not
specified, I<host> will default to C<host> specified in the
arguments.  If C<host> is not specified there it will default to "*".
Default port is 20203.  Configuration passed to new or run may be either
a scalar containing a single port number or an arrayref of ports.

On an IPv6-enabled host where a module IO::Socket::INET6 is installed
the "*" implies two listening sockets, one for each of the protocols
(PF_INET and PF_INET6) and is equivalent to specifying two ports, bound
to an 'unspecified' address of each address family ("0.0.0.0" and "::").
If listening on an INET6 socket is not desired despite IO::Socket::INET6
module being available, please supply the 'unspecifed' INET (IPv4) address
'0.0.0.0' as a I<host>, either in the C<port> or in the C<host> argument.

An INET socket can only accept IPv4 connections. An INET6 socket accepts
IPv6 connections, but may also accept IPv4 connections depending on
OS and its settings. For example, on FreeBSD systems setting a sysctl
net.inet6.ip6.v6only to 0 will allow IPv4 connections to an INET6 socket.
If this is the case, specifying "::" as a binding address instead of a "*"
might be desired to reduce the number of sockets needed. Note that a
textual representation of a peer's IPv4 address as connected to an INET6
socket will typically be in a form of an IPv4-mapped IPv6 addresses,
e.g. "::FFFF:127.0.0.1" .

Restricting binding to a loopback interface on systems where an INET6
socket does not accept IPv4 connections requires creating two sockets,
one bound to address "127.0.0.1" and the other bound to address "::1".

On systems that support it, a port value of 0 may be used to ask

Local host or addr upon which to bind port.  If a value of '*' is
given, the server will bind that port on all available addresses
on the box.  The C<host> argument provides a default local host
address if the C<port> argument omits a host specification.
See L<Net::Server::Proto>. See L<IO::Socket>.  Configuration
passed to new or run may be either a scalar containing a single
host or an arrayref of hosts - if the hosts array is shorter than

Return to bug 370355

Lines 556-574 Link Here

(-)Net-Server-0.99.ori/lib/Net/Server.pod (-13 / +42 lines)
556	bound at server startup. May be of the form	556	bound at server startup. May be of the form
557	C<host:port/proto>, C<host:port>, C<port/proto>, or C<port>,	557	C<host:port/proto>, C<host:port>, C<port/proto>, or C<port>,
558	where I<host> represents a hostname residing on the local	558	where I<host> represents a hostname residing on the local box,
559	box, where I<port> represents either the number of the port	559	where I<port> represents either the number of the port (eg. "80")
560	(eg. "80") or the service designation (eg. "http"), and	560	or the service designation (eg. "http"), and where I<proto>
561	where I<proto> represents the protocol to be used. See	561	represents the protocol to be used. See L<Net::Server::Proto>.
562	L<Net::Server::Proto>. If you are working with unix sockets,	562
563	you may also specify C<socket_file\|unix> or	563	An explicit I<host> given in a port specification overrides
564	C<socket_file\|type\|unix> where type is SOCK_DGRAM or	564	a default binding address (a C<host> setting, see below).
565	SOCK_STREAM. If the protocol is not specified, I<proto> will	565	The I<host> part may be enclosed in square brackets, but when it is
		566	a numerical IPv6 address it B<must> be enclosed in square brackets
		567	to avoid ambiguity in parsing a port number, e.g.: "[::1]:80".
		568
		569	If you are working with unix sockets, you may also specify
		570	C<socket_file\|unix> or C<socket_file\|type\|unix> where type is SOCK_DGRAM
		571	or SOCK_STREAM. If the protocol is not specified, I<proto> will
566	default to the C<proto> specified in the arguments. If C<proto> is not	572	default to the C<proto> specified in the arguments. If C<proto> is not
567	specified there it will default to "tcp". If I<host> is not	573	specified there it will default to "tcp". If I<host> is not
568	specified, I<host> will default to C<host> specified in the	574	specified, I<host> will default to C<host> specified in the
569	arguments. If C<host> is not specified there it will	575	arguments. If C<host> is not specified there it will default to "*".
570	default to "*". Default port is 20203. Configuration passed	576	Default port is 20203. Configuration passed to new or run may be either
571	to new or run may be either a scalar containing a single port	577	a scalar containing a single port number or an arrayref of ports.
572	number or an arrayref of ports.	578
		579	On an IPv6-enabled host where a module IO::Socket::INET6 is installed
		580	the "*" implies two listening sockets, one for each of the protocols
		581	(PF_INET and PF_INET6) and is equivalent to specifying two ports, bound
		582	to an 'unspecified' address of each address family ("0.0.0.0" and "::").
		583	If listening on an INET6 socket is not desired despite IO::Socket::INET6
		584	module being available, please supply the 'unspecifed' INET (IPv4) address
		585	'0.0.0.0' as a I<host>, either in the C<port> or in the C<host> argument.
		586
		587	An INET socket can only accept IPv4 connections. An INET6 socket accepts
		588	IPv6 connections, but may also accept IPv4 connections depending on
		589	OS and its settings. For example, on FreeBSD systems setting a sysctl
		590	net.inet6.ip6.v6only to 0 will allow IPv4 connections to an INET6 socket.
		591	If this is the case, specifying "::" as a binding address instead of a "*"
		592	might be desired to reduce the number of sockets needed. Note that a
		593	textual representation of a peer's IPv4 address as connected to an INET6
		594	socket will typically be in a form of an IPv4-mapped IPv6 addresses,
		595	e.g. "::FFFF:127.0.0.1" .
		596
		597	Restricting binding to a loopback interface on systems where an INET6
		598	socket does not accept IPv4 connections requires creating two sockets,
		599	one bound to address "127.0.0.1" and the other bound to address "::1".
573		600
574	On systems that support it, a port value of 0 may be used to ask	601	On systems that support it, a port value of 0 may be used to ask
Lines 583-587 Link Here
583	Local host or addr upon which to bind port. If a value of '*' is	610	Local host or addr upon which to bind port. If a value of '*' is
584	given, the server will bind that port on all available addresses	611	given, the server will bind that port on all available addresses
585	on the box. See L<Net::Server::Proto>. See L<IO::Socket>. Configuration	612	on the box. The C<host> argument provides a default local host
		613	address if the C<port> argument omits a host specification.
		614	See L<Net::Server::Proto>. See L<IO::Socket>. Configuration
586	passed to new or run may be either a scalar containing a single	615	passed to new or run may be either a scalar containing a single
587	host or an arrayref of hosts - if the hosts array is shorter than	616	host or an arrayref of hosts - if the hosts array is shorter than

Lines 35-43 Link Here

(-)Net-Server-0.99.ori/lib/Net/Server/Proto/UDP.pm (-19 / +23 lines)
35	my $class = ref($type) \|\| $type \|\| __PACKAGE__;	35	my $class = ref($type) \|\| $type \|\| __PACKAGE__;
36		36
37	my $sock = $class->SUPER::object( @_ );
38
39	$sock->NS_proto('UDP');
40
41	### set a few more parameters
42	my($default_host,$port,$server) = @_;	37	my($default_host,$port,$server) = @_;
43	my $prop = $server->{server};	38	my $prop = $server->{server};
Lines 62-94 Link Here
62	&& $prop->{udp_broadcast};	57	&& $prop->{udp_broadcast};
63		58
64	$sock->NS_recv_len( $prop->{udp_recv_len} );	59	my @sockets_list = $class->SUPER::object( @_ );
65	$sock->NS_recv_flags( $prop->{udp_recv_flags} );
66		60
67	return $sock;	61	foreach my $sock ( @sockets_list ){
		62	$sock->NS_proto('UDP');
		63	$sock->NS_recv_len( $prop->{udp_recv_len} );
		64	$sock->NS_recv_flags( $prop->{udp_recv_flags} );
		65	}
		66
		67	### returns any number of sockets,
		68	### one for each protocol family (PF_INET or PF_INET6) and each bind address
		69	return !wantarray ? $sockets_list[0] : @sockets_list;
68	}	70	}
69		71
70		72
71	### connect the first time	73	### bind the first time
72	### doesn't support the listen or the reuse option	74	### doesn't support the listen or the reuse option
73	sub connect {	75	sub connect {
74	my $sock = shift;	76	my $sock = shift;
75	my $server = shift;	77	my $server = shift;
76	my $prop = $server->{server};	78	my $prop = $server->{server};
77		79
78	my $host = $sock->NS_host;	80	my $host = $sock->NS_host;
79	my $port = $sock->NS_port;	81	my $port = $sock->NS_port;
		82	my $pfamily = $sock->NS_family \|\| 0;
80		83
81	my %args = ();	84	my %args;
82	$args{LocalPort} = $port; # what port to bind on	85	$args{LocalPort} = $port; # what port to bind on
83	$args{Proto} = 'udp'; # what procol to use	86	$args{Proto} = 'udp'; # what procol to use
84	$args{LocalAddr} = $host if $host !~ /\/; # what local address ( is all)	87	$args{LocalAddr} = $host if $host !~ /\/; # what local address ( is all)
		88	$args{Domain} = $pfamily if $Net::Server::Proto::TCP::have_inet6 && $pfamily;
85	$args{Reuse} = 1; # allow us to rebind the port on a restart	89	$args{Reuse} = 1; # allow us to rebind the port on a restart
86	$args{Broadcast} = 1 if $prop->{udp_broadcast};	90	$args{Broadcast} = 1 if $prop->{udp_broadcast};
87		91
88	### connect to the sock	92	### bind to the sock
89	$sock->SUPER::configure(\%args)	93	$sock->SUPER::configure(\%args)
90	or $server->fatal("Can't connect to UDP port $port on $host [$!]");	94	or $server->fatal("Can't bind to UDP port $port on $host [$!]");
91		95
92	$server->fatal("Back sock [$!]!".caller())	96	$server->fatal("Bad sock [$!]!".caller())
93	unless $sock;	97	unless $sock;
94		98