File Coverage

blib/lib/Mojolicious/Plugin/Status.pm

Criterion	Covered	Total	%
statement	166	176	94.3
branch	29	50	58.0
condition	4	9	44.4
subroutine	34	36	94.4
pod	1	1	100.0
total	234	272	86.0

package Mojolicious::Plugin::Status;
use Mojo::Base 'Mojolicious::Plugin';

use BSD::Resource qw(getrusage);
use Time::HiRes qw(time);
use Mojo::File qw(path);
use Mojo::IOLoop;
use Mojo::MemoryMap;
use Mojo::Util qw(humanize_bytes);

use constant MACOS => $^O eq 'darwin';

our $VERSION = '1.17';

sub register {
  my ($self, $app, $config) = @_;

  # Config
  my $prefix = $config->{route} // $app->routes->any('/mojo-status');
  $prefix->to(return_to => $config->{return_to} // '/');
  $self->{slowest} = $config->{slowest} // 10;

  # Initialize cache
  my $map = $self->{map} = Mojo::MemoryMap->new($config->{size});
  $map->writer->store({processed => 0, started => time, stats => _stats(), slowest => []});

  # Only the two built-in servers are supported for now
  $app->hook(before_server_start => sub { $self->_start(@_) });

  # Static files
  my $resources = path(__FILE__)->sibling('resources');
  push @{$app->static->paths}, $resources->child('public')->to_string;

  # Templates
  push @{$app->renderer->paths}, $resources->child('templates')->to_string;

  # Routes
  $prefix->get('/' => => [format => ['json']] => {format => undef, mojo_status => $self} => \&_dashboard)
    ->name('mojo_status');
}

sub _activity {
  my $all = shift;

  # Workers
  my @table;
  for my $pid (sort keys %{$all->{workers}}) {
    my $worker = $all->{workers}{$pid};
    my $cpu    = sprintf '%.2f', $worker->{utime} + $worker->{stime};
    my @worker = ($pid, $cpu, humanize_bytes($worker->{maxrss}));

    # Connections
    my $connections = $worker->{connections};
    if (keys %$connections) {
      my $repeat;
      for my $cid (sort keys %$connections) {
        my $conn = $connections->{$cid};
        @worker = ('', '', '') if $repeat++;
        my $bytes_read    = humanize_bytes $conn->{bytes_read};
        my $bytes_written = humanize_bytes $conn->{bytes_written};
        my $rw            = "$bytes_read/$bytes_written";
        my @conn          = ($conn->{client}, $rw, $conn->{processed});

        # Request
        if (my $req = $conn->{request}) {
          my $active = $req->{finished} ? 0 : 1;
          my ($rid, $proto) = @{$req}{qw(request_id protocol)};

          my $str = "$req->{method} $req->{path}";
          $str .= "?$req->{query}"    if $req->{query};
          $str .= " → $req->{status}" if $req->{status};

          my $finished = $active ? time : $req->{finished};
          my $time     = sprintf '%.2f', $finished - $req->{started};
          push @table, [@worker, @conn, $rid, $active, $time, $proto, $str];
        }
        else { push @table, [@worker, @conn] }
      }
    }
    else { push @table, \@worker }
  }

  return \@table;
}

sub _dashboard {
  my $c = shift;

  my $map = $c->stash('mojo_status')->{map};
  if ($c->param('reset')) {
    $map->writer->change(sub { @{$_}{qw(slowest stats)} = ([], _stats()) });
    return $c->redirect_to('mojo_status');
  }

  my $all = $map->writer->fetch;
  $c->respond_to(
    html => sub {
      $c->render(
        'mojo-status/dashboard',
        now      => time,
        usage    => humanize_bytes($map->usage),
        size     => humanize_bytes($map->size),
        activity => _activity($all),
        slowest  => _slowest($all),
        all      => $all
      );
    },
    json => {json => $all}
  );
}

sub _read_write {
  my ($all, $id) = @_;
  return unless my $stream = Mojo::IOLoop->stream($id);
  @{$all->{workers}{$$}{connections}{$id}}{qw(bytes_read bytes_written)}
    = ($stream->bytes_read, $stream->bytes_written);
}

sub _request {
  my ($self, $c) = @_;

  # Request start
  my $tx    = $c->tx;
  my $id    = $tx->connection;
  my $req   = $tx->req;
  my $url   = $req->url->to_abs;
  my $proto = $tx->is_websocket ? 'ws' : 'http';
  $proto .= 's' if $req->is_secure;
  $self->{map}->writer->change(sub {
    $_->{workers}{$$}{connections}{$id}{request} = {
      request_id => $req->request_id,
      method     => $req->method,
      protocol   => $proto,
      path       => $url->path->to_abs_string,
      query      => $url->query->to_string,
      started    => time
    };
    _read_write($_, $id);
    $_->{workers}{$$}{connections}{$id}{client} = $tx->remote_address;
  });

  # Request end
  $tx->on(
    finish => sub {
      my $tx = shift;
      $self->{map}->writer->change(sub {
        return unless my $worker = $_->{workers}{$$};

        my $code = $tx->res->code || 0;
        if    ($code > 499) { $_->{stats}{server_error}++ }
        elsif ($code > 399) { $_->{stats}{client_error}++ }
        elsif ($code > 299) { $_->{stats}{redirect}++ }
        elsif ($code > 199) { $_->{stats}{success}++ }
        elsif ($code)       { $_->{stats}{info}++ }

        @{$worker->{connections}{$id}{request}}{qw(finished status)} = (time, $code);
        $worker->{connections}{$id}{processed}++;
        $worker->{processed}++;
        $_->{processed}++;
      });
    }
  );
}

sub _rendered {
  my ($self, $c) = @_;

  my $id = $c->tx->connection;
  $self->{map}->writer->change(sub {
    return unless my $conn = $_->{workers}{$$}{connections}{$id};
    return unless my $req  = $conn->{request};
    $req->{time} = time - $req->{started};
    @{$req}{qw(client status worker)} = ($conn->{client}, $c->res->code, $$);

    my $slowest = $_->{slowest};
    @$slowest = sort { $b->{time} <=> $a->{time} } @$slowest, $req;
    my %seen;
    @$slowest = grep { !$seen{"$_->{method} $_->{path}"}++ } @$slowest;
    pop @$slowest while @$slowest > $self->{slowest};
  });
}

sub _resources {
  my $self = shift;

  $self->{map}->writer->change(sub {
    @{$_->{workers}{$$}}{qw(utime stime maxrss)} = (getrusage)[0, 1, 2];

    # macOS actually returns bytes instead of kilobytes
    $_->{workers}{$$}{maxrss} = $_->{workers}{$$}{maxrss} * 1000 unless MACOS;

    for my $id (keys %{$_->{workers}{$$}{connections}}) { _read_write($_, $id) }
  });
}

sub _slowest {
  my $all = shift;

  my @table;
  for my $req (@{$all->{slowest}}) {
    my $str = "$req->{method} $req->{path}";
    $str .= "?$req->{query}"    if $req->{query};
    $str .= " → $req->{status}" if $req->{status};
    my $time = sprintf '%.2f', $req->{time};
    push @table, [$time, $str, @{$req}{qw(request_id worker client started)}];
  }

  return \@table;
}

sub _start {
  my ($self, $server, $app) = @_;

  return $app->log->warn('Server not suported by Mojolicious::Plugin::Status')
    unless $server->isa('Mojo::Server::Daemon');

  # Register started workers
  Mojo::IOLoop->next_tick(sub {
    $self->{map}->writer->change(sub { $_->{workers}{$$} = {started => time, processed => 0} });
  });

  # Remove stopped workers
  $server->on(
    reap => sub {
      my ($server, $pid) = @_;
      $self->{map}->writer->change(sub { delete $_->{workers}{$pid} });
    }
  ) if $server->isa('Mojo::Server::Prefork');

  # Collect stats
  $app->hook(after_build_tx  => sub { $self->_tx(@_) });
  $app->hook(before_dispatch => sub { $self->_request(@_) });
  $app->hook(after_dispatch  => sub { $self->_rendered(@_) });
  Mojo::IOLoop->next_tick(sub { $self->_resources });
  Mojo::IOLoop->recurring(5 => sub { $self->_resources });
}

sub _stats { {started => time, info => 0, success => 0, redirect => 0, client_error => 0, server_error => 0} }

sub _stream {
  my ($self, $id) = @_;

  my $stream = Mojo::IOLoop->stream($id);
  $stream->on(
    close => sub {
      $self->{map}->writer->change(sub { delete $_->{workers}{$$}{connections}{$id} if $_->{workers}{$$} });
    }
  );
}

sub _tx {
  my ($self, $tx, $app) = @_;

  $tx->on(
    connection => sub {
      my ($tx, $id) = @_;

      my $map = $self->{map};
      return if $map->writer->fetch->{workers}{$$}{connections}{$id};

      $map->writer->change(sub {
        $_->{workers}{$$}{connections}{$id} = {started => time, processed => 0, bytes_read => 0, bytes_written => 0};
      });
      $self->_stream($id);
    }
  );
}

1;

=encoding utf8

=head1 NAME

Mojolicious::Plugin::Status - Mojolicious server status

=head1 SYNOPSIS

  # Mojolicious
  $self->plugin('Status');

  # Mojolicious::Lite
  plugin 'Status';

  # Secure access to the server status ui with Basic authentication
  my $under = $self->routes->under('/status' => sub ($c) {
    return 1 if $c->req->url->to_abs->userinfo eq 'Bender:rocks';
    $c->res->headers->www_authenticate('Basic');
    $c->render(text => 'Authentication required!', status => 401);
    return undef;
  });
  $self->plugin('Status' => {route => $under});

=head1 DESCRIPTION

=begin html



    width="600px">


=end html

L is a L plugin providing a server status ui for L and
L. Note that this module is B and should therefore only be used for debugging
purposes.

=head1 OPTIONS

L supports the following options.

=head2 return_to

  # Mojolicious::Lite
  plugin Status => {return_to => 'some_route'};

Name of route or path to return to when leaving the server status ui, defaults to C.

=head2 route

  # Mojolicious::Lite
  plugin Status => {route => app->routes->any('/status')};

L object to attach the server status ui to, defaults to generating a new one with the
prefix C.

=head2 size

  # Mojolicious::Lite
  plugin Status => {size => 1234};

Size of anonymous mapped memory to use for storing statistics, defaults to C<52428800> (50 MiB).

=head2 slowest

  # Mojolicious::Lite
  plugin Status => {slowest => 5};

Number of slowest requests to track, defaults to C<10>.

=head1 METHODS

L inherits all methods from L and implements the following new ones.

=head2 register

  my $route = $plugin->register(Mojolicious->new);

Register renderer and helper in L application.

=head1 BUNDLED FILES

The L distribution includes a few files with different licenses that have been bundled for
internal use.

=head2 Artwork

  Copyright (C) 2018, Sebastian Riedel.

Licensed under the CC-SA License, Version 4.0 L.

=head2 Bootstrap

  Copyright (C) 2011-2018 The Bootstrap Authors.

Licensed under the MIT License, L.

=head2 Font Awesome

  Copyright (C) Dave Gandy.

Licensed under the MIT License, L, and the SIL OFL 1.1,
L.

=head1 AUTHOR

Sebastian Riedel, C.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2018-2021, Sebastian Riedel and others.

This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version
2.0.

=head1 SEE ALSO

L, L, L.

=cut