File Coverage

blib/lib/AnyEvent/HTTPD.pm

Criterion	Covered	Total	%
statement	55	62	88.7
branch	10	16	62.5
condition	2	5	40.0
subroutine	10	13	76.9
pod	4	5	80.0
total	81	101	80.2

line	stmt	bran	cond	sub	pod	time	code
1							package AnyEvent::HTTPD;
2	12			12		1139076	use common::sense;
	12					38
	12					96
3	12			12		770	use Scalar::Util qw/weaken/;
	12					22
	12					678
4	12			12		14373	use URI;
	12					134403
	12					407
5	12			12		8744	use AnyEvent::HTTPD::Request;
	12					40
	12					410
6	12			12		10816	use AnyEvent::HTTPD::Util;
	12					44
	12					1062
7
8	12			12		73	use base qw/AnyEvent::HTTPD::HTTPServer/;
	12					21
	12					9312
9
10							=head1 NAME
11
12							AnyEvent::HTTPD - A simple lightweight event based web (application) server
13
14							=head1 VERSION
15
16							Version 0.93
17
18							=cut
19
20							our $VERSION = '0.93';
21
22							=head1 SYNOPSIS
23
24							use AnyEvent::HTTPD;
25
26							my $httpd = AnyEvent::HTTPD->new (port => 9090);
27
28							$httpd->reg_cb (
29							'/' => sub {
30							my ($httpd, $req) = @_;
31
32							$req->respond ({ content => ['text/html',
33							"<html><body><h1>Hello World!</h1>"
34							. "<a href=\"/test\">another test page</a>"
35							. "</body></html>"
36							]});
37							},
38							'/test' => sub {
39							my ($httpd, $req) = @_;
40
41							$req->respond ({ content => ['text/html',
42							"<html><body><h1>Test page</h1>"
43							. "<a href=\"/\">Back to the main page</a>"
44							. "</body></html>"
45							]});
46							},
47							);
48
49							$httpd->run; # making a AnyEvent condition variable would also work
50
51							=head1 DESCRIPTION
52
53							This module provides a simple HTTPD for serving simple web application
54							interfaces. It's completly event based and independend from any event loop
55							by using the L<AnyEvent> module.
56
57							It's HTTP implementation is a bit hacky, so before using this module make sure
58							it works for you and the expected deployment. Feel free to improve the HTTP
59							support and send in patches!
60
61							The documentation is currently only the source code, but next versions of this
62							module will be better documented hopefully. See also the C<samples/> directory
63							in the L<AnyEvent::HTTPD> distribution for basic starting points.
64
65							=head1 FEATURES
66
67							=over 4
68
69							=item * support for GET and POST requests.
70
71							=item * support for HTTP 1.0 keep-alive.
72
73							=item * processing of C<x-www-form-urlencoded> and C<multipart/form-data> (C<multipart/mixed>) encoded form parameters.
74
75							=item * support for streaming responses.
76
77							=item * with version 0.8 no more dependend on L<LWP> for L<HTTP::Date>.
78
79							=item * (limited) support for SSL
80
81							=back
82
83							=head1 METHODS
84
85							The L<AnyEvent::HTTPD> class inherits directly from
86							L<AnyEvent::HTTPD::HTTPServer> which inherits the event callback interface from
87							L<Object::Event>.
88
89							Event callbacks can be registered via the L<Object::Event> API (see the
90							documentation of L<Object::Event> for details).
91
92							For a list of available events see below in the I<EVENTS> section.
93
94							=over 4
95
96							=item B<new (%args)>
97
98							This is the constructor for a L<AnyEvent::HTTPD> object.
99							The C<%args> hash may contain one of these key/value pairs:
100
101							=over 4
102
103							=item host => $host
104
105							The TCP address of the HTTP server will listen on. Usually 0.0.0.0 (the
106							default), for a public server, or 127.0.0.1 for a local server.
107
108							=item port => $port
109
110							The TCP port the HTTP server will listen on. If undefined some
111							free port will be used. You can get it via the C<port> method.
112
113							=item ssl => $tls_ctx
114
115							If this option is given the server will listen for a SSL/TLS connection on the
116							configured port. As C<$tls_ctx> you can pass anything that you can pass as
117							C<tls_ctx> to an L<AnyEvent::Handle> object.
118
119							Example:
120
121							my $httpd =
122							AnyEvent::HTTPD->new (
123							port => 443,
124							ssl => { cert_file => "/path/to/my/server_cert_and_key.pem" }
125							);
126
127							Or:
128
129							my $httpd =
130							AnyEvent::HTTPD->new (
131							port => 443,
132							ssl => AnyEvent::TLS->new (...),
133							);
134
135							=item request_timeout => $seconds
136
137							This will set the request timeout for connections.
138							The default value is 60 seconds.
139
140							=item backlog => $int
141
142							The backlog argument defines the maximum length the queue of pending
143							connections may grow to. The real maximum queue length will be 1.5 times more
144							than the value specified in the backlog argument.
145
146							See also C<man 2 listen>.
147
148							By default will be set by L<AnyEvent::Socket>C<::tcp_server> to C<128>.
149
150							=item connection_class => $class
151
152							This is a special parameter that you can use to pass your own connection class
153							to L<AnyEvent::HTTPD::HTTPServer>. This is only of interest to you if you plan
154							to subclass L<AnyEvent::HTTPD::HTTPConnection>.
155
156							=item request_class => $class
157
158							This is a special parameter that you can use to pass your own request class
159							to L<AnyEvent::HTTPD>. This is only of interest to you if you plan
160							to subclass L<AnyEvent::HTTPD::Request>.
161
162							=item allowed_methods => $arrayref
163
164							This parameter sets the allowed HTTP methods for requests, defaulting to GET,
165							HEAD and POST. Each request received is matched against this list, and a
166							'501 not implemented' is returned if no match is found. Requests using
167							disallowed handlers will never trigger callbacks.
168
169							=back
170
171							=cut
172
173							sub new {
174	11			11	1	2285	my $this = shift;
175	11		33			90	my $class = ref($this) \|\| $this;
176	11					151	my $self = $class->SUPER::new (
177							request_class => "AnyEvent::HTTPD::Request",
178							@_
179							);
180
181							$self->reg_cb (
182							connect => sub {
183	15			15		314	my ($self, $con) = @_;
184
185	15					47	weaken $self;
186
187							$self->{conns}->{$con} = $con->reg_cb (
188							request => sub {
189	18					343	my ($con, $meth, $url, $hdr, $cont) = @_;
190							#d# warn "REQUEST: $meth, $url, [$cont] " . join (',', %$hdr) . "\n";
191
192	18					155	$url = URI->new ($url);
193
194	18	100				104730	if ($meth eq 'GET') {
195	12					127	$cont = parse_urlencoded ($url->query);
196							}
197
198	18	50				131	if ( scalar grep { $meth eq $_ } @{ $self->{allowed_methods} } ) {
	54					167
	18					78
199
200	18					82	weaken $con;
201
202							$self->handle_app_req (
203							$meth, $url, $hdr, $cont, $con->{host}, $con->{port},
204							sub {
205	18	50				146	$con->response (@_) if $con;
206	18					226	});
207							} else {
208	0					0	$con->response (200, "ok");
209							}
210							}
211	15					324	);
212
213	15					1169	$self->event (client_connected => $con->{host}, $con->{port});
214							},
215							disconnect => sub {
216	12			12		211	my ($self, $con) = @_;
217	12					207	$con->unreg_cb (delete $self->{conns}->{$con});
218	12					721	$self->event (client_disconnected => $con->{host}, $con->{port});
219							},
220	11					198	);
221
222	11		50			1923	$self->{state} \|\|= {};
223
224	11					42	return $self
225							}
226
227							sub handle_app_req {
228	18			18	0	129	my ($self, $meth, $url, $hdr, $cont, $host, $port, $respcb) = @_;
229
230	18	100				326	my $req =
		100
231							$self->{request_class}->new (
232							httpd => $self,
233							method => $meth,
234							url => $url,
235							hdr => $hdr,
236							parm => (ref $cont ? $cont : {}),
237							content => (ref $cont ? undef : $cont),
238							resp => $respcb,
239							host => $host,
240							port => $port,
241							);
242
243	18					54	$self->{req_stop} = 0;
244	18					103	$self->event (request => $req);
245	18	50				315	return if $self->{req_stop};
246
247	18					31	my @evs;
248	18					49	my $cururl = '';
249	18					110	for my $seg ($url->path_segments) {
250	36					903	$cururl .= $seg;
251	36					62	push @evs, $cururl;
252	36					74	$cururl .= '/';
253							}
254
255	18					50	for my $ev (reverse @evs) {
256	36					122	$self->event ($ev => $req);
257	36	50				1162	last if $self->{req_stop};
258							}
259							}
260
261							=item B<port>
262
263							Returns the port number this server is bound to.
264
265							=item B<host>
266
267							Returns the host/ip this server is bound to.
268
269							=item B<allowed_methods>
270
271							Returns an arrayref of allowed HTTP methods, possibly as set by the
272							allowed_methods argument to the constructor.
273
274							=item B<stop_request>
275
276							When the server walks the request URI path upwards you can stop
277							the walk by calling this method. You can even stop further handling
278							after the C<request> event.
279
280							Example:
281
282							$httpd->reg_cb (
283							'/test' => sub {
284							my ($httpd, $req) = @_;
285
286							# ...
287
288							$httpd->stop_request; # will prevent that the callback below is called
289							},
290							'' => sub { # this one wont be called by a request to '/test'
291							my ($httpd, $req) = @_;
292
293							# ...
294							}
295							);
296
297							=cut
298
299							sub stop_request {
300	0			0	1		my ($self) = @_;
301	0						$self->{req_stop} = 1;
302							}
303
304							=item B<run>
305
306							This method is a simplification of the C<AnyEvent> condition variable
307							idiom. You can use it instead of writing:
308
309							my $cvar = AnyEvent->condvar;
310							$cvar->wait;
311
312							=cut
313
314							sub run {
315	0			0	1		my ($self) = @_;
316	0						$self->{condvar} = AnyEvent->condvar;
317	0						$self->{condvar}->wait;
318							}
319
320							=item B<stop>
321
322							This will stop the HTTP server and return from the
323							C<run> method B<if you started the server via that method!>
324
325							=cut
326
327	0	0		0	1		sub stop { $_[0]->{condvar}->broadcast if $_[0]->{condvar} }
328
329							=back
330
331							=head1 EVENTS
332
333							Every request goes to a specific URL. After a (GET or POST) request is
334							received the URL's path segments are walked down and for each segment
335							a event is generated. An example:
336
337							If the URL '/test/bla.jpg' is requestes following events will be generated:
338
339							'/test/bla.jpg' - the event for the last segment
340							'/test' - the event for the 'test' segment
341							'' - the root event of each request
342
343							To actually handle any request you just have to register a callback for the event
344							name with the empty string. To handle all requests in the '/test' directory
345							you have to register a callback for the event with the name C<'/test'>.
346							Here is an example how to register an event for the example URL above:
347
348							$httpd->reg_cb (
349							'/test/bla.jpg' => sub {
350							my ($httpd, $req) = @_;
351
352							$req->respond ([200, 'ok', { 'Content-Type' => 'text/html' }, '<h1>Test</h1>' }]);
353							}
354							);
355
356							See also C<stop_request> about stopping the walk of the path segments.
357
358							The first argument to such a callback is always the L<AnyEvent::HTTPD> object
359							itself. The second argument (C<$req>) is the L<AnyEvent::HTTPD::Request>
360							object for this request. It can be used to get the (possible) form parameters
361							for this request or the transmitted content and respond to the request.
362
363
364							Along with the above mentioned events these events are also provided:
365
366							=over 4
367
368							=item request => $req
369
370							Every request also emits the C<request> event, with the same arguments and
371							semantics as the above mentioned path request events. You can use this to
372							implement your own request multiplexing. You can use C<stop_request> to stop
373							any further processing of the request as the C<request> event is the first
374							thing that is executed for an incoming request.
375
376							An example of one of many possible uses:
377
378							$httpd->reg_cb (
379							request => sub {
380							my ($httpd, $req) = @_;
381
382							my $url = $req->url;
383
384							if ($url->path =~ /\/images\/img_(\d+).jpg$/) {
385							handle_image_request ($req, $1); # your task :)
386
387							# stop the request from emitting further events
388							# so that the '/images/img_001.jpg' and the
389							# '/images' and '' events are NOT emitted:
390							$httpd->stop_request;
391							}
392							}
393							);
394
395							=item client_connected => $host, $port
396
397							=item client_disconnected => $host, $port
398
399							These events are emitted whenever a client coming from C<$host:$port> connects
400							to your server or is disconnected from it.
401
402							=back
403
404							=head1 CACHING
405
406							Any response from the HTTP server will have C<Cache-Control> set to C<max-age=0> and
407							also the C<Expires> header set to the C<Date> header. Meaning: Caching is disabled.
408
409							You can of course set those headers yourself in the response, or remove them by
410							setting them to undef, but keep in mind that the default for those headers are
411							like mentioned above.
412
413							If you need more support here you can send me a mail or even better: a patch :)
414
415							=head1 AUTHOR
416
417							Robin Redeker, C<< <elmex at ta-sa.org> >>
418
419							=head1 BUGS
420
421							Please report any bugs or feature requests to C<bug-bs-httpd at rt.cpan.org>,
422							or through the web interface at
423							L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-HTTPD>. I will be
424							notified, and then you'll automatically be notified of progress on your bug as
425							I make changes.
426
427							=head1 SUPPORT
428
429							You can find documentation for this module with the perldoc command.
430
431							perldoc AnyEvent::HTTPD
432
433
434							You can also look for information at:
435
436							=over 4
437
438							=item * Git repository
439
440							L<http://git.ta-sa.org/AnyEvent-HTTPD.git>
441
442							=item * RT: CPAN's request tracker
443
444							L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-HTTPD>
445
446							=item * AnnoCPAN: Annotated CPAN documentation
447
448							L<http://annocpan.org/dist/AnyEvent-HTTPD>
449
450							=item * CPAN Ratings
451
452							L<http://cpanratings.perl.org/d/AnyEvent-HTTPD>
453
454							=item * Search CPAN
455
456							L<http://search.cpan.org/dist/AnyEvent-HTTPD>
457
458							=back
459
460							=head1 ACKNOWLEDGEMENTS
461
462							Andrey Smirnov - for keep-alive patches.
463							Pedro Melo - for valuable input in general and patches.
464							Nicholas Harteau - patch for ';' pair separator support,
465							patch for allowed_methods support
466							Chris Kastorff - patch for making default headers removable
467							and more fault tolerant w.r.t. case.
468							Mons Anderson - Optimizing the regexes in L<AnyEvent::HTTPD::HTTPConnection>
469							and adding the C<backlog> option to L<AnyEvent::HTTPD>.
470
471							=head1 COPYRIGHT & LICENSE
472
473							Copyright 2008-2011 Robin Redeker, all rights reserved.
474
475							This program is free software; you can redistribute it and/or modify it
476							under the same terms as Perl itself.
477
478
479							=cut
480
481							1; # End of AnyEvent::HTTPD