FU::Log: Add logger and basic integration with FU
This commit is contained in:
Yorhel
parent
6f1583ddad
commit
a5f9584b02
3 changed files with 178 additions and 7 deletions
52
FU.pm
52
FU.pm
|
|
@ -2,7 +2,9 @@ package FU 0.1;
|
|||
use v5.36;
|
||||
use Carp 'confess', 'croak';
|
||||
use IO::Socket;
|
||||
use POSIX;
|
||||
use POSIX ();
|
||||
use Time::HiRes 'time';
|
||||
use FU::Log 'log_write';
|
||||
use FU::Util;
|
||||
|
||||
|
||||
|
|
@ -21,6 +23,12 @@ our $REQ = {}; # Internal request-local data
|
|||
our $fu = bless {}, 'FU::obj'; # App request-local data
|
||||
sub fu() { $fu }
|
||||
|
||||
FU::Log::capture_warn(1);
|
||||
FU::Log::set_fmt(sub($msg) {
|
||||
FU::Log::default_fmt($msg,
|
||||
fu->path && fu->method ? fu->method.' '.fu->path.(fu->query?'?'.fu->query:'') : '[init]',
|
||||
);
|
||||
});
|
||||
|
||||
sub debug { state $v = 0; $v = $_[0] if @_; $v }
|
||||
sub log_slow_pages { state $v = 0; $v = $_[0] if @_; $v }
|
||||
|
|
@ -235,7 +243,8 @@ sub _read_req($c) {
|
|||
# All other errors suggest a misconfigured web server, anyway.
|
||||
if ($r == -6) { fu->error(400, 'Client disconnect before request was read') }
|
||||
elsif ($r) {
|
||||
warn $r == -1 ? "Unexpected EOF while reading from FastCGI socket\n"
|
||||
log_write
|
||||
$r == -1 ? "Unexpected EOF while reading from FastCGI socket\n"
|
||||
: $r == -2 ? "I/O error while reading from FastCGI socket\n"
|
||||
: $r == -3 ? "FastCGI protocol error\n"
|
||||
: $r == -4 ? "Too long FastCGI parameter\n"
|
||||
|
|
@ -246,6 +255,9 @@ sub _read_req($c) {
|
|||
fu->error(400, 'Invalid request') if !$REQ->{method} || $REQ->{method} !~ /^$method_re$/ || !$REQ->{path};
|
||||
} else {
|
||||
_read_req_http($c->{client_sock}, $REQ);
|
||||
|
||||
# Silly hack to clear ${^LAST_FH}, removes the "at <GEN#> line $n" from warn()
|
||||
open my $bullshit, '<', \"\n"; <$bullshit>;
|
||||
}
|
||||
|
||||
# The HTTP reader above and the FastCGI XS reader operate on bytes.
|
||||
|
|
@ -264,7 +276,16 @@ sub _is_done($e) { ref $@ eq 'FU::err' && $@->[0] == 200 }
|
|||
sub _log_err($e) {
|
||||
return if !$e;
|
||||
return if !debug && ref $@ eq 'FU::err' && $@->[0] != 500;
|
||||
warn $e =~ /\n$/ ? $e : "$e\n";
|
||||
if (!$REQ->{full_err} && (ref $@ ne 'FU::err' || $@->[0] == 500)) {
|
||||
$REQ->{full_err}++;
|
||||
log_write join "\n",
|
||||
'IP: '.($REQ->{ip}||'-'),
|
||||
'Headers:', (map " $_: $REQ->{hdr}{$_}", sort keys $REQ->{hdr}->%*),
|
||||
'ERROR:', $e =~ s/(^|\n)/ /rg;
|
||||
# TODO: decoded body, if we have that.
|
||||
} else {
|
||||
log_write $e;
|
||||
}
|
||||
}
|
||||
|
||||
sub _do_req($c) {
|
||||
|
|
@ -276,6 +297,7 @@ sub _do_req($c) {
|
|||
|
||||
my $ok = eval {
|
||||
_read_req $c;
|
||||
$REQ->{trace_start} = time;
|
||||
|
||||
for my $h (@before_request) { $h->() }
|
||||
|
||||
|
|
@ -318,7 +340,15 @@ sub _do_req($c) {
|
|||
} || _err_500();
|
||||
}
|
||||
|
||||
$REQ->{trace_end} = time;
|
||||
fu->_flush($c->{fcgi_obj} || $c->{client_sock});
|
||||
|
||||
my $proc_ms = (time - $REQ->{trace_start}) * 1000;
|
||||
log_write(sprintf "%.0fms %s-%s %s-%d\n", $proc_ms,
|
||||
$REQ->{status}, ($REQ->{reshdr}{'content-type'}//'-') =~ s/;.+$//r,
|
||||
$REQ->{reshdr}{'content-encoding'}//'bytes', length($REQ->{resbody}),
|
||||
# TODO: SQL timings
|
||||
) if FU::debug || $proc_ms > (FU::log_slow_pages||1e10);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -338,7 +368,7 @@ sub _run_loop($c) {
|
|||
$c->{fcgi_obj} ||= $c->{listen_proto} eq 'fcgi' && FU::fcgi::new(fileno $c->{client_sock}, $c->{proc});
|
||||
|
||||
if ($c->{monitor} && _monitor) {
|
||||
warn "File change detected, restarting process.\n" if debug;
|
||||
log_write "File change detected, restarting process.\n" if debug;
|
||||
passclient;
|
||||
}
|
||||
|
||||
|
|
@ -384,7 +414,7 @@ sub _supervisor($c) {
|
|||
$err = 1 if POSIX::WIFEXITED($?) && POSIX::WEXITSTATUS($?) != 0;
|
||||
if (!$err && (!$childs{$pid} || $childs{$pid} != 2)) {
|
||||
$err = 1;
|
||||
warn "Script exited before calling FU::run()\n";
|
||||
log_write "Script exited before calling FU::run()\n";
|
||||
}
|
||||
delete $childs{$pid};
|
||||
}
|
||||
|
|
@ -459,7 +489,9 @@ sub _spawn {
|
|||
$c{max_reqs} = $1 if /^--max-reqs=([0-9]+)$/;
|
||||
debug 1 if /^--debug$/;
|
||||
debug 0 if /^--no-debug$/;
|
||||
$ENV{FU_LOG_FILE} = $1 if /^--log-file=(.+)$/;
|
||||
}
|
||||
FU::Log::set_file($ENV{FU_LOG_FILE}) if $ENV{FU_LOG_FILE};
|
||||
};
|
||||
|
||||
# Single process, no need for a supervisor
|
||||
|
|
@ -493,7 +525,7 @@ sub _spawn {
|
|||
LocalAddr => $addr,
|
||||
)
|
||||
) or die "Unable to create listen socket: $!\n";
|
||||
print "Listening on $addr\n" if debug;
|
||||
log_write "Listening on $addr\n" if debug;
|
||||
}
|
||||
|
||||
if ($need_supervisor) {
|
||||
|
|
@ -753,6 +785,8 @@ standalone and can be used independently of the framework:
|
|||
|
||||
=item * L<FU::XMLWriter> - Dynamic XML generation, easy and fast.
|
||||
|
||||
=item * L<FU::Log> - Global logger.
|
||||
|
||||
=back
|
||||
|
||||
Note that everything in this distribution requires a moderately recent version
|
||||
|
|
@ -944,6 +978,12 @@ and then can never hurt.
|
|||
|
||||
Set the initial value for C<FU::debug>.
|
||||
|
||||
=item FU_LOG_FILE=path
|
||||
|
||||
=item --log-file=path
|
||||
|
||||
Set the initial value for C<FU::Log::set_file()>.
|
||||
|
||||
=item LISTEN_FD=num
|
||||
|
||||
=item LISTEN_PROTO=http/fcgi
|
||||
|
|
|
|||
132
FU/Log.pm
Normal file
132
FU/Log.pm
Normal file
|
|
@ -0,0 +1,132 @@
|
|||
package FU::Log 0.1;
|
||||
use v5.36;
|
||||
use Exporter 'import';
|
||||
use POSIX 'strftime';
|
||||
|
||||
our @EXPORT_OK = ('log_write');
|
||||
|
||||
my $dest = [\*STDERR];
|
||||
my $capture_warn = 0;
|
||||
my $fmt = \&default_fmt;
|
||||
our $in_log = 0;
|
||||
|
||||
sub default_fmt($msg, @extra) {
|
||||
my $pre = '';
|
||||
if ($msg =~ /\n/) {
|
||||
$msg =~ s/(^|\n)/\n# /g;
|
||||
$msg .= "\n";
|
||||
$pre = "\n";
|
||||
} else {
|
||||
$msg = " # $msg";
|
||||
}
|
||||
sprintf "%s%sZ%s%s\n", $pre, strftime('%Y-%m-%d %H:%M:%S', gmtime), join('', map " $_", @extra), $msg
|
||||
}
|
||||
|
||||
sub log_write($msg) {
|
||||
local $SIG{__WARN__} = undef if $capture_warn;
|
||||
|
||||
chomp $msg;
|
||||
my $line = (!$in_log && eval {
|
||||
local $in_log = 1;
|
||||
$fmt->($msg)
|
||||
}) || default_fmt($msg);
|
||||
utf8::encode($line);
|
||||
|
||||
for my $out (@$dest) {
|
||||
if (ref $out eq 'GLOB') {
|
||||
print $out $line;
|
||||
} elsif (open my $F, '>>', $out) {
|
||||
flock $F, 2;
|
||||
seek $F, 0, 2;
|
||||
print $F $line;
|
||||
flock $F, 4;
|
||||
close $F;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub capture_warn($enabled) {
|
||||
$capture_warn = !!$enabled;
|
||||
$SIG{__WARN__} = $enabled ? sub { log_write($_) for @_ } : undef;
|
||||
}
|
||||
|
||||
sub set_fmt :prototype(&) ($f) { $fmt = $f || \&default_fmt }
|
||||
|
||||
sub set_file($path) {
|
||||
$dest = !defined $path ? [\*STDERR] :
|
||||
[ $path ne '-' && -t STDERR ? \*STDERR : (), $path eq '-' ? \*STDOUT : $path ];
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
FU::Log - Extremely Basic Process-Wide Logging Infrastructure
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use FU::Log 'log_write';
|
||||
|
||||
FU::Log::capture_warn(1);
|
||||
FU::Log::set_file('/var/log/mylog.log');
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module doesn't do a whole lot. Its main purpose is to have a
|
||||
centrally-configured logging facility so that modules can log stuff and an
|
||||
application can configure where those logs should end up.
|
||||
|
||||
There's no log levels or filtering; the I<what> to log question is better
|
||||
answered with separate configuration options per module. There's no OO-style
|
||||
interface either; the entire point of this module is that it only handles
|
||||
process-global logging. This module mainly exists for users of the L<FU>
|
||||
framework.
|
||||
|
||||
=head2 Configuration
|
||||
|
||||
=over
|
||||
|
||||
=item FU::Log::set_file($path)
|
||||
|
||||
Set the path to write logs to.
|
||||
|
||||
If no path is configured or if C<$path> is C<undef>, logs are written to
|
||||
C<STDERR>. If C<$path> is C<->, logs are written to C<STDOUT>.
|
||||
|
||||
When writing to file, logs are still replicated to C<STDERR> if that is a TTY.
|
||||
|
||||
=item FU::Log::capture_warn($enabled)
|
||||
|
||||
Whether to capture Perl C<warn> messages.
|
||||
|
||||
=item FU::Log::set_fmt($sub)
|
||||
|
||||
Subroutine to call to format the log messages. Is given a log message as
|
||||
Unicode string as first argument and should return a formatted Unicode string.
|
||||
|
||||
The given message may include newlines, it is up to the formatting function to
|
||||
decide how to log that.
|
||||
|
||||
This function is not called when inside C<log_write()>, the default log format
|
||||
is then used instead. This is to avoid recursion.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Exportable function
|
||||
|
||||
=over
|
||||
|
||||
=item log_write($msg)
|
||||
|
||||
Write a message to the log.
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
MIT.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Yorhel <projects@yorhel.nl>
|
||||
|
|
@ -18,7 +18,6 @@ Things that may or may not happen:
|
|||
|
||||
- FU::JSON - JSON::{XS,PP,etc}-compatible wrapper around FU::Util's JSON functions? I prolly won't need this myself, but could be handy.
|
||||
- FU::DBI - DBI wrapper with a FU::Pg-like API, for easier integration into FU.
|
||||
- FU::Log - Basic logger.
|
||||
- FU::Validate - TUWF::Validate & normalization with some improvements.
|
||||
- FU::Mailer - Simple sendmail wrapper
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue