1 | package Mojo::IOLoop::Stream::HTTPServer;
|
---|
2 | use Mojo::Base 'Mojo::IOLoop::Stream';
|
---|
3 |
|
---|
4 | use Mojo::Server;
|
---|
5 | use Mojo::Transaction::WebSocket;
|
---|
6 | use Mojo::Util 'term_escape';
|
---|
7 | use Mojo::WebSocket 'server_handshake';
|
---|
8 | use Scalar::Util 'weaken';
|
---|
9 |
|
---|
10 | use constant DEBUG => $ENV{MOJO_SERVER_DEBUG} || 0;
|
---|
11 |
|
---|
12 | has app => sub { Mojo::Server->new->build_app('Mojo::HelloWorld') };
|
---|
13 | has max_requests => 100;
|
---|
14 |
|
---|
15 | sub new {
|
---|
16 | my $self = shift->SUPER::new(@_);
|
---|
17 | $self->on(read => sub { shift->_read_content(shift) });
|
---|
18 | $self->on(close => sub { shift->_close });
|
---|
19 | return $self;
|
---|
20 | }
|
---|
21 |
|
---|
22 | sub _build_tx {
|
---|
23 | my $self = shift;
|
---|
24 |
|
---|
25 | my $tx = $self->app->build_tx;
|
---|
26 | $tx->res->headers->server('Mojolicious (Perl)');
|
---|
27 | my $handle = $self->handle;
|
---|
28 | unless ($handle->isa('IO::Socket::UNIX')) {
|
---|
29 | $tx->local_address($handle->sockhost)->local_port($handle->sockport);
|
---|
30 | $tx->remote_address($handle->peerhost)->remote_port($handle->peerport);
|
---|
31 | }
|
---|
32 | $tx->req->url->base->scheme('https') if $handle->isa('IO::Socket::SSL');
|
---|
33 |
|
---|
34 | weaken $self;
|
---|
35 | $tx->on(
|
---|
36 | request => sub {
|
---|
37 | my $tx = shift;
|
---|
38 |
|
---|
39 | # WebSocket
|
---|
40 | my $req = $tx->req;
|
---|
41 | if ($req->is_handshake) {
|
---|
42 | my $ws = $self->{next}
|
---|
43 | = Mojo::Transaction::WebSocket->new(handshake => $tx);
|
---|
44 | $self->emit(request => server_handshake $ws);
|
---|
45 | }
|
---|
46 |
|
---|
47 | # HTTP
|
---|
48 | else { $self->emit(request => $tx) }
|
---|
49 |
|
---|
50 | # Last keep-alive request or corrupted connection
|
---|
51 | $tx->res->headers->connection('close')
|
---|
52 | if ($self->{keep_alive} || 1) >= $self->max_requests || $req->error;
|
---|
53 |
|
---|
54 | $tx->on(resume => sub { $self->_write_content });
|
---|
55 | $self->_write_content;
|
---|
56 | }
|
---|
57 | );
|
---|
58 |
|
---|
59 | $self->emit(start => $tx);
|
---|
60 |
|
---|
61 | # Kept alive if we have more than one request on the connection
|
---|
62 | return ++$self->{keep_alive} > 1 ? $tx->kept_alive(1) : $tx;
|
---|
63 | }
|
---|
64 |
|
---|
65 | sub _close { delete($_[0]->{tx})->closed if $_[0]->{tx} }
|
---|
66 |
|
---|
67 | sub _finish {
|
---|
68 | my $self = shift;
|
---|
69 |
|
---|
70 | # Always remove connection for WebSockets
|
---|
71 | return unless my $tx = $self->{tx};
|
---|
72 |
|
---|
73 | # Finish transaction
|
---|
74 | delete($self->{tx})->closed;
|
---|
75 |
|
---|
76 | # Upgrade connection to WebSocket
|
---|
77 | if (my $ws = delete $self->{next}) {
|
---|
78 |
|
---|
79 | # Successful upgrade
|
---|
80 | if ($ws->handshake->res->code == 101) {
|
---|
81 | $self->emit(upgrade => $ws->established(1));
|
---|
82 | }
|
---|
83 |
|
---|
84 | # Failed upgrade
|
---|
85 | else { $ws->closed }
|
---|
86 | }
|
---|
87 |
|
---|
88 | # Close connection if necessary
|
---|
89 | return $self->close_gracefully if $tx->error || !$tx->keep_alive;
|
---|
90 |
|
---|
91 | # Build new transaction for leftovers
|
---|
92 | return unless length(my $leftovers = $tx->req->content->leftovers);
|
---|
93 | $self->{tx} = $tx = $self->_build_tx;
|
---|
94 | $tx->server_read($leftovers);
|
---|
95 | }
|
---|
96 |
|
---|
97 | sub _read_content {
|
---|
98 | my ($self, $chunk) = @_;
|
---|
99 | my $tx = $self->{tx} ||= $self->_build_tx;
|
---|
100 | warn term_escape "-- Server <<< Client (@{[_url($tx)]})\n$chunk\n" if DEBUG;
|
---|
101 | $tx->server_read($chunk);
|
---|
102 | }
|
---|
103 |
|
---|
104 | sub _url { shift->req->url->to_abs }
|
---|
105 |
|
---|
106 | sub _write_content {
|
---|
107 | my $self = shift;
|
---|
108 |
|
---|
109 | # Protect from resume event recursion
|
---|
110 | return if !(my $tx = $self->{tx}) || $self->{cont_writing};
|
---|
111 | local $self->{cont_writing} = 1;
|
---|
112 | my $chunk = $tx->server_write;
|
---|
113 | warn term_escape "-- Server >>> Client (@{[_url($tx)]})\n$chunk\n" if DEBUG;
|
---|
114 | my $next
|
---|
115 | = $tx->is_finished ? '_finish' : length $chunk ? '_write_content' : undef;
|
---|
116 | return $self->write($chunk) unless $next;
|
---|
117 | $self->write($chunk => sub { shift->$next() });
|
---|
118 | }
|
---|
119 |
|
---|
120 | 1;
|
---|
121 |
|
---|
122 | =encoding utf8
|
---|
123 |
|
---|
124 | =head1 NAME
|
---|
125 |
|
---|
126 | Mojo::IOLoop::Stream::HTTPServer - Non-blocking I/O HTTP server stream
|
---|
127 |
|
---|
128 | =head1 SYNOPSIS
|
---|
129 |
|
---|
130 | use Mojo::IOLoop::Server;
|
---|
131 | use Mojo::IOLoop::Stream::HTTPServer;
|
---|
132 |
|
---|
133 | # Create listen socket
|
---|
134 | my $server = Mojo::IOLoop::Server->new;
|
---|
135 | $server->on(
|
---|
136 | accept => sub {
|
---|
137 | my $stream = Mojo::IOLoop::Stream::HTTPServer->new(pop);
|
---|
138 |
|
---|
139 | $stream->on(
|
---|
140 | request => sub {
|
---|
141 | my ($stream, $tx) = @_;
|
---|
142 | $tx->res->code(200);
|
---|
143 | $tx->res->headers->content_type('text/plain');
|
---|
144 | $tx->res->body('Hello World!');
|
---|
145 | $tx->resume;
|
---|
146 | }
|
---|
147 | );
|
---|
148 | $stream->start;
|
---|
149 | }
|
---|
150 | );
|
---|
151 | $server->listen(port => 3000);
|
---|
152 |
|
---|
153 | # Start reactor if necessary
|
---|
154 | $stream->reactor->start unless $stream->reactor->is_running;
|
---|
155 |
|
---|
156 | =head1 DESCRIPTION
|
---|
157 |
|
---|
158 | L<Mojo::IOLoop::Stream::HTTPServer> is a container for I/O streams used by
|
---|
159 | L<Mojo::IOLoop> to support the HTTP protocol server-side.
|
---|
160 |
|
---|
161 | =head1 EVENTS
|
---|
162 |
|
---|
163 | L<Mojo::IOLoop::Stream::HTTPServer> inherits all events from
|
---|
164 | L<Mojo::IOLoop::Stream> and can emit the following new ones.
|
---|
165 |
|
---|
166 | =head2 request
|
---|
167 |
|
---|
168 | $stream->on(request => sub {
|
---|
169 | my ($sream, $tx) = @_;
|
---|
170 | ...
|
---|
171 | });
|
---|
172 |
|
---|
173 | Emitted when a request is ready and needs to be handled.
|
---|
174 |
|
---|
175 | $stream->on(request => sub {
|
---|
176 | my ($stream, $tx) = @_;
|
---|
177 | $tx->res->code(200);
|
---|
178 | $tx->res->headers->content_type('text/plain');
|
---|
179 | $tx->res->body('Hello World!');
|
---|
180 | $tx->resume;
|
---|
181 | });
|
---|
182 |
|
---|
183 | =head2 start
|
---|
184 |
|
---|
185 | $stream->on(start => sub {
|
---|
186 | my ($stream, $tx) = @_;
|
---|
187 | ...
|
---|
188 | });
|
---|
189 |
|
---|
190 | Emitted whenever a transaction for a new request is about to start.
|
---|
191 |
|
---|
192 | =head2 upgrade
|
---|
193 |
|
---|
194 | $stream->on(upgrade => sub {
|
---|
195 | my ($stream, $ws) = @_;
|
---|
196 | ...
|
---|
197 | });
|
---|
198 |
|
---|
199 | Emitted when the connection should be upgraded to the WebSocket protocol.
|
---|
200 |
|
---|
201 | =head1 ATTRIBUTES
|
---|
202 |
|
---|
203 | L<Mojo::IOLoop::Stream::HTTPServer> inherits all attributes from
|
---|
204 | L<Mojo::IOLoop::Stream> and implements the following ones.
|
---|
205 |
|
---|
206 | =head2 app
|
---|
207 |
|
---|
208 | my $app = $stream->app;
|
---|
209 | $stream = $stream->app(Mojolicious->new);
|
---|
210 |
|
---|
211 | Application responsible for building transactions, defaults to a
|
---|
212 | L<Mojo::HelloWorld> object.
|
---|
213 |
|
---|
214 | =head2 max_requests
|
---|
215 |
|
---|
216 | my $max = $stream->max_requests;
|
---|
217 | $stream = $stream->max_requests(250);
|
---|
218 |
|
---|
219 | Maximum number of keep-alive requests per connection, defaults to C<100>.
|
---|
220 |
|
---|
221 | =head1 METHODS
|
---|
222 |
|
---|
223 | L<Mojo::IOLoop::Stream::HTTPServer> inherits all methods from
|
---|
224 | L<Mojo::IOLoop::Stream> and implements the following new ones.
|
---|
225 |
|
---|
226 | =head2 new
|
---|
227 |
|
---|
228 | my $stream = Mojo::IOLoop::Stream::HTTPServer->new($handle);
|
---|
229 |
|
---|
230 | Construct a new L<Mojo::IOLoop::Stream::HTTPServer> object.
|
---|
231 |
|
---|
232 | =head1 DEBUGGING
|
---|
233 |
|
---|
234 | You can set the C<MOJO_SERVER_DEBUG> environment variable to get some advanced
|
---|
235 | diagnostics information printed to C<STDERR>.
|
---|
236 |
|
---|
237 | MOJO_SERVER_DEBUG=1
|
---|
238 |
|
---|
239 | =head1 SEE ALSO
|
---|
240 |
|
---|
241 | L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
|
---|
242 |
|
---|
243 | =cut
|
---|
244 |
|
---|