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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
package TestHTTPD;
use warnings;
use strict;
require IO::Socket::INET;
require Socket;
require Exporter;
require Time::HiRes;
our @ISA = qw(Exporter);
our @EXPORT = qw(new);
our $VERSION = '0.01';
my $http_methods = {
'GET' => 1,
'POST' => 1,
'HEAD' => 1,
'PUT' => 1,
'DELETE' => 1,
'TRACE' => 1,
'DEBUG' => 1,
'CONNECT' => 1,
'OPTIONS' => 1,
};
sub default_response_parser {
my $sock = shift;
my $status = 500;
# Read HTTP request
for (my $i = 0; my $line = $sock->getline(); $i++) {
if ($i == 0 && $line =~ m/\A(\S+) (\S+) HTTP\/(\S+)\r\n\z/) {
$status = 200 if exists($http_methods->{$1});
}
# Wait for blank line indicating the end of the request
last if $i > 0 && $line eq "\r\n";
}
return $status;
};
my $count = 0;
# This represents the sizes of chunks of our responses
my $responses = [
[ 20 ],
[ 20, 18000],
[ 22 ],
[ 200 ],
[ 20, 1, 1, 1, 1, 1, 1, 200 ],
];
my $http_status_line = {
200 => 'OK',
203 => 'Non-Authoritative Information',
500 => 'Internal Server Error',
};
sub default_response_generator {
$count ++;
return sub($$) {
my $sock = shift;
my $status = shift;
my @chunks = @{$responses->[$count % scalar @{$responses}]};
my $content_length = 0;
map { $content_length += $_ } @chunks;
print $sock "HTTP/1.1 $status " . $http_status_line->{$status} . "\r\n";
print $sock "Server: TestHTTPD/$VERSION\r\n";
print $sock "Content-Type: text/plain\r\n";
print $sock "Content-Length: $content_length\r\n";
print $sock "Connection: close\r\n";
print $sock "\r\n";
# Return data in chunks specified in responses
while (my $length = shift @chunks) {
print $sock 'X' x $length;
$sock->flush();
Time::HiRes::usleep(100) if @chunks;
}
};
}
sub httpd {
my %args = @_;
my $ip = $args{'ip'} || 'localhost';
my $port = $args{'port'} || 8081;
my $request_parser = $args{'parser'} || \&default_response_parser;
my $responder_generator = $args{'generator'} || \&default_response_generator;
my $server = IO::Socket::INET->new(Listen => Socket::SOMAXCONN(),
Proto => 'tcp',
LocalAddr => $ip,
LocalPort => $port,
ReuseAddr => 1)
or die $!;
$SIG{CHLD} = 'IGNORE';
while(my $client = $server->accept()) {
my $responder = $responder_generator->();
my $pid = fork();
next if $pid; # Parent
die "fork: $!" unless defined $pid;
# Child
#
my $status = $request_parser->($client);
# Assume a GET request
$responder->($client, $status);
$client->close();
exit 0;
} continue {
# close child sockets
$client->close();
}
die "accept(): $!";
}
1;
|
