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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
#!/usr/bin/perl -w
#
# This file is part of the dgit test suite.
#
# Copyright (C)2004-2015 Best Practical Solutions, LLC
# Copyright (C)2019 Ian Jackson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
#
# invocation protocol:
#
# http-static-server >port-file tests/tmp/$thing/aq
#
# Will write the allocated port number to port-file.
# Then we fork and the parent exits 0.
# If port-file is unlinked, we exit.
use strict;
use IO::Handle;
our ($webroot) = @ARGV;
our $port = '';
# HTTP::Server::Simple handles requests in the main process so it
# must redirect and close STDOUT. So transplant STDOUT to CHECK.
open CHECK, ">& STDOUT" or die $!;
open STDOUT, ">/dev/null" or die $!;
sub stat_type_check () {
die "[$port, $webroot] stdout not ta plain file"
unless -f _;
}
stat CHECK or die $!;
stat_type_check();
sub start_polling_fstat () {
our $polling_pid = $$;
$SIG{ALRM} = sub {
return unless $$ = $polling_pid;
stat CHECK or die $!;
my $nlink = (stat _)[3];
exit 0 unless $nlink;
stat_type_check(); # doesn't seem possible to fail but check anyway
alarm(1);
};
alarm(1);
}
package ServerClass;
use strict;
use Socket qw(AF_INET SOCK_STREAM);
use Socket qw(AF_INET SOCK_STREAM unpack_sockaddr_in);
use IO::Handle;
use base qw(HTTP::Server::Simple::CGI);
use HTTP::Server::Simple::Static;
sub handle_request {
my ($self, $cgi) = @_;
if (!$self->serve_static($cgi, $::webroot)) {
print "HTTP/1.0 404 Not found\r\n";
print $cgi->header;
print $cgi->start_html('Not found'),
$cgi->h1('Not found'),
$cgi->end_html
if uc $cgi->request_method eq 'GET';
}
}
sub port () { return 0; }
sub after_setup_listener () {
my $sn = getsockname HTTP::Server::Simple::HTTPDaemon or die $!;
($main::port,) = unpack_sockaddr_in $sn;
print main::CHECK $port, "\n" or die $!;
flush main::CHECK or die $!;
my $c = fork // die $!;
exit 0 if $c;
::main::start_polling_fstat();
}
package main;
our $server = ServerClass->new();
$server->run();
|
