From a5f9584b02d29e921c75fda09fc262f8e20f40f5 Mon Sep 17 00:00:00 2001 From: Yorhel Date: Fri, 21 Feb 2025 16:57:10 +0100 Subject: [PATCH] FU::Log: Add logger and basic integration with FU --- FU.pm | 52 ++++++++++++++++++--- FU/Log.pm | 132 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ README.md | 1 - 3 files changed, 178 insertions(+), 7 deletions(-) create mode 100644 FU/Log.pm diff --git a/FU.pm b/FU.pm index 498d5cf..b490b37 100644 --- a/FU.pm +++ b/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 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 - Dynamic XML generation, easy and fast. +=item * L - 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. +=item FU_LOG_FILE=path + +=item --log-file=path + +Set the initial value for C. + =item LISTEN_FD=num =item LISTEN_PROTO=http/fcgi diff --git a/FU/Log.pm b/FU/Log.pm new file mode 100644 index 0000000..fce9b71 --- /dev/null +++ b/FU/Log.pm @@ -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 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 +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, logs are written to +C. If C<$path> is C<->, logs are written to C. + +When writing to file, logs are still replicated to C if that is a TTY. + +=item FU::Log::capture_warn($enabled) + +Whether to capture Perl C 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, 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 diff --git a/README.md b/README.md index 42b4bc6..4cabcec 100644 --- a/README.md +++ b/README.md @@ -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