Merge pull request #18 from Troglodyne-Internet-Widgets/log-request-errors

Put the reason for a 500 somewhere that can be read

Makefile.PL

@@ -53,6 +53,7 @@ WriteMakefile(
         "File::Temp" => "0",
         "Test2::V0"  => "0",
         "Test2::Plugin::NoWarnings" => "0",
+        "Test::MockModule"          => "0",
     },
     test => {TESTS => 't/*.t'}
 );

bin/tpsgi

@@ -60,6 +60,8 @@ our $app = sub {
     require Devel::NYTProf;
     mkdir "$options{tpsgi_dir}/prof";
 
-    my $self = TPSGI->new(%options);
+    # new() loads the routers, so a router that will not compile dies here,
+    # before app() can catch anything.
+    my $self = eval { TPSGI->new(%options) } or return TPSGI::cannot_start( $@, $_[0], %options );
     return $self->app(@_);
 };

lib/TPSGI.pm

@@ -581,17 +581,44 @@ my $cur_query = {};
 sub app {
     my $self = shift;
     return eval { _app( $self, @_ ) } || do {
+        my $err = $@;
         my $env = shift;
-        $env->{'psgi.errors'}->print($@) if $env->{'psgi.errors'};
+        $env->{'psgi.errors'}->print($err) if $env->{'psgi.errors'};
+
+        # psgi.errors is the server's stderr, which a daemonized server sends
+        # nowhere unless it was started with --error-log.  The log is the one
+        # place that is always there, so the reason goes in it whole.
+        $self->ERROR("Request failed: $err");
 
         # Redact the stack trace past line 1, it usually has things which should not be shown
-        $cur_query->{message} = $@;
+        $cur_query->{message} = $err;
         $cur_query->{message} =~ s/\n.*//g if $cur_query->{message} && !$debug;
 
         return $self->error($cur_query);
     };
 }
 
+=head2 cannot_start($error, $env, %options) = ARRAYREF
+
+What to answer with when new() died, so there is no object to answer with.
+Usually a router that would not load: a missing module, a syntax error.
+
+The error goes to psgi.errors, and to the log by way of a stand-in built from
+the same options, so it lands in the same places a request's own errors do.  If
+building the log is what failed -- a logger that will not load -- psgi.errors
+is all there is, and the answer is still a 500 rather than a second exception.
+
+=cut
+
+sub cannot_start {
+    my ( $error, $env, %options ) = @_;
+
+    $env->{'psgi.errors'}->print($error) if ref $env eq 'HASH' && $env->{'psgi.errors'};
+    eval { bless( { %options, ip => '0.0.0.0' }, __PACKAGE__ )->ERROR("Could not start: $error"); 1 };
+
+    return [ 500, [ $ct => $content_types{text} ], ['Internal Server Error'] ];
+}
+
 my %etags;
 
 sub _app {

service/tpsgi.sh

@@ -42,8 +42,16 @@ for bind in "${BIND_DIRS[@]}"; do
     fi;
 done
 
+# Daemonizing points stderr at /dev/null, and stderr is where the server puts
+# whatever an application dies with.  --error-log points it at a file instead,
+# which the server opens before it chroots or drops privileges, so the path is
+# one outside the chroot.  It is the directory tPSGI's own log goes in, which
+# the workers write as $USERNAME, so that is who it is made for.
+LOG_DIR=$(bin/tpsgi-config --log_dir)
+[[ -d $LOG_DIR ]] || install -d -o "$USERNAME" -g "$GROUP" "$LOG_DIR"
+
 # We should obey the PATH set by this user, whose homedir is right here, ideally.
-bin/tarbaby --listen run/tpsgi.sock --workers 20 --user "$USERNAME" --group "$GROUP" --daemonize --pid run/tpsgi.pid --chroot $(pwd) bin/tpsgi
+bin/tarbaby --listen run/tpsgi.sock --workers 20 --user "$USERNAME" --group "$GROUP" --daemonize --error-log "$LOG_DIR/error.log" --pid run/tpsgi.pid --chroot $(pwd) bin/tpsgi
 
 if [ $? -ne 0 ]
 then

t/TPSGI.t

@@ -0,0 +1,91 @@
+use strict;
+use warnings;
+
+use Test2::V0;
+use Test2::Plugin::NoWarnings;
+
+use Cwd            qw{abs_path};
+use File::Temp     qw{tempdir};
+use File::Basename qw{dirname};
+use Test::MockModule;
+
+use lib dirname( abs_path(__FILE__) ) . '/../lib';
+
+use TPSGI;
+
+# Every line the log gets, so a test can ask whether the reason for a 500 is
+# among them.
+package Test::Logger::Capture {
+    use parent qw{Log::Dispatch::Output};
+
+    our @lines;
+
+    sub new {
+        my ( $class, %p ) = @_;
+        my $self = bless {}, $class;
+        $self->_basic_init( name => 'capture', min_level => $p{min_level} );
+        return $self;
+    }
+
+    sub log_message {
+        my ( $self, %p ) = @_;
+        push( @lines, $p{message} );
+        return;
+    }
+}
+$INC{'Test/Logger/Capture.pm'} = __FILE__;
+
+my $dir     = tempdir( CLEANUP => 1 );
+my %options = (
+    log_name => "$dir/tpsgi.log",
+    log_dir  => $dir,
+    verbose  => 0,
+    loggers  => ['Test::Logger::Capture'],
+);
+
+sub fake_env {
+    open( my $errors, '>', \my $written ) or die "Cannot open a scalar: $!";
+    return ( { 'psgi.errors' => $errors }, \$written );
+}
+
+# TPSGI builds its log once per process, so this has to run before anything
+# else here builds it: a logger that will not load is only a failure the first
+# time.
+subtest 'cannot_start, when building the log is what failed' => sub {
+    my ( $env, $written ) = fake_env();
+    my $res;
+    ok( lives { $res = TPSGI::cannot_start( "Could not load Bogus.pm!\n", $env, %options, loggers => ['Bogus::Logger::That::Is::Not'] ) },
+        'a logger that will not load does not turn the 500 into an exception' )
+      or note $@;
+    is( $res->[0], 500, 'it still answers 500' );
+    like( $$written, qr/Could not load Bogus\.pm/, 'and psgi.errors still gets the reason' );
+};
+
+subtest 'cannot_start' => sub {
+    local @Test::Logger::Capture::lines;
+    my ( $env, $written ) = fake_env();
+
+    my $res = TPSGI::cannot_start( "Could not load Bogus.pm!\nCan't locate Bogus/Dep.pm in \@INC\n", $env, %options );
+    is( $res->[0], 500, 'answers 500' );
+    like( $$written,                       qr/Can't locate Bogus\/Dep\.pm/,                     'psgi.errors gets the whole reason' );
+    like( \@Test::Logger::Capture::lines, bag { item qr/Could not start: Could not load Bogus\.pm!\nCan't locate/; etc() }, 'and so does the log' );
+
+    ok( lives { TPSGI::cannot_start( "no env\n", undef, %options ) }, 'a missing env is not a second failure' ) or note $@;
+};
+
+subtest 'app, when the request dies' => sub {
+    local @Test::Logger::Capture::lines;
+    my ( $env, $written ) = fake_env();
+
+    my $mock = Test::MockModule->new( 'TPSGI', no_auto => 1 );
+    $mock->redefine( _app => sub { die "Can't locate Bogus/Dep.pm in \@INC\n" } );
+
+    my $tpsgi = bless( { %options, ip => '0.0.0.0' }, 'TPSGI' );
+    my $res   = $tpsgi->app($env);
+
+    is( $res->[0], 500, 'answers 500' );
+    like( $$written,                       qr/Can't locate Bogus\/Dep\.pm/,                                'psgi.errors gets the reason' );
+    like( \@Test::Logger::Capture::lines, bag { item qr/Request failed: Can't locate Bogus\/Dep\.pm/; etc() }, 'and so does the log, not just that a 500 happened' );
+};
+
+done_testing();