Commit | Line | Data |
3fea05b9 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | package HTTP::Server::Simple; |
5 | use FileHandle; |
6 | use Socket; |
7 | use Carp; |
8 | use URI::Escape; |
9 | |
10 | use vars qw($VERSION $bad_request_doc); |
11 | $VERSION = '0.41'; |
12 | |
13 | =head1 NAME |
14 | |
15 | HTTP::Server::Simple - Lightweight HTTP server |
16 | |
17 | =head1 SYNOPSIS |
18 | |
19 | use warnings; |
20 | use strict; |
21 | |
22 | use HTTP::Server::Simple; |
23 | |
24 | my $server = HTTP::Server::Simple->new(); |
25 | $server->run(); |
26 | |
27 | However, normally you will sub-class the HTTP::Server::Simple::CGI |
28 | module (see L<HTTP::Server::Simple::CGI>); |
29 | |
30 | package Your::Web::Server; |
31 | use base qw(HTTP::Server::Simple::CGI); |
32 | |
33 | sub handle_request { |
34 | my ($self, $cgi) = @_; |
35 | |
36 | #... do something, print output to default |
37 | # selected filehandle... |
38 | |
39 | } |
40 | |
41 | 1; |
42 | |
43 | =head1 DESCRIPTION |
44 | |
45 | This is a simple standalone HTTP server. By default, it doesn't thread |
46 | or fork. It does, however, act as a simple frontend which can be used |
47 | to build a standalone web-based application or turn a CGI into one. |
48 | |
49 | It is possible to use L<Net::Server> classes to create forking, |
50 | pre-forking, and other types of more complicated servers; see |
51 | L</net_server>. |
52 | |
53 | By default, the server traps a few signals: |
54 | |
55 | =over |
56 | |
57 | =item HUP |
58 | |
59 | When you C<kill -HUP> the server, it lets the current request finish being |
60 | processed, then uses the C<restart> method to re-exec itself. Please note that |
61 | in order to provide restart-on-SIGHUP, HTTP::Server::Simple sets a SIGHUP |
62 | handler during initialisation. If your request handling code forks you need to |
63 | make sure you reset this or unexpected things will happen if somebody sends a |
64 | HUP to all running processes spawned by your app (e.g. by "kill -HUP <script>") |
65 | |
66 | =item PIPE |
67 | |
68 | If the server detects a broken pipe while writing output to the client, |
69 | it ignores the signal. Otherwise, a client closing the connection early |
70 | could kill the server. |
71 | |
72 | =back |
73 | |
74 | =head1 EXAMPLE |
75 | |
76 | #!/usr/bin/perl |
77 | { |
78 | package MyWebServer; |
79 | |
80 | use HTTP::Server::Simple::CGI; |
81 | use base qw(HTTP::Server::Simple::CGI); |
82 | |
83 | my %dispatch = ( |
84 | '/hello' => \&resp_hello, |
85 | # ... |
86 | ); |
87 | |
88 | sub handle_request { |
89 | my $self = shift; |
90 | my $cgi = shift; |
91 | |
92 | my $path = $cgi->path_info(); |
93 | my $handler = $dispatch{$path}; |
94 | |
95 | if (ref($handler) eq "CODE") { |
96 | print "HTTP/1.0 200 OK\r\n"; |
97 | $handler->($cgi); |
98 | |
99 | } else { |
100 | print "HTTP/1.0 404 Not found\r\n"; |
101 | print $cgi->header, |
102 | $cgi->start_html('Not found'), |
103 | $cgi->h1('Not found'), |
104 | $cgi->end_html; |
105 | } |
106 | } |
107 | |
108 | sub resp_hello { |
109 | my $cgi = shift; # CGI.pm object |
110 | return if !ref $cgi; |
111 | |
112 | my $who = $cgi->param('name'); |
113 | |
114 | print $cgi->header, |
115 | $cgi->start_html("Hello"), |
116 | $cgi->h1("Hello $who!"), |
117 | $cgi->end_html; |
118 | } |
119 | |
120 | } |
121 | |
122 | # start the server on port 8080 |
123 | my $pid = MyWebServer->new(8080)->background(); |
124 | print "Use 'kill $pid' to stop server.\n"; |
125 | |
126 | =head1 METHODS |
127 | |
128 | =head2 HTTP::Server::Simple->new($port) |
129 | |
130 | API call to start a new server. Does not actually start listening |
131 | until you call C<-E<gt>run()>. If omitted, C<$port> defaults to 8080. |
132 | |
133 | =cut |
134 | |
135 | sub new { |
136 | my ( $proto, $port ) = @_; |
137 | my $class = ref($proto) || $proto; |
138 | |
139 | if ( $class eq __PACKAGE__ ) { |
140 | require HTTP::Server::Simple::CGI; |
141 | return HTTP::Server::Simple::CGI->new( @_[ 1 .. $#_ ] ); |
142 | } |
143 | |
144 | my $self = {}; |
145 | bless( $self, $class ); |
146 | $self->port( $port || '8080' ); |
147 | |
148 | return $self; |
149 | } |
150 | |
151 | |
152 | =head2 lookup_localhost |
153 | |
154 | Looks up the local host's IP address, and returns it. For most hosts, |
155 | this is C<127.0.0.1>. |
156 | |
157 | =cut |
158 | |
159 | sub lookup_localhost { |
160 | my $self = shift; |
161 | |
162 | my $local_sockaddr = getsockname( $self->stdio_handle ); |
163 | my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr); |
164 | $self->host( gethostbyaddr( $localiaddr, AF_INET ) || "localhost"); |
165 | $self->{'local_addr'} = inet_ntoa($localiaddr) || "127.0.0.1"; |
166 | } |
167 | |
168 | |
169 | =head2 port [NUMBER] |
170 | |
171 | Takes an optional port number for this server to listen on. |
172 | |
173 | Returns this server's port. (Defaults to 8080) |
174 | |
175 | =cut |
176 | |
177 | sub port { |
178 | my $self = shift; |
179 | $self->{'port'} = shift if (@_); |
180 | return ( $self->{'port'} ); |
181 | |
182 | } |
183 | |
184 | =head2 host [address] |
185 | |
186 | Takes an optional host address for this server to bind to. |
187 | |
188 | Returns this server's bound address (if any). Defaults to C<undef> |
189 | (bind to all interfaces). |
190 | |
191 | =cut |
192 | |
193 | sub host { |
194 | my $self = shift; |
195 | $self->{'host'} = shift if (@_); |
196 | return ( $self->{'host'} ); |
197 | |
198 | } |
199 | |
200 | =head2 background [ARGUMENTS] |
201 | |
202 | Runs the server in the background, and returns the process ID of the |
203 | started process. Any arguments will be passed through to L</run>. |
204 | |
205 | =cut |
206 | |
207 | sub background { |
208 | my $self = shift; |
209 | my $child = fork; |
210 | croak "Can't fork: $!" unless defined($child); |
211 | return $child if $child; |
212 | |
213 | srand(); # after a fork, we need to reset the random seed |
214 | # or we'll get the same numbers in both branches |
215 | if ( $^O !~ /MSWin32/ ) { |
216 | require POSIX; |
217 | POSIX::setsid() |
218 | or croak "Can't start a new session: $!"; |
219 | } |
220 | $self->run(@_); # should never return |
221 | exit; # just to be sure |
222 | } |
223 | |
224 | =head2 run [ARGUMENTS] |
225 | |
226 | Run the server. If all goes well, this won't ever return, but it will |
227 | start listening for C<HTTP> requests. Any arguments passed to this |
228 | will be passed on to the underlying L<Net::Server> implementation, if |
229 | one is used (see L</net_server>). |
230 | |
231 | =cut |
232 | |
233 | my $server_class_id = 0; |
234 | |
235 | use vars '$SERVER_SHOULD_RUN'; |
236 | $SERVER_SHOULD_RUN = 1; |
237 | |
238 | sub run { |
239 | my $self = shift; |
240 | my $server = $self->net_server; |
241 | |
242 | local $SIG{CHLD} = 'IGNORE'; # reap child processes |
243 | |
244 | # $pkg is generated anew for each invocation to "run" |
245 | # Just so we can use different net_server() implementations |
246 | # in different runs. |
247 | my $pkg = join '::', ref($self), "NetServer" . $server_class_id++; |
248 | |
249 | no strict 'refs'; |
250 | *{"$pkg\::process_request"} = $self->_process_request; |
251 | |
252 | if ($server) { |
253 | require join( '/', split /::/, $server ) . '.pm'; |
254 | *{"$pkg\::ISA"} = [$server]; |
255 | |
256 | # clear the environment before every request |
257 | require HTTP::Server::Simple::CGI; |
258 | *{"$pkg\::post_accept"} = sub { |
259 | HTTP::Server::Simple::CGI::Environment->setup_environment; |
260 | # $self->SUPER::post_accept uses the wrong super package |
261 | $server->can('post_accept')->(@_); |
262 | }; |
263 | } |
264 | else { |
265 | $self->setup_listener; |
266 | $self->after_setup_listener(); |
267 | *{"$pkg\::run"} = $self->_default_run; |
268 | } |
269 | |
270 | local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; }; |
271 | |
272 | $pkg->run( port => $self->port, @_ ); |
273 | } |
274 | |
275 | =head2 net_server |
276 | |
277 | User-overridable method. If you set it to a L<Net::Server> subclass, |
278 | that subclass is used for the C<run> method. Otherwise, a minimal |
279 | implementation is used as default. |
280 | |
281 | =cut |
282 | |
283 | sub net_server {undef} |
284 | |
285 | sub _default_run { |
286 | my $self = shift; |
287 | |
288 | # Default "run" closure method for a stub, minimal Net::Server instance. |
289 | return sub { |
290 | my $pkg = shift; |
291 | |
292 | $self->print_banner; |
293 | |
294 | while ($SERVER_SHOULD_RUN) { |
295 | local $SIG{PIPE} = 'IGNORE'; # If we don't ignore SIGPIPE, a |
296 | # client closing the connection before we |
297 | # finish sending will cause the server to exit |
298 | while ( accept( my $remote = new FileHandle, HTTPDaemon ) ) { |
299 | $self->stdio_handle($remote); |
300 | $self->lookup_localhost() unless ($self->host); |
301 | $self->accept_hook if $self->can("accept_hook"); |
302 | |
303 | |
304 | *STDIN = $self->stdin_handle(); |
305 | *STDOUT = $self->stdout_handle(); |
306 | select STDOUT; # required for HTTP::Server::Simple::Recorder |
307 | # XXX TODO glasser: why? |
308 | $pkg->process_request; |
309 | close $remote; |
310 | } |
311 | } |
312 | |
313 | # Got here? Time to restart, due to SIGHUP |
314 | $self->restart; |
315 | }; |
316 | } |
317 | |
318 | =head2 restart |
319 | |
320 | Restarts the server. Usually called by a HUP signal, not directly. |
321 | |
322 | =cut |
323 | |
324 | sub restart { |
325 | my $self = shift; |
326 | |
327 | close HTTPDaemon; |
328 | |
329 | $SIG{CHLD} = 'DEFAULT'; |
330 | wait; |
331 | |
332 | ### if the standalone server was invoked with perl -I .. we will loose |
333 | ### those include dirs upon re-exec. So add them to PERL5LIB, so they |
334 | ### are available again for the exec'ed process --kane |
335 | use Config; |
336 | $ENV{PERL5LIB} .= join $Config{path_sep}, @INC; |
337 | |
338 | # Server simple |
339 | # do the exec. if $0 is not executable, try running it with $^X. |
340 | exec {$0}( ( ( -x $0 ) ? () : ($^X) ), $0, @ARGV ); |
341 | } |
342 | |
343 | |
344 | sub _process_request { |
345 | my $self = shift; |
346 | |
347 | # Create a callback closure that is invoked for each incoming request; |
348 | # the $self above is bound into the closure. |
349 | sub { |
350 | |
351 | $self->stdio_handle(*STDIN) unless $self->stdio_handle; |
352 | |
353 | # Default to unencoded, raw data out. |
354 | # if you're sending utf8 and latin1 data mixed, you may need to override this |
355 | binmode STDIN, ':raw'; |
356 | binmode STDOUT, ':raw'; |
357 | |
358 | # The ternary operator below is to protect against a crash caused by IE |
359 | # Ported from Catalyst::Engine::HTTP (Originally by Jasper Krogh and Peter Edwards) |
360 | # ( http://dev.catalyst.perl.org/changeset/5195, 5221 ) |
361 | |
362 | my $remote_sockaddr = getpeername( $self->stdio_handle ); |
363 | my ( undef, $iaddr ) = $remote_sockaddr ? sockaddr_in($remote_sockaddr) : (undef,undef); |
364 | my $peeraddr = $iaddr ? ( inet_ntoa($iaddr) || "127.0.0.1" ) : '127.0.0.1'; |
365 | |
366 | my ( $method, $request_uri, $proto ) = $self->parse_request; |
367 | |
368 | unless ($self->valid_http_method($method) ) { |
369 | $self->bad_request; |
370 | return; |
371 | } |
372 | |
373 | $proto ||= "HTTP/0.9"; |
374 | |
375 | my ( $file, $query_string ) |
376 | = ( $request_uri =~ /([^?]*)(?:\?(.*))?/s ); # split at ? |
377 | |
378 | $self->setup( |
379 | method => $method, |
380 | protocol => $proto, |
381 | query_string => ( defined($query_string) ? $query_string : '' ), |
382 | request_uri => $request_uri, |
383 | path => $file, |
384 | localname => $self->host, |
385 | localport => $self->port, |
386 | peername => $peeraddr, |
387 | peeraddr => $peeraddr, |
388 | ); |
389 | |
390 | # HTTP/0.9 didn't have any headers (I think) |
391 | if ( $proto =~ m{HTTP/(\d(\.\d)?)$} and $1 >= 1 ) { |
392 | |
393 | my $headers = $self->parse_headers |
394 | or do { $self->bad_request; return }; |
395 | |
396 | $self->headers($headers); |
397 | |
398 | } |
399 | |
400 | $self->post_setup_hook if $self->can("post_setup_hook"); |
401 | |
402 | $self->handler; |
403 | } |
404 | } |
405 | |
406 | =head2 stdio_handle [FILEHANDLE] |
407 | |
408 | When called with an argument, sets the socket to the server to that arg. |
409 | |
410 | Returns the socket to the server; you should only use this for actual socket-related |
411 | calls like C<getsockname>. If all you want is to read or write to the socket, |
412 | you should use C<stdin_handle> and C<stdout_handle> to get the in and out filehandles |
413 | explicitly. |
414 | |
415 | =cut |
416 | |
417 | sub stdio_handle { |
418 | my $self = shift; |
419 | $self->{'_stdio_handle'} = shift if (@_); |
420 | return $self->{'_stdio_handle'}; |
421 | } |
422 | |
423 | =head2 stdin_handle |
424 | |
425 | Returns a filehandle used for input from the client. By default, |
426 | returns whatever was set with C<stdio_handle>, but a subclass could do |
427 | something interesting here. |
428 | |
429 | =cut |
430 | |
431 | sub stdin_handle { |
432 | my $self = shift; |
433 | return $self->stdio_handle; |
434 | } |
435 | |
436 | =head2 stdout_handle |
437 | |
438 | Returns a filehandle used for output to the client. By default, |
439 | returns whatever was set with C<stdio_handle>, but a subclass |
440 | could do something interesting here. |
441 | |
442 | =cut |
443 | |
444 | sub stdout_handle { |
445 | my $self = shift; |
446 | return $self->stdio_handle; |
447 | } |
448 | |
449 | =head1 IMPORTANT SUB-CLASS METHODS |
450 | |
451 | A selection of these methods should be provided by sub-classes of this |
452 | module. |
453 | |
454 | =head2 handler |
455 | |
456 | This method is called after setup, with no parameters. It should |
457 | print a valid, I<full> HTTP response to the default selected |
458 | filehandle. |
459 | |
460 | =cut |
461 | |
462 | sub handler { |
463 | my ($self) = @_; |
464 | if ( ref($self) ne __PACKAGE__ ) { |
465 | croak "do not call " . ref($self) . "::SUPER->handler"; |
466 | } |
467 | else { |
468 | croak "handler called out of context"; |
469 | } |
470 | } |
471 | |
472 | =head2 setup(name =E<gt> $value, ...) |
473 | |
474 | This method is called with a name =E<gt> value list of various things |
475 | to do with the request. This list is given below. |
476 | |
477 | The default setup handler simply tries to call methods with the names |
478 | of keys of this list. |
479 | |
480 | ITEM/METHOD Set to Example |
481 | ----------- ------------------ ------------------------ |
482 | method Request Method "GET", "POST", "HEAD" |
483 | protocol HTTP version "HTTP/1.1" |
484 | request_uri Complete Request URI "/foobar/baz?foo=bar" |
485 | path Path part of URI "/foobar/baz" |
486 | query_string Query String undef, "foo=bar" |
487 | port Received Port 80, 8080 |
488 | peername Remote name "200.2.4.5", "foo.com" |
489 | peeraddr Remote address "200.2.4.5", "::1" |
490 | localname Local interface "localhost", "myhost.com" |
491 | |
492 | =cut |
493 | |
494 | sub setup { |
495 | my $self = shift; |
496 | while ( my ( $item, $value ) = splice @_, 0, 2 ) { |
497 | $self->$item($value) if $self->can($item); |
498 | } |
499 | } |
500 | |
501 | =head2 headers([Header =E<gt> $value, ...]) |
502 | |
503 | Receives HTTP headers and does something useful with them. This is |
504 | called by the default C<setup()> method. |
505 | |
506 | You have lots of options when it comes to how you receive headers. |
507 | |
508 | You can, if you really want, define C<parse_headers()> and parse them |
509 | raw yourself. |
510 | |
511 | Secondly, you can intercept them very slightly cooked via the |
512 | C<setup()> method, above. |
513 | |
514 | Thirdly, you can leave the C<setup()> header as-is (or calling the |
515 | superclass C<setup()> for unknown request items). Then you can define |
516 | C<headers()> in your sub-class and receive them all at once. |
517 | |
518 | Finally, you can define handlers to receive individual HTTP headers. |
519 | This can be useful for very simple SOAP servers (to name a |
520 | crack-fueled standard that defines its own special HTTP headers). |
521 | |
522 | To do so, you'll want to define the C<header()> method in your subclass. |
523 | That method will be handed a (key,value) pair of the header name and the value. |
524 | |
525 | |
526 | =cut |
527 | |
528 | sub headers { |
529 | my $self = shift; |
530 | my $headers = shift; |
531 | |
532 | my $can_header = $self->can("header"); |
533 | return unless $can_header; |
534 | while ( my ( $header, $value ) = splice @$headers, 0, 2 ) { |
535 | $self->header( $header => $value ); |
536 | } |
537 | } |
538 | |
539 | =head2 accept_hook |
540 | |
541 | If defined by a sub-class, this method is called directly after an |
542 | accept happens. An accept_hook to add SSL support might look like this: |
543 | |
544 | sub accept_hook { |
545 | my $self = shift; |
546 | my $fh = $self->stdio_handle; |
547 | |
548 | $self->SUPER::accept_hook(@_); |
549 | |
550 | my $newfh = |
551 | IO::Socket::SSL->start_SSL( $fh, |
552 | SSL_server => 1, |
553 | SSL_use_cert => 1, |
554 | SSL_cert_file => 'myserver.crt', |
555 | SSL_key_file => 'myserver.key', |
556 | ) |
557 | or warn "problem setting up SSL socket: " . IO::Socket::SSL::errstr(); |
558 | |
559 | $self->stdio_handle($newfh) if $newfh; |
560 | } |
561 | |
562 | =head2 post_setup_hook |
563 | |
564 | If defined by a sub-class, this method is called after all setup has |
565 | finished, before the handler method. |
566 | |
567 | =head2 print_banner |
568 | |
569 | This routine prints a banner before the server request-handling loop |
570 | starts. |
571 | |
572 | Methods below this point are probably not terribly useful to define |
573 | yourself in subclasses. |
574 | |
575 | =cut |
576 | |
577 | sub print_banner { |
578 | my $self = shift; |
579 | |
580 | print( ref($self) |
581 | . ": You can connect to your server at " |
582 | . "http://localhost:" |
583 | . $self->port |
584 | . "/\n" ); |
585 | |
586 | } |
587 | |
588 | =head2 parse_request |
589 | |
590 | Parse the HTTP request line. Returns three values, the request |
591 | method, request URI and the protocol. |
592 | |
593 | =cut |
594 | |
595 | sub parse_request { |
596 | my $self = shift; |
597 | my $chunk; |
598 | while ( sysread( STDIN, my $buff, 1 ) ) { |
599 | last if $buff eq "\n"; |
600 | $chunk .= $buff; |
601 | } |
602 | defined($chunk) or return undef; |
603 | $_ = $chunk; |
604 | |
605 | m/^(\w+)\s+(\S+)(?:\s+(\S+))?\r?$/; |
606 | my $method = $1 || ''; |
607 | my $uri = $2 || ''; |
608 | my $protocol = $3 || ''; |
609 | |
610 | return ( $method, $uri, $protocol ); |
611 | } |
612 | |
613 | =head2 parse_headers |
614 | |
615 | Parses incoming HTTP headers from STDIN, and returns an arrayref of |
616 | C<(header =E<gt> value)> pairs. See L</headers> for possibilities on |
617 | how to inspect headers. |
618 | |
619 | =cut |
620 | |
621 | sub parse_headers { |
622 | my $self = shift; |
623 | |
624 | my @headers; |
625 | |
626 | my $chunk = ''; |
627 | while ( sysread( STDIN, my $buff, 1 ) ) { |
628 | if ( $buff eq "\n" ) { |
629 | $chunk =~ s/[\r\l\n\s]+$//; |
630 | if ( $chunk =~ /^([^()<>\@,;:\\"\/\[\]?={} \t]+):\s*(.*)/i ) { |
631 | push @headers, $1 => $2; |
632 | } |
633 | last if ( $chunk =~ /^$/ ); |
634 | $chunk = ''; |
635 | } |
636 | else { $chunk .= $buff } |
637 | } |
638 | |
639 | return ( \@headers ); |
640 | } |
641 | |
642 | =head2 setup_listener |
643 | |
644 | This routine binds the server to a port and interface. |
645 | |
646 | =cut |
647 | |
648 | sub setup_listener { |
649 | my $self = shift; |
650 | |
651 | my $tcp = getprotobyname('tcp'); |
652 | socket( HTTPDaemon, PF_INET, SOCK_STREAM, $tcp ) or croak "socket: $!"; |
653 | setsockopt( HTTPDaemon, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) ) |
654 | or warn "setsockopt: $!"; |
655 | bind( HTTPDaemon, |
656 | sockaddr_in( |
657 | $self->port(), |
658 | ( $self->host |
659 | ? inet_aton( $self->host ) |
660 | : INADDR_ANY |
661 | ) |
662 | ) |
663 | ) |
664 | or croak "bind to @{[$self->host||'*']}:@{[$self->port]}: $!"; |
665 | listen( HTTPDaemon, SOMAXCONN ) or croak "listen: $!"; |
666 | } |
667 | |
668 | |
669 | =head2 after_setup_listener |
670 | |
671 | This method is called immediately after setup_listener. It's here just |
672 | for you to override. |
673 | |
674 | =cut |
675 | |
676 | sub after_setup_listener { |
677 | } |
678 | |
679 | =head2 bad_request |
680 | |
681 | This method should print a valid HTTP response that says that the |
682 | request was invalid. |
683 | |
684 | =cut |
685 | |
686 | $bad_request_doc = join "", <DATA>; |
687 | |
688 | sub bad_request { |
689 | my $self = shift; |
690 | |
691 | print "HTTP/1.0 400 Bad request\r\n"; # probably OK by now |
692 | print "Content-Type: text/html\r\nContent-Length: ", |
693 | length($bad_request_doc), "\r\n\r\n", $bad_request_doc; |
694 | } |
695 | |
696 | =head2 valid_http_method($method) |
697 | |
698 | Given a candidate HTTP method in $method, determine if it is valid. |
699 | Override if, for example, you'd like to do some WebDAV. The default |
700 | implementation only accepts C<GET>, C<POST>, C<HEAD>, C<PUT>, and |
701 | C<DELETE>. |
702 | |
703 | =cut |
704 | |
705 | sub valid_http_method { |
706 | my $self = shift; |
707 | my $method = shift or return 0; |
708 | return $method =~ /^(?:GET|POST|HEAD|PUT|DELETE)$/; |
709 | } |
710 | |
711 | =head1 AUTHOR |
712 | |
713 | Copyright (c) 2004-2008 Jesse Vincent, <jesse@bestpractical.com>. |
714 | All rights reserved. |
715 | |
716 | Marcus Ramberg <drave@thefeed.no> contributed tests, cleanup, etc |
717 | |
718 | Sam Vilain, <samv@cpan.org> contributed the CGI.pm split-out and |
719 | header/setup API. |
720 | |
721 | Example section by almut on perlmonks, suggested by Mark Fuller. |
722 | |
723 | =head1 BUGS |
724 | |
725 | There certainly are some. Please report them via rt.cpan.org |
726 | |
727 | =head1 LICENSE |
728 | |
729 | This library is free software; you can redistribute it and/or modify |
730 | it under the same terms as Perl itself. |
731 | |
732 | =cut |
733 | |
734 | 1; |
735 | |
736 | __DATA__ |
737 | <html> |
738 | <head> |
739 | <title>Bad Request</title> |
740 | </head> |
741 | <body> |
742 | <h1>Bad Request</h1> |
743 | |
744 | <p>Your browser sent a request which this web server could not |
745 | grok.</p> |
746 | </body> |
747 | </html> |