-
Notifications
You must be signed in to change notification settings - Fork 19
/
Easy.pm6
87 lines (80 loc) · 3.31 KB
/
Easy.pm6
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
## A simple HTTP Daemon role. Inspired by HTTP::Server::Simple
## This doesn't do anything by itself, and must be extended.
## See HTTP::Easy::PSGI and HTTP::Easy::SCGI for implementations
## using this role.
class HTTP::Easy {
has Int $.port = 8080;
has Str $.host = 'localhost';
has Bool $.debug = False;
has $!listener = IO::Socket::INET.new(:localhost($.host), :localport($.port), :listen(1));
has $.connection is rw; ## To be populated by accept().
has %.env; ## The environment, generated by run().
has $.body is rw; ## Any request body, populated by run().
## We're using DateTime.new(time) instead of DateTime.now()
## Because the current DateTime messes up the user's local timezone
## if they are in a negative offset, which totally screws up the reported
## time, so we are forcing UTC instead.
sub message ($message) {
my $timestamp = DateTime.new(time).Str;
$*ERR.say: "$timestamp -- $message";
}
method run {
message('Started HTTP server.');
self.pre-connection;
while $.connection = $!listener.accept {
self.on-connection;
if ($.debug) { message("Client connection opened."); }
my $received = $!connection.recv();
if ($.debug) { message("Got HTTP request:\n$received"); }
my @request = split("\x0D\x0A", $received);
my $request = shift @request;
if (! $.debug) { ## This is shown when not debugging.
message($request);
}
my ($method, $uri, $protocol) = $request.split(/\s/);
if (!$protocol) { $protocol = 'HTTP/1.1'; }
unless $method eq any(<GET POST HEAD PUT DELETE>) { die "unknown HTTP method"; }
my ($path, $query) = $uri.split('?', 2);
$query //= '';
## First, let's add our "known" headers.
%.env<SERVER_PROTOCOL> = $protocol;
%.env<REQUEST_METHOD> = $method;
%.env<QUERY_STRING> = $query;
%.env<PATH_INFO> = $path;
%.env<REQUEST_URI> = $uri;
%.env<SERVER_NAME> = $.host;
%.env<SERVER_PORT> = $.port;
## Next, let's add HTTP request headers.
while my $header = shift @request { ## Will end at the first empty line.
my ($key, $value) = $header.split(': ');
if defined $key and defined $value {
$key ~~ s:g/\-/_/;
$key .= uc;
$key = 'HTTP_' ~ $key unless $key eq any(<CONTENT_LENGTH CONTENT_TYPE>);
if %!env.exists($key) {
%!env{$key} ~= ", $value";
}
else {
%!env{$key} = $value;
}
}
}
## Anything left in @request is now the body.
$.body = @request.join("\x0D\x0A"); ## Put it back together with CRLF.
my $res = self.handler; ## Call our handler. It can return an HTTP response, or handle it itself, in which case it should return Nil.
if defined $res {
$!connection.send($res);
}
$!connection.close;
self.closed-connection;
}
self.finish-connection;
}
## Stub methods. Replace with your own.
method pre-connection {}; ## Runs prior to waiting for connection.
method on-connection {}; ## Runs at the beginning of each connection.
method closed-connection {}; ## Runs after closing each connection.
method finished-connection {}; ## Runs when the wait loop is ended.
method handler {}; ## The HTTP request handler (MANDATORY).
}
## End of role.