Commit | Line | Data |
3cdea3c7 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use CGI; |
7 | use HTTP::Daemon; |
8 | use HTTP::Request; |
9 | use HTTP::Request::AsCGI; |
10 | use HTTP::Response; |
11 | |
f93fc77c |
12 | $SIG{'PIPE'} = 'IGNORE'; |
13 | |
14 | my $server = HTTP::Daemon->new( LocalPort => 3000, ReuseAddr => 1 ) || die; |
3cdea3c7 |
15 | |
16 | print "Please contact me at: <URL:", $server->url, ">\n"; |
17 | |
18 | while ( my $client = $server->accept ) { |
f93fc77c |
19 | |
20 | my %e = ( |
21 | REMOTE_ADDR => $client->peerhost, |
22 | REMOTE_HOST => $client->peerhost, |
23 | REMOTE_PORT => $client->peerport |
24 | ); |
3cdea3c7 |
25 | |
26 | while ( my $request = $client->get_request ) { |
27 | |
f93fc77c |
28 | my $c = HTTP::Request::AsCGI->new( $request, %e )->setup; |
3cdea3c7 |
29 | my $q = CGI->new; |
30 | |
f93fc77c |
31 | print $q->header, |
32 | $q->start_html('Hello World'), |
3cdea3c7 |
33 | $q->h1('Hello World'), |
34 | $q->end_html; |
35 | |
36 | $c->restore; |
37 | |
f93fc77c |
38 | my $message = "HTTP/1.1 200\x0d\x0a"; |
3cdea3c7 |
39 | |
40 | while ( my $line = $c->stdout->getline ) { |
41 | $message .= $line; |
42 | last if $line =~ /^\x0d?\x0a$/; |
43 | } |
44 | |
45 | my $response = HTTP::Response->parse($message); |
f93fc77c |
46 | |
47 | if ( my $code = $response->header('Status') ) { |
48 | $response->code($code); |
49 | } |
50 | |
51 | $response->header( Connection => 'close' ); |
52 | $response->protocol( $request->protocol ); |
3cdea3c7 |
53 | $response->content( sub { |
54 | if ( $c->stdout->read( my $buffer, 4096 ) ) { |
55 | return $buffer; |
56 | } |
57 | return undef; |
58 | }); |
59 | |
60 | $client->send_response($response); |
f93fc77c |
61 | $client->close; |
3cdea3c7 |
62 | } |
63 | |
f93fc77c |
64 | #$client->close; |
3cdea3c7 |
65 | } |