1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
use Test::More;
BEGIN {
my @needs = grep { ! eval "require $_; 1" } qw(HTTP::Daemon Net::EmptyPort);
if( @needs ) {
plan 'skip_all' => "Local::localversion needs " . join ' and ', @needs;
}
}
use File::Spec::Functions qw(catfile);
use HTTP::Response;
use Net::EmptyPort;
sub start_server {
my( $port ) = @_;
my $child_pid = fork;
return $child_pid unless $child_pid == 0;
require HTTP::Daemon;
require HTTP::Date;
require HTTP::Status;
my $d = HTTP::Daemon->new( LocalPort => $port ) or exit;
CONNECTION: while (my $c = $d->accept) {
REQUEST: while (my $r = $c->get_request) {
my $file = (split m|/|, $r->uri->path)[-1] // 'index.html';
my $path = catfile 't', 'html', $file;
if ($r->method eq 'GET') {
if( -e $path ) {
$c->send_file_response( catfile 't', 'html', $file);
}
elsif( $path eq 'shutdown' ) {
$c->close; undef $c;
last CONNECTION;
}
else {
$c->send_error(HTTP::Status::RC_NOT_FOUND())
}
}
elsif ($r->method eq 'HEAD') { # update_mirror does this
if( -e $path ) {
my $res = HTTP::Response->new;
$res->code(200);
$res->content('');
$res->header('Last-Modified' => HTTP::Date::time2str( (stat $path)[9] )),
$res->header('Content-Length' => (-s $path));
$c->send_response($res);
}
else {
$c->send_error(HTTP::Status::RC_NOT_FOUND())
}
}
else {
$c->send_error(HTTP::Status::RC_FORBIDDEN())
}
}
$c->close;
undef($c);
}
exit;
}
sub can_fetch { require LWP::UserAgent; LWP::UserAgent->new->get( shift )->is_success }
1;
|
