File Coverage

blib/lib/Plack/Handler/Net/Async/HTTP/Server.pm

Criterion	Covered	Total	%
statement	11	54	20.3
branch	0	22	0.0
condition	0	5	0.0
subroutine	4	7	57.1
pod	2	2	100.0
total	17	90	18.8

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2013-2024 -- [e-mail]

package Plack::Handler::Net::Async::HTTP::Server 0.15;

use v5.14;
use warnings;

use Net::Async::HTTP::Server::PSGI;
use IO::Async::Loop;

=head1 NAME

C - HTTP handler for Plack using L

=head1 SYNOPSIS

   use Plack::Handler::Net::Async::HTTP::Server;

   my $handler = Plack::Handler::Net::Async::HTTP::Server->new(
      listen => [ ":8080" ],
   );

   sub psgi_app { ... }

   $handler->run( \&psgi_app );

=head1 DESCRIPTION

This module allows L to run a L application as a standalone
HTTP daemon under L, by using L.

   plackup -s Net::Async::HTTP::Server --listen ":8080" application.psgi

This is internally implemented using L;
further information on environment etc.. is documented there.

If L is available, this handler supports accepting connections
via C

   plackup -s Net::Async::HTTP::Server --ssl ...

Or per-listen argument by appending C<:SSL>, as

   plackup -s Net::Async::HTTP::Server --listen ":8443:SSL" ...

Any other options whose names start C will be passed on to the SSL
listen method.

=cut

=head1 CONSTRUCTOR

=head2 new

   $handler = Plack::Handler::Net::Async::HTTP::Server->new( %args );

Returns a new instance of a C
object. Takes the following named arguments:

=over 4

=item listen => ARRAY of STRING

Reference to an array containing listen string specifications. Each string
gives a port number and optional hostname, given as C<:port> or C.

=item server_ready => CODE

Reference to code to invoke when the server is set up and listening, ready to
accept connections. It is invoked with a HASH reference containing the
following details:

   $server_ready->( {
      host            => HOST,
      port            => SERVICE,
      server_software => NAME,
   } )

=item socket => STRING

Gives a UNIX socket path to listen on, instead of a TCP socket.

=item queuesize => INT

Optional. If provided, sets the C queue size for creating listening
sockets. If missing, a default of 10 is used.

=back

=cut

sub new
{
   my $class = shift;
   my %opts = @_;

   delete $opts{host};
   delete $opts{port};
   delete $opts{socket};

   my $self = bless {
      map { $_ => delete $opts{$_} } qw( listen server_ready queuesize ),
   }, $class;

   # Grab all of the SSL options
   $self->{ssl} = 1 if exists $opts{ssl}; delete $opts{ssl};
   $self->{$_} = delete $opts{$_} for grep m/^ssl_/, keys %opts;

   keys %opts and die "Unrecognised keys " . join( ", ", sort keys %opts );

   return $self;
}

=head1 METHODS

=cut

=head2 run

   $handler->run( $psgi_app );

Creates the HTTP-listening socket or sockets, and runs the given PSGI
application for received requests.

=cut

sub run
{
   my $self = shift;
   my ( $app ) = @_;

   my $loop = IO::Async::Loop->new;
   my $queuesize = $self->{queuesize} || 10;

   foreach my $listen ( @{ $self->{listen} } ) {
      my $httpserver = Net::Async::HTTP::Server::PSGI->new(
         app => $app,
      );

      $loop->add( $httpserver );

      # IPv6 addresses contain colons. They'll be wrapped in [] brackets
      my $host;
      my $path;

      if( $listen =~ s/^\[([0-9a-f:]+)\]://i ) {
         $host = $1;
      }
      elsif( $listen =~ s/^([^:]+?):// ) {
         $host = $1;
      }
      elsif( $listen =~ s/^:// ) {
         # OK
      }
      else {
         $path = $listen;
      }

      if( defined $path ) {
         require IO::Socket::UNIX;

         unlink $path if -e $path;

         my $socket = IO::Socket::UNIX->new(
            Local  => $path,
            Listen => $queuesize,
         ) or die "Cannot listen on $path - $!";

         $httpserver->configure( handle => $socket );
      }
      else {
         my ( $service, $ssl ) = split m/:/, $listen;
         $ssl ||= $self->{ssl};

         my %SSL_args;
         if( $ssl ) {
            require IO::Async::SSL;
            %SSL_args = (
               extensions => [qw( SSL )],
            );

            foreach my $key ( grep m/^ssl_/, keys %$self ) {
               my $val = $self->{$key};
               # IO::Async::Listener extension wants uppercase "SSL"
               $key =~ s/^ssl/SSL/;

               $SSL_args{$key} = $val;
            };
         }

         $httpserver->listen(
            host     => $host,
            service  => $service,
            socktype => "stream",
            queuesize => $queuesize,

            %SSL_args,

            on_notifier => sub {
               $self->{server_ready}->( {
                  host            => $host,
                  port            => $service,
                  proto           => $ssl ? "https" : "http",
                  server_software => ref $self,
               } ) if $self->{server_ready};
            },
         )->get;
      }
   }

   $loop->run;
}

=head1 SEE ALSO

=over 4

=item *

L - serve HTTP with L

=item *

L - Perl Superglue for Web frameworks and Web Servers (PSGI toolkit)

=back

=head1 AUTHOR

Paul Evans

=cut

0x55AA;