File Coverage

blib/lib/Alice/HTTP/Server.pm
Criterion Covered Total %
statement 39 236 16.5
branch 0 54 0.0
condition 0 23 0.0
subroutine 13 46 28.2
pod 1 22 4.5
total 53 381 13.9


line stmt bran cond sub pod time code
1             package Alice::HTTP::Server;
2              
3 2     2   11 use AnyEvent;
  2         4  
  2         50  
4 2     2   2183 use AnyEvent::HTTP;
  2         66583  
  2         227  
5              
6 2     2   2014 use Fliggy::Server;
  2         150664  
  2         64  
7 2     2   1706 use Plack::Builder;
  2         15242  
  2         166  
8 2     2   1741 use Plack::Middleware::Static;
  2         25992  
  2         72  
9 2     2   2172 use Plack::Session::Store::File;
  2         20335  
  2         59  
10 2     2   1639 use Plack::Session::State::Cookie;
  2         167726  
  2         130  
11              
12 2     2   1447 use Alice::HTTP::Request;
  2         9  
  2         60  
13 2     2   1302 use Alice::HTTP::Stream::XHR;
  2         7  
  2         75  
14 2     2   1397 use Alice::HTTP::Stream::WebSocket;
  2         6  
  2         71  
15              
16 2     2   13 use JSON;
  2         5  
  2         12  
17 2     2   244 use Encode;
  2         4  
  2         206  
18 2     2   11 use Any::Moose;
  2         5  
  2         22  
19              
20             has app => (
21             is => 'ro',
22             isa => 'Alice',
23             required => 1,
24             );
25              
26             has httpd => (
27             is => 'rw',
28             lazy => 1,
29             builder => "_build_httpd",
30             );
31              
32             has ping => (
33             is => 'rw',
34             lazy => 1,
35             default => sub {
36             my $self = shift;
37             AE::timer 1, 5, sub {
38             $self->app->ping;
39             };
40             },
41             );
42              
43             has port => (
44             is => 'ro',
45             default => 8080,
46             );
47              
48             has address => (
49             is => 'ro',
50             default => "127.0.0.1",
51             );
52              
53             has session => (
54             is => 'ro'
55             );
56              
57             has assets => (
58             is => 'ro',
59             required => 1,
60             );
61              
62             my $url_handlers = [
63             [ "say" => "handle_message" ],
64             [ "stream" => "setup_xhr_stream" ],
65             [ "wsstream" => "setup_ws_stream" ],
66             [ "" => "send_index" ],
67             [ "safe" => "send_safe_index" ],
68             [ "tabs" => "tab_order" ],
69             [ "savetabsets" => "save_tabsets" ],
70             [ "serverconfig" => "server_config" ],
71             [ "save" => "save_config" ],
72             [ "login" => "login" ],
73             [ "logout" => "logout" ],
74             [ "export" => "export_config" ],
75             ];
76              
77 0     0 0   sub url_handlers { return $url_handlers }
78              
79             sub BUILD {
80 0     0 1   my $self = shift;
81 0           $self->httpd;
82 0           $self->ping;
83             }
84              
85             sub _build_httpd {
86 0     0     my $self = shift;
87 0           my $httpd;
88              
89             # eval in case server can't bind port
90 0           eval {
91 0           $httpd = Fliggy::Server->new(
92             host => $self->address,
93             port => $self->port,
94             );
95             $httpd->register_service(
96             builder {
97 0     0     enable "Session",
98             store => $self->session,
99             state => Plack::Session::State::Cookie->new(expires => 60 * 60 * 24 * 7);
100 0           enable "Static", path => qr{^/static/}, root => $self->assets;
101 0           enable "+Alice::HTTP::WebSocket";
102             sub {
103 0           my $env = shift;
104 0           return sub {$self->dispatch($env, shift)}
105 0           }
106 0           }
107 0           );
108             };
109              
110 0 0         AE::log(warn => $@) if $@;
111 0           return $httpd;
112             }
113              
114             sub dispatch {
115 0     0 0   my ($self, $env, $cb) = @_;
116              
117 0           my $req = Alice::HTTP::Request->new($env, $cb);
118 0           my $res = $req->new_response(200);
119              
120 0           AE::log trace => $req->path;
121              
122 0 0         if ($self->auth_enabled) {
123 0 0 0       unless ($req->path eq "/login" or $self->is_logged_in($req)) {
124 0           $self->auth_failed($req, $res);
125 0           return;
126             }
127             }
128 0           for my $handler (@{$self->url_handlers}) {
  0            
129 0           my $path = $handler->[0];
130 0 0         if ($req->path_info =~ /^\/$path\/?$/) {
131 0           my $method = $handler->[1];
132 0           $self->$method($req, $res);
133 0           return;
134             }
135             }
136 0           $self->template($req, $res);
137             }
138              
139             sub auth_failed {
140 0     0 0   my ($self, $req, $res) = @_;
141              
142 0 0         if ($req->path =~ m{^(/(?:safe)?)$}) {
143 0 0         $res->redirect("/login".($1 ? "?dest=$1" : ""));
144 0           $res->body("bai");
145             } else {
146 0           $res->status(401);
147 0           $res->body("unauthorized");
148             }
149 0           $res->send;
150             }
151              
152             sub is_logged_in {
153 0     0 0   my ($self, $req) = @_;
154 0           my $session = $req->env->{"psgix.session"};
155 0           return $session->{is_logged_in};
156             }
157              
158             sub login {
159 0     0 0   my ($self, $req, $res) = @_;
160              
161 0   0       my $dest = $req->param("dest") || "/";
162              
163             # no auth is required
164 0 0 0       if (!$self->auth_enabled) {
    0          
165 0           $res->redirect($dest);
166 0           $res->send;
167             }
168              
169             # we have credentials
170             elsif (my $user = $req->param('username')
171             and my $pass = $req->param('password')) {
172              
173             $self->authenticate($user, $pass, sub {
174 0     0     my $app = shift;
175 0 0         if ($app) {
176 0           $req->env->{"psgix.session"} = {
177             is_logged_in => 1,
178             username => $user,
179             userid => $app->user,
180             };
181 0           $res->redirect($dest);
182             }
183             else {
184 0           $req->env->{"psgix.session"}{is_logged_in} = 0;
185 0           $req->env->{"psgix.session.options"}{expire} = 1;
186 0           $res->content_type("text/html; charset=utf-8");
187 0           $res->body($self->render("login", $dest, "bad username or password"));
188             }
189 0           $res->send;
190 0           });
191             }
192              
193             # render the login page
194             else {
195 0           $res->content_type("text/html; charset=utf-8");
196 0           $res->body($self->render("login", $dest));
197 0           $res->send;
198             }
199             }
200              
201             sub logout {
202 0     0 0   my ($self, $req, $res) = @_;
203 0           $_->close for @{$self->app->streams};
  0            
204 0 0         if (!$self->auth_enabled) {
205 0           $res->redirect("/");
206             } else {
207 0           $req->env->{"psgix.session"}{is_logged_in} = 0;
208 0           $req->env->{"psgix.session.options"}{expire} = 1;
209 0           $res->redirect("/login");
210             }
211 0           $res->send;
212             }
213              
214             sub setup_xhr_stream {
215 0     0 0   my ($self, $req, $res) = @_;
216 0           my $app = $self->app;
217              
218 0           AE::log debug => "opening new stream";
219              
220 0           $res->headers([@Alice::HTTP::Stream::XHR::headers]);
221             my $stream = Alice::HTTP::Stream::XHR->new(
222             writer => $res->writer,
223             start_time => $req->param('t'),
224             # android requires 4K updates to trigger loading event
225             min_bytes => $req->user_agent =~ /android/i ? 4096 : 0,
226 0     0     on_error => sub { $app->purge_disconnects },
227 0 0         );
228              
229 0           $stream->send([$app->connect_actions]);
230 0           $app->add_stream($stream);
231             }
232              
233             sub setup_ws_stream {
234 0     0 0   my ($self, $req, $res) = @_;
235 0           my $app = $self->app;
236              
237 0           AE::log debug => "opening new websocket stream";
238              
239 0 0         if (my $fh = $req->env->{'websocket.impl'}->handshake) {
240             my $stream = Alice::HTTP::Stream::WebSocket->new(
241             start_time => $req->param('t') || time,
242             fh => $fh,
243 0     0     on_read => sub { $app->handle_message(@_) },
244 0     0     on_error => sub { $app->purge_disconnects },
245 0   0       ws_version => $req->env->{'websocket.impl'}->version,
246             );
247              
248 0           $stream->send([$app->connect_actions]);
249 0           $app->add_stream($stream);
250             }
251             else {
252 0           my $code = $req->env->{'websocket.impl'}->error_code;
253 0           $res->send([$code, ["Content-Type", "text/plain"], ["something broke"]]);
254             }
255             }
256              
257             sub handle_message {
258 0     0 0   my ($self, $req, $res) = @_;
259              
260 0           my $msg = $req->param('msg');
261 0           my $html = $req->param('html');
262 0           my $source = $req->param('source');
263 0           my $stream = $req->param('stream');
264              
265 0 0         $self->app->handle_message({
    0          
    0          
    0          
266             msg => defined $msg ? $msg : "",
267             html => defined $html ? $html : "",
268             source => defined $source ? $source : "",
269             stream => defined $stream ? $stream : "",
270             });
271            
272 0           $res->ok;
273             }
274              
275             sub send_safe_index {
276 0     0 0   my ($self, $req, $res) = @_;
277 0           $req->parameters->{images} = "hide";
278 0           $req->parameters->{avatars} = "hide";
279 0           $self->send_index($req, $res);
280             }
281              
282             sub send_index {
283 0     0 0   my ($self, $req, $res) = @_;
284 0           my $options = $self->merged_options($req);
285 0           my $app = $self->app;
286              
287 0           $res->headers(["Content-type" => "text/html; charset=utf-8"]);
288 0           my $writer = $res->writer;
289 0           my @windows = $app->sorted_windows;
290              
291 0           my @queue;
292            
293 0     0     push @queue, sub {$app->render('index_head', @windows)};
  0            
294 0           for my $window (@windows) {
295 0     0     push @queue, sub {$app->render('window_head', $window)};
  0            
296 0     0     push @queue, sub {$app->render('window_footer', $window)};
  0            
297             }
298             push @queue, sub {
299 0     0     my $html = $app->render('index_footer', $options, @windows);
300 0           $app->config->first_run(0);
301 0           $app->config->write;
302 0           return $html;
303 0           };
304              
305 0           my $idle_w; $idle_w = AE::idle sub {
306 0 0   0     if (my $cb = shift @queue) {
307 0           my $content = encode "utf8", $cb->();
308 0           $writer->write($content);
309             } else {
310 0           $writer->close;
311 0           undef $idle_w;
312             }
313 0           };
314             }
315              
316             sub merged_options {
317 0     0 0   my ($self, $req) = @_;
318 0           my $config = $self->app->config;
319              
320 0   0       my $options = { map { $_ => ($req->param($_) || $config->$_) }
  0            
321             qw/images avatars alerts audio timeformat image_prefix/ };
322              
323 0 0 0       if ($options->{images} eq "show" and $config->animate eq "hide") {
324 0           $options->{image_prefix} = "https://noembed.com/i/still/";
325             }
326              
327 0           return $options;
328             }
329              
330             sub template {
331 0     0 0   my ($self, $req, $res) = @_;
332 0           my $path = $req->path;
333 0           $path =~ s/^\///;
334              
335 0           eval {
336 0           $res->body($self->render($path));
337             };
338              
339 0 0         if ($@) {
340 0           AE::log(warn => $@);
341 0           $res->notfound;
342             }
343             else {
344 0           $res->send;
345             }
346             }
347              
348             sub save_tabsets {
349 0     0 0   my ($self, $req, $res) = @_;
350              
351 0           AE::log debug => "saving tabsets";
352              
353 0           my $tabsets = {};
354              
355 0           for my $set ($req->param) {
356 0 0         next if $set eq '_';
357 0           my $wins = [$req->param($set)];
358 0 0         $tabsets->{$set} = $wins->[0] eq 'empty' ? [] : $wins;
359             }
360              
361 0           $self->app->config->tabsets($tabsets);
362 0           $self->app->config->write;
363              
364 0           $res->body($self->render('tabset_menu'));
365 0           $res->send;
366             }
367              
368             sub server_config {
369 0     0 0   my ($self, $req, $res) = @_;
370              
371 0           AE::log debug => "serving blank server config";
372            
373 0           my $name = $req->param('name');
374 0           $name =~ s/\s+//g;
375 0           my $config = $self->render('new_server', $name);
376 0           my $listitem = $self->render('server_listitem', $name);
377            
378 0           $res->body(to_json({config => $config, listitem => $listitem}));
379 0           $res->header("Cache-control" => "no-cache");
380 0           $res->send;
381             }
382              
383             #
384             # TODO separate methods for saving prefs and server configs
385             #
386              
387             sub save_config {
388 0     0 0   my ($self, $req, $res) = @_;
389              
390 0           AE::log debug => "saving config";
391            
392 0           my $new_config = {};
393 0 0         if ($req->param('has_servers')) {
394 0           $new_config->{servers} = {};
395             }
396             else {
397 0           $new_config->{$_} = [$req->param($_)] for qw/highlights monospace_nicks/;
398             }
399              
400 0           for my $name ($req->param) {
401 0 0         next unless $req->param($name);
402 0 0         next if $name =~ /^(?:has_servers|highlights|monospace_nicks)$/;
403 0 0 0       if ($name =~ /^(.+?)_(.+)/ and exists $new_config->{servers}) {
404 0 0 0       if ($2 eq "channels" or $2 eq "on_connect") {
405 0           $new_config->{servers}{$1}{$2} = [$req->param($name)];
406             } else {
407 0           $new_config->{servers}{$1}{$2} = $req->param($name);
408             }
409             }
410             else {
411 0           $new_config->{$name} = $req->param($name);
412             }
413             }
414              
415 0           $self->app->reload_config($new_config);
416 0           $self->app->send_info("config", "saved");
417 0           $res->ok;
418             }
419              
420             sub tab_order {
421 0     0 0   my ($self, $req, $res) = @_;
422              
423 0           AE::log debug => "updating tab order";
424            
425 0           $self->app->tab_order([grep {defined $_} $req->param('tabs')]);
  0            
426 0           $res->ok;
427             }
428              
429             sub auth_enabled {
430 0     0 0   my $self = shift;
431 0           $self->app->auth_enabled;
432             }
433              
434             sub authenticate {
435 0     0 0   my ($self, $user, $pass, $cb) = @_;
436 0           my $success = $self->app->authenticate($user, $pass);
437 0 0         $cb->($success ? $self->app : ());
438             }
439              
440             sub render {
441 0     0 0   my $self = shift;
442 0           return $self->app->render(@_);
443             }
444              
445             sub export_config {
446 0     0 0   my ($self, $req, $res) = @_;
447 0           $res->content_type("text/plain; charset=utf-8");
448             {
449 0           $res->body(to_json($self->app->config->serialized,
  0            
450             {utf8 => 1, pretty => 1}));
451             }
452 0           $res->send;
453             }
454              
455             __PACKAGE__->meta->make_immutable;
456             1;