view release on metacpan or  search on metacpan

lib/IO/Async/OS.pm  view on Meta::CPAN

use constant HAVE_SIGNALS => 1;

# Do we support POSIX-style true fork()ed processes at all?
use constant HAVE_POSIX_FORK => !$ENV{IO_ASYNC_NO_FORK};
# Can we potentially support threads? (would still need to 'require threads')
use constant HAVE_THREADS => !$ENV{IO_ASYNC_NO_THREADS} &&
   eval { require Config && $Config::Config{useithreads} };

# Preferred trial order for built-in Loop classes
use constant LOOP_BUILTIN_CLASSES => qw( Poll Select );

# Should there be any other Loop classes we try before the builtin ones?
use constant LOOP_PREFER_CLASSES => ();

=head1 NAME

C<IO::Async::OS> - operating system abstractions for C<IO::Async>

=head1 DESCRIPTION

=for highlighter language=perl

This module acts as a class to provide a number of utility methods whose exact
behaviour may depend on the type of OS it is running on. It is provided as a
class so that specific kinds of operating system can override methods in it.

As well as these support functions it also provides a number of constants, all
with names beginning C<HAVE_> which describe various features that may or may
not be available on the OS or perl build. Most of these are either hard-coded
per OS, or detected at runtime.

The following constants may be overridden by environment variables.

=over 4

=item * HAVE_POSIX_FORK

True if the C<fork()> call has full POSIX semantics (full process separation).
This is true on most OSes but false on MSWin32.

This may be overridden to be false by setting the environment variable
C<IO_ASYNC_NO_FORK>.

=item * HAVE_THREADS

True if C<ithreads> are available, meaning that the C<threads> module can be
used. This depends on whether perl was built with threading support.

This may be overridable to be false by setting the environment variable
C<IO_ASYNC_NO_THREADS>.

=back

=cut

=head2 getfamilybyname

   $family = IO::Async::OS->getfamilybyname( $name )

Return a protocol family value based on the given name. If C<$name> looks like
a number it will be returned as-is. The string values C<inet>, C<inet6> and
C<unix> will be converted to the appropriate C<AF_*> constant.

=cut

sub getfamilybyname
{
   shift;
   my ( $name ) = @_;

   return undef unless defined $name;

   return $name if $name =~ m/^\d+$/;

   return AF_INET    if $name eq "inet";
   return AF_INET6() if $name eq "inet6" and defined &AF_INET6;
   return AF_UNIX    if $name eq "unix";

   croak "Unrecognised socket family name '$name'";
}

=head2 getsocktypebyname

   $socktype = IO::Async::OS->getsocktypebyname( $name );

Return a socket type value based on the given name. If C<$name> looks like a
number it will be returned as-is. The string values C<stream>, C<dgram> and
C<raw> will be converted to the appropriate C<SOCK_*> constant.

=cut

sub getsocktypebyname
{
   shift;
   my ( $name ) = @_;

   return undef unless defined $name;

   return $name if $name =~ m/^\d+$/;

   return SOCK_STREAM if $name eq "stream";
   return SOCK_DGRAM  if $name eq "dgram";
   return SOCK_RAW    if $name eq "raw";

   croak "Unrecognised socktype name '$name'";
}

# This one isn't documented because it's not really overridable. It's largely
# here just for completeness
my $HAVE_IO_SOCKET_IP;

sub socket
{
   my $self = shift;
   my ( $family, $socktype, $proto ) = @_;

   require IO::Socket;
   defined $HAVE_IO_SOCKET_IP or
      $HAVE_IO_SOCKET_IP = defined eval { require IO::Socket::IP };

   croak "Cannot create a new socket without a family" unless $family;
   # PF_UNSPEC and undef are both false
   $family = $self->getfamilybyname( $family ) || AF_UNIX;

   # SOCK_STREAM is the most likely
   $socktype = $self->getsocktypebyname( $socktype ) || SOCK_STREAM;

   $proto //= 0;

   if( $HAVE_IO_SOCKET_IP and ( $family == AF_INET || $family == AF_INET6() ) ) {
      return IO::Socket::IP->new->socket( $family, $socktype, $proto );
   }

   my $sock = eval {
      IO::Socket->new(
         Domain => $family,

lib/IO/Async/OS.pm  view on Meta::CPAN

sub extract_addrinfo
{
   my $self = shift;
   my ( $ai, $argname ) = @_;

   $argname ||= "addr";

   my @ai;

   if( ref $ai eq "ARRAY" ) {
      @ai = @$ai;
   }
   elsif( ref $ai eq "HASH" ) {
      $ai = { %$ai }; # copy so we can delete from it
      @ai = delete @{$ai}{qw( family socktype protocol addr )};

      if( defined $ai[ADDRINFO_FAMILY] and !defined $ai[ADDRINFO_ADDR] ) {
         my $family = $ai[ADDRINFO_FAMILY];
         my $method = "_extract_addrinfo_$family";
         my $code = $self->can( $method ) or croak "Cannot determine addr for extract_addrinfo on family='$family'";

         $ai[ADDRINFO_ADDR] = $code->( $self, $ai );

         keys %$ai and croak "Unrecognised '$family' addrinfo keys: " . join( ", ", keys %$ai );
      }
   }
   else {
      croak "Expected '$argname' to be an ARRAY or HASH reference";
   }

   $ai[ADDRINFO_FAMILY]   = $self->getfamilybyname( $ai[ADDRINFO_FAMILY] );
   $ai[ADDRINFO_SOCKTYPE] = $self->getsocktypebyname( $ai[ADDRINFO_SOCKTYPE] );

   # Make sure all fields are defined
   $ai[$_] ||= 0 for ADDRINFO_FAMILY, ADDRINFO_SOCKTYPE, ADDRINFO_PROTOCOL;
   $ai[ADDRINFO_ADDR]  = "" if !defined $ai[ADDRINFO_ADDR];

   return @ai;
}

=item family => 'inet'

Will pack an IP address and port number from keys called C<ip> and C<port>.
If C<ip> is missing it will be set to "0.0.0.0". If C<port> is missing it will
be set to 0.

=cut

sub _extract_addrinfo_inet
{
   my $self = shift;
   my ( $ai ) = @_;

   my $port = delete $ai->{port} || 0;
   my $ip   = delete $ai->{ip}   || "0.0.0.0";

   return pack_sockaddr_in( $port, inet_aton( $ip ) );
}

=item family => 'inet6'

Will pack an IP address and port number from keys called C<ip> and C<port>.
If C<ip> is missing it will be set to "::". If C<port> is missing it will be
set to 0. Optionally will also include values from C<scopeid> and C<flowinfo>
keys if provided.

This will only work if a C<pack_sockaddr_in6> function can be found in
C<Socket>

=cut

sub _extract_addrinfo_inet6
{
   my $self = shift;
   my ( $ai ) = @_;

   my $port     = delete $ai->{port}     || 0;
   my $ip       = delete $ai->{ip}       || "::";
   my $scopeid  = delete $ai->{scopeid}  || 0;
   my $flowinfo = delete $ai->{flowinfo} || 0;

   if( HAVE_SOCKADDR_IN6 ) {
      return pack_sockaddr_in6( $port, inet_pton( AF_INET6, $ip ), $scopeid, $flowinfo );
   }
   else {
      croak "Cannot pack_sockaddr_in6";
   }
}

=item family => 'unix'

Will pack a UNIX socket path from a key called C<path>.

=cut

sub _extract_addrinfo_unix
{
   my $self = shift;
   my ( $ai ) = @_;

   defined( my $path = delete $ai->{path} ) or croak "Expected 'path' for extract_addrinfo on family='unix'";

   return pack_sockaddr_un( $path );
}

=pod

=back

=cut

=head2 make_addr_for_peer

   $connectaddr = IO::Async::OS->make_addr_for_peer( $family, $listenaddr );

Given the C<sockdomain> and C<sockname> of a listening socket. creates an
address suitable to C<connect()> to it.

This method will handle specially any C<AF_INET> address bound to
C<INADDR_ANY> or any C<AF_INET6> address bound to C<IN6ADDR_ANY>, as some OSes
do not allow C<connect(2)>ing to those and would instead insist on receiving
C<INADDR_LOOPBACK> or C<IN6ADDR_LOOPBACK> respectively.

This method is used by the C<< ->connect( peer => $sock ) >> parameter of
handle and loop connect methods.

=cut

sub make_addr_for_peer
{
   shift;
   my ( $p_family, $p_addr ) = @_;