1 |
use strict; |
2 |
use warnings; |
3 |
|
4 |
use HTTP::Daemon; |
5 |
use HTTP::Status; |
6 |
|
7 |
$|++; |
8 |
|
9 |
my $d = HTTP::Daemon->new(LocalPort => 8000, ReuseAddr => 1) || die; |
10 |
print "Please contact me at: <URL:", $d->url, ">\n"; |
11 |
my $done = 0; |
12 |
while (not $done and my $c = $d->accept) { |
13 |
my $r = $c->get_request; |
14 |
if (not defined($r)) { |
15 |
print "Error: ", $c->reason, "\n"; |
16 |
$c->close; |
17 |
undef($c); |
18 |
next; |
19 |
} |
20 |
print STDERR $r->method, ' ', $r->url, "\n"; |
21 |
$c->force_last_request; |
22 |
if ($r->method eq 'GET') { |
23 |
my $file = substr($r->url->path, 1); |
24 |
if (open FILE, $file) { |
25 |
undef $/; |
26 |
binmode FILE; |
27 |
my $content = <FILE>; |
28 |
close FILE; |
29 |
my @headers = ('Connection' => 'close'); |
30 |
if ($file =~ /\.js$/) { |
31 |
push @headers, 'Content-Type' => 'text/javascript'; |
32 |
} |
33 |
elsif ($file =~ /\.[^\/]+$/) { |
34 |
push @headers, 'Content-Type' => 'application/octet-stream'; |
35 |
} |
36 |
else { |
37 |
# do nothing - no Content-Type |
38 |
} |
39 |
my $response = HTTP::Response->new(200, 'OK', \@headers, $content); |
40 |
$c->send_response($response); |
41 |
} |
42 |
else { |
43 |
my $response = HTTP::Response->new(404, 'Not found', ['Connection' => 'close'], 'Not found'); |
44 |
$c->send_response($response); |
45 |
} |
46 |
} |
47 |
elsif ($r->method eq 'POST') { |
48 |
if ($r->url->path eq '/perl-shutdown') { |
49 |
$done = 1; |
50 |
} |
51 |
my $content = $r->content; |
52 |
my $response = HTTP::Response->new(200, 'OK', ['Connection' => 'close'], $content); |
53 |
$c->send_response($response); |
54 |
} |
55 |
else { |
56 |
$c->send_error(RC_FORBIDDEN); |
57 |
} |
58 |
$c->close; |
59 |
undef($c); |
60 |
} |
61 |
|