File Coverage

blib/lib/Net/Async/UWSGI/Server/Connection.pm
Criterion Covered Total %
statement 30 121 24.7
branch 0 44 0.0
condition 0 21 0.0
subroutine 10 30 33.3
pod 13 17 76.4
total 53 233 22.7


line stmt bran cond sub pod time code
1             package Net::Async::UWSGI::Server::Connection;
2             $Net::Async::UWSGI::Server::Connection::VERSION = '0.006';
3 2     2   8 use strict;
  2         3  
  2         63  
4 2     2   7 use warnings;
  2         3  
  2         65  
5              
6 2     2   8 use parent qw(IO::Async::Stream);
  2         2  
  2         12  
7              
8             =head1 NAME
9              
10             Net::Async::UWSGI::Server::Connection - represents an incoming connection to a server
11              
12             =head1 VERSION
13              
14             version 0.006
15              
16             =head1 DESCRIPTION
17              
18             =cut
19              
20 2     2   32500 use JSON::MaybeXS;
  2         8764  
  2         114  
21              
22 2     2   980 use URI::QueryParam;
  2         1174  
  2         64  
23 2     2   977 use IO::Async::Timer::Countdown;
  2         3087  
  2         70  
24              
25 2     2   11 use Encode qw(encode);
  2         3  
  2         92  
26 2     2   1025 use Protocol::UWSGI qw(:server);
  2         10919  
  2         300  
27 2     2   14 use List::UtilsBy qw(bundle_by);
  2         2  
  2         163  
28              
29             =head2 CONTENT_TYPE_HANDLER
30              
31             =cut
32              
33             our %CONTENT_TYPE_HANDLER = (
34             'application/javascript' => 'json',
35             );
36              
37 2     2   10 use constant USE_HTTP_RESPONSE => 0;
  2         2  
  2         2781  
38              
39             =head1 METHODS
40              
41             =cut
42              
43             =head2 configure
44              
45             Applies configuration parameters.
46              
47             =over 4
48              
49             =item * bus - the event bus
50              
51             =item * on_request - callback when we get an incoming request
52              
53             =back
54              
55             =cut
56              
57             sub configure {
58 0     0 1   my ($self, %args) = @_;
59 0           for(qw(bus on_request default_content_handler)) {
60 0 0         $self->{$_} = delete $args{$_} if exists $args{$_};
61             }
62 0           $self->SUPER::configure(%args);
63             }
64              
65 0     0 0   sub default_content_handler { shift->{default_content_handler} }
66              
67             =head2 json
68              
69             Accessor for the current JSON state
70              
71             =cut
72              
73 0   0 0 1   sub json { shift->{json} ||= JSON::MaybeXS->new(utf8 => 1) }
74              
75             =head2 on_read
76              
77             Base read handler for incoming traffic.
78              
79             Attempts to delegate to L as soon as we get the UWSGI
80             frame.
81              
82             =cut
83              
84             sub on_read {
85 0     0 1   my ( $self, $buffref, $eof ) = @_;
86 0 0         if(my $pkt = extract_frame($buffref)) {
    0          
87 0           $self->{env} = $pkt;
88             # We have a request, start processing
89 0           return $self->can('dispatch_request');
90             } elsif($eof) {
91             # EOF before a valid request? Bail out immediately
92 0           $self->cancel;
93             }
94 0           return 0;
95             }
96              
97             =head2 cancel
98              
99             Cancels any request in progress.
100              
101             If there's still a connection to the client,
102             they'll receive a 500 response.
103              
104             It's far more likely that the client has gone
105             away, in which case there's no response to send.
106              
107             =cut
108              
109             sub cancel {
110 0     0 1   my ($self) = @_;
111 0 0         $self->response->cancel unless $self->response->is_ready
112             }
113              
114             =head2 env
115              
116             Accessor for the UWSGI environment.
117              
118             =cut
119              
120 0     0 1   sub env { shift->{env} }
121              
122             =head2 response
123              
124             Resolves when the response is complete.
125              
126             =cut
127              
128             sub response {
129 0   0 0 1   $_[0]->{response} ||= $_[0]->loop->new_future;
130             }
131              
132             =head2 dispatch_request
133              
134             At this point we have a request including headers,
135             and we should know whether there's a body involved
136             somewhere.
137              
138             =cut
139              
140             sub dispatch_request {
141 0     0 1   my ($self, $buffref, $eof) = @_;
142              
143             # Plain GET request? We might be able to bail out here
144 0 0         return $self->finish_request unless $self->has_body;
145              
146 0           my $env = $self->env;
147 0   0       my $handler = $self->default_content_handler || 'raw';
148 0 0         if(my $type = $env->{CONTENT_TYPE}) {
149 0 0         $handler = $CONTENT_TYPE_HANDLER{$type} if exists $CONTENT_TYPE_HANDLER{$type};
150             }
151 0           $handler = 'content_handler_' . $handler;
152 0           $self->{input_handler} = $self->${\"curry::weak::$handler"};
  0            
153              
154             # Try to read N bytes if we have content length. Most UWSGI implementations seem
155             # to set this.
156 0 0         if(exists $env->{CONTENT_LENGTH}) {
157 0           $self->{remaining} = $env->{CONTENT_LENGTH};
158 0           return $self->can('read_to_length');
159             }
160              
161             # Streaming might be nice, but nginx has no support for this
162 0 0 0       if(exists $env->{HTTP_TRANSFER_ENCODING} && $env->{HTTP_TRANSFER_ENCODING} eq 'chunked') {
163 0           return $self->can('read_chunked');
164             }
165 0           die "no idea how to handle this, missing length and not chunked";
166             }
167              
168             sub finish_request {
169 0     0 0   my ($self) = @_;
170 0 0         $self->{request_body} = $self->{input_handler}->()
171             if $self->has_body;
172             $self->{completion} = $self->{on_request}->($self)
173             ->then($self->curry::write_response)
174             ->on_fail(sub {
175 0     0     $self->debug_printf("Failed while attempting to handle request: %s (%s)", @_);
176 0           })->on_ready($self->curry::close_now);
177             return sub {
178 0     0     my ($self, $buffref, $eof) = @_;
179 0 0 0       $self->{completion}->cancel if $eof && !$self->{completion}->is_ready;
180 0           0
181             }
182 0           }
183              
184             {
185             my %methods_with_body = (
186             PUT => 1,
187             POST => 1,
188             PROPPATCH => 1,
189             );
190              
191             =head2 has_body
192              
193             Returns true if we're expecting a request body
194             for the current request method.
195              
196             =cut
197              
198             sub has_body {
199 0     0 1   my ($self, $env) = @_;
200 0 0         return 1 if $methods_with_body{$self->env->{REQUEST_METHOD}};
201 0           return 0;
202             }
203             }
204              
205             =head2 read_chunked
206              
207             Read handler for chunked data. Unlikely to be used by any real implementations.
208              
209             =cut
210              
211             sub read_chunked {
212 0     0 1   my ($self, $buffref, $eof) = @_;
213 0           $self->debug_printf("Body read: $self, $buffref, $eof: [%s]", $$buffref);
214 0 0         if(defined $self->{chunk_remaining}) {
215 0           my $data = substr $$buffref, 0, $self->{chunk_remaining}, '';
216 0           $self->{chunk_remaining} -= length $data;
217 0           $self->debug_printf("Had %d bytes, %d left in chunk", length($data), $self->{chunk_remaining});
218 0           $self->{input_handler}->($data);
219 0 0         return 0 if $self->{chunk_remaining};
220 0           $self->debug_printf("Look for next chunk");
221 0           delete $self->{chunk_remaining};
222 0           return 1;
223             } else {
224 0 0         return 0 if -1 == (my $size_len = index($$buffref, "\x0D\x0A"));
225 0           $self->{chunk_remaining} = hex substr $$buffref, 0, $size_len, '';
226 0           substr $$buffref, 0, 2, '';
227 0           $self->debug_printf("Have %d bytes in this chunk", $self->{chunk_remaining});
228 0 0         return 1 if $self->{chunk_remaining};
229 0           $self->debug_printf("End of chunked data, looking for trailing headers");
230 0           return $self->can('on_trailing_header');
231             }
232             }
233              
234             =head2 on_trailing_header
235              
236             Deal with trailing headers. Not yet implemented.
237              
238             =cut
239              
240             sub on_trailing_header {
241 0     0 1   my ($self, $buffref, $eof) = @_;
242             # FIXME not yet implemented
243 0           $$buffref = '';
244 0           return $self->finish_request;
245             }
246              
247             =head2 read_to_length
248              
249             Read up to the expected fixed length of data.
250              
251             =cut
252              
253             sub read_to_length {
254 0     0 1   my ($self, $buffref, $eof) = @_;
255 0           $self->{remaining} -= length $$buffref;
256 0           $self->debug_printf("Body read: $self, $buffref, $eof: %s with %d remaining", $$buffref, $self->{remaining});
257 0           $self->{input_handler}->($$buffref);
258 0           $$buffref = '';
259 0 0         return $self->finish_request unless $self->{remaining};
260 0           return 0;
261             }
262              
263             =head2 request_body
264              
265             Accessor for the request body, available to the L callback.
266              
267             =cut
268              
269 0     0 1   sub request_body { shift->{request_body} }
270              
271             sub content_handler_raw {
272 0     0 0   my ($self, $data) = @_;
273 0 0         if(defined $data) {
274 0           $self->{data} .= $data;
275             } else {
276 0           return $self->{data}
277             }
278             }
279              
280             =head2 content_handler_json
281              
282             Handle JSON content.
283              
284             =cut
285              
286             sub content_handler_json {
287 0     0 1   my ($self, $data) = @_;
288 0 0         if(defined $data) {
289             eval {
290 0           $self->json->incr_parse($data);
291 0           1
292 0 0         } or do {
293 0           $self->debug_printf("Invalid JSON received: %s", $@);
294             };
295             } else {
296             return eval {
297 0           $self->json->incr_parse
298 0   0       } // do {
299 0           $self->debug_printf("Invalid JSON from incr_parse: %s", $@);
300             }
301             }
302             }
303              
304             my %status = (
305             100 => 'Continue',
306             101 => 'Switching protocols',
307             102 => 'Processing',
308             200 => 'OK',
309             201 => 'Created',
310             202 => 'Accepted',
311             203 => 'Non-authoritative information',
312             204 => 'No content',
313             205 => 'Reset content',
314             206 => 'Partial content',
315             207 => 'Multi-status',
316             208 => 'Already reported',
317             226 => 'IM used',
318             300 => 'Multiple choices',
319             301 => 'Moved permanently',
320             302 => 'Found',
321             303 => 'See other',
322             304 => 'Not modified',
323             305 => 'Use proxy',
324             307 => 'Temporary redirect',
325             308 => 'Permanent redirect',
326             400 => 'Bad request',
327             401 => 'Unauthorised',
328             402 => 'Payment required',
329             403 => 'Forbidden',
330             404 => 'Not found',
331             405 => 'Method not allowed',
332             500 => 'Internal server error',
333             );
334              
335             sub write_response {
336 0     0 0   my ($self, $code, $hdr, $body) = @_;
337 0 0         my $type = ref($body) ? 'text/javascript' : 'text/plain';
338 0 0         my $content = ref($body) ? encode_json($body) : encode(
339             'UTF-8' => $body
340             );
341 0   0       $hdr ||= [];
342 0           if(USE_HTTP_RESPONSE) {
343             return $self->write(
344             'HTTP/1.1 ' . HTTP::Response->new(
345             $code => ($status{$code} // 'Unknown'), [
346             'Content-Type' => $type,
347             'Content-Length' => length $content,
348             @$hdr
349             ],
350             $content
351             )->as_string("\x0D\x0A")
352             )
353             } else {
354             return $self->write(
355             join "\015\012", (
356             'HTTP/1.1 ' . $code . ' ' . ($status{$code} // 'Unknown'),
357             'Content-Type: ' . $type,
358             'Content-Length: ' . length($content),
359 0   0 0     (bundle_by { join ': ', @_ } 2, @$hdr),
  0            
360             '',
361             $content
362             )
363             )
364             }
365             }
366              
367             1;
368              
369             __END__