File Coverage

blib/lib/Plack/Handler/Net/Async/HTTP/Server.pm
Criterion Covered Total %
statement 12 55 21.8
branch 0 22 0.0
condition 0 5 0.0
subroutine 4 7 57.1
pod 2 2 100.0
total 18 91 19.7


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk
5              
6             package Plack::Handler::Net::Async::HTTP::Server;
7              
8 1     1   1843 use strict;
  1         2  
  1         30  
9 1     1   5 use warnings;
  1         2  
  1         27  
10              
11 1     1   485 use Net::Async::HTTP::Server::PSGI;
  1         3  
  1         34  
12 1     1   863 use IO::Async::Loop;
  1         9836  
  1         727  
13              
14             our $VERSION = '0.12';
15              
16             =head1 NAME
17              
18             C - HTTP handler for Plack using L
19              
20             =head1 SYNOPSIS
21              
22             use Plack::Handler::Net::Async::HTTP::Server;
23              
24             my $handler = Plack::Handler::Net::Async::HTTP::Server->new(
25             listen => [ ":8080" ],
26             );
27              
28             sub psgi_app { ... }
29              
30             $handler->run( \&psgi_app );
31              
32             =head1 DESCRIPTION
33              
34             This module allows L to run a L application as a standalone
35             HTTP daemon under L, by using L.
36              
37             plackup -s Net::Async::HTTP::Server --listen ":8080" application.psgi
38              
39             This is internally implemented using L;
40             further information on environment etc.. is documented there.
41              
42             If L is available, this handler supports accepting connections
43             via C
44              
45             plackup -s Net::Async::HTTP::Server --ssl ...
46              
47             Or per-listen argument by appending C<:SSL>, as
48              
49             plackup -s Net::Async::HTTP::Server --listen ":8443:SSL" ...
50              
51             Any other options whose names start C will be passed on to the SSL
52             listen method.
53              
54             =cut
55              
56             =head1 METHODS
57              
58             =cut
59              
60             =head2 $handler = Plack::Handler::Net::Async::HTTP::Server->new( %args )
61              
62             Returns a new instance of a C
63             object. Takes the following named arguments:
64              
65             =over 4
66              
67             =item listen => ARRAY of STRING
68              
69             Reference to an array containing listen string specifications. Each string
70             gives a port number and optional hostname, given as C<:port> or C.
71              
72             =item server_ready => CODE
73              
74             Reference to code to invoke when the server is set up and listening, ready to
75             accept connections. It is invoked with a HASH reference containing the
76             following details:
77              
78             $server_ready->( {
79             host => HOST,
80             port => SERVICE,
81             server_software => NAME,
82             } )
83              
84             =item socket => STRING
85              
86             Gives a UNIX socket path to listen on, instead of a TCP socket.
87              
88             =item queuesize => INT
89              
90             Optional. If provided, sets the C queue size for creating listening
91             sockets. If missing, a default of 10 is used.
92              
93             =back
94              
95             =cut
96              
97             sub new
98             {
99 0     0 1   my $class = shift;
100 0           my %opts = @_;
101              
102 0           delete $opts{host};
103 0           delete $opts{port};
104 0           delete $opts{socket};
105              
106             my $self = bless {
107 0           map { $_ => delete $opts{$_} } qw( listen server_ready queuesize ),
  0            
108             }, $class;
109              
110             # Grab all of the SSL options
111 0 0         $self->{ssl} = 1 if exists $opts{ssl}; delete $opts{ssl};
  0            
112 0           $self->{$_} = delete $opts{$_} for grep m/^ssl_/, keys %opts;
113              
114 0 0         keys %opts and die "Unrecognised keys " . join( ", ", sort keys %opts );
115              
116 0           return $self;
117             }
118              
119             =head2 $handler->run( $psgi_app )
120              
121             Creates the HTTP-listening socket or sockets, and runs the given PSGI
122             application for received requests.
123              
124             =cut
125              
126             sub run
127             {
128 0     0 1   my $self = shift;
129 0           my ( $app ) = @_;
130              
131 0           my $loop = IO::Async::Loop->new;
132 0   0       my $queuesize = $self->{queuesize} || 10;
133              
134 0           foreach my $listen ( @{ $self->{listen} } ) {
  0            
135 0           my $httpserver = Net::Async::HTTP::Server::PSGI->new(
136             app => $app,
137             );
138              
139 0           $loop->add( $httpserver );
140              
141             # IPv6 addresses contain colons. They'll be wrapped in [] brackets
142 0           my $host;
143             my $path;
144              
145 0 0         if( $listen =~ s/^\[([0-9a-f:]+)\]://i ) {
    0          
    0          
146 0           $host = $1;
147             }
148             elsif( $listen =~ s/^([^:]+?):// ) {
149 0           $host = $1;
150             }
151             elsif( $listen =~ s/^:// ) {
152             # OK
153             }
154             else {
155 0           $path = $listen;
156             }
157              
158 0 0         if( defined $path ) {
159 0           require IO::Socket::UNIX;
160              
161 0 0         unlink $path if -e $path;
162              
163 0 0         my $socket = IO::Socket::UNIX->new(
164             Local => $path,
165             Listen => $queuesize,
166             ) or die "Cannot listen on $path - $!";
167              
168 0           $httpserver->configure( handle => $socket );
169             }
170             else {
171 0           my ( $service, $ssl ) = split m/:/, $listen;
172 0   0       $ssl ||= $self->{ssl};
173              
174 0           my %SSL_args;
175 0 0         if( $ssl ) {
176 0           require IO::Async::SSL;
177 0           %SSL_args = (
178             extensions => [qw( SSL )],
179             );
180              
181 0           foreach my $key ( grep m/^ssl_/, keys %$self ) {
182 0           my $val = $self->{$key};
183             # IO::Async::Listener extension wants uppercase "SSL"
184 0           $key =~ s/^ssl/SSL/;
185              
186 0           $SSL_args{$key} = $val;
187             };
188             }
189              
190             $httpserver->listen(
191             host => $host,
192             service => $service,
193             socktype => "stream",
194             queuesize => $queuesize,
195              
196             %SSL_args,
197              
198             on_notifier => sub {
199             $self->{server_ready}->( {
200             host => $host,
201             port => $service,
202             proto => $ssl ? "https" : "http",
203             server_software => ref $self,
204 0 0   0     } ) if $self->{server_ready};
    0          
205             },
206 0           )->get;
207             }
208             }
209              
210 0           $loop->run;
211             }
212              
213             =head1 SEE ALSO
214              
215             =over 4
216              
217             =item *
218              
219             L - serve HTTP with L
220              
221             =item *
222              
223             L - Perl Superglue for Web frameworks and Web Servers (PSGI toolkit)
224              
225             =back
226              
227             =head1 AUTHOR
228              
229             Paul Evans
230              
231             =cut
232              
233             0x55AA;