diff -r 6c7fed815e4f -r b378b5a3ca86 hlog.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hlog.pl Thu Jan 29 17:57:38 2009 +0100 @@ -0,0 +1,441 @@ +#! /usr/bin/perl + +# HTTP access to some (log) file +# Copyright (C) 2009 Heiko Schlittermann +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +# +# Heiko Schlittermann + +use strict; +use warnings; +use Getopt::Long; +use IO::Socket::INET; +use Pod::Usage; +use File::Basename; +use POSIX qw(:sys_wait_h setsid); +use Cwd; + +my $opt_addr = "0.0.0.0"; +my $opt_port = 8080; +my $opt_lines = 10; +my $opt_daemon = 1; +my $opt_kill = 0; + +my $ME = basename $0; + +# these vars will be filled with the real dirs later +my $rundir = [ "/var/run/$ME", "$ENV{HOME}/.$ME" ]; +my $logdir = [ "/var/log/$ME", "$ENV{HOME}/.$ME" ]; + +my $maxlogsize = 1000_000_000; # ca 1 MByte +my $killtimeout = 3; + +# these are refs to detect if they're converted already +my $access = \"%s/access.log"; +my $errors = \"%s/error.log"; +my $pidfile = \"%s/%s.%s.pid"; # %dir/%ip.%port + +END { + unlink $pidfile + if defined $pidfile and not ref $pidfile; +} + +sub find_writable_dir(@); + +sub log_open($); +sub log_write($); + +sub handle_request($); +sub http($@); + +sub bad_request(); +sub date1123(;$); + +my %FILE; + +MAIN: { + + GetOptions( + "addr=s" => \$opt_addr, + "port=i" => \$opt_port, + "lines=i" => \$opt_lines, + "daemon!" => \$opt_daemon, + "kill" => \$opt_kill, + "help" => sub { pod2usage(-verbose => 1, -exitval => 0) }, + "man" => sub { pod2usage(-verbose => 2, -exitval => 0) }, + ) or pod2usage(); + + if (defined($logdir = find_writable_dir(@$logdir))) { + $access = sprintf $$access, $logdir; + $errors = sprintf $$errors, $logdir; + log_open($access); + } + + if (defined($rundir = find_writable_dir(@$rundir))) { + + # santize hostname + (my $host = $opt_addr) =~ s/([^\w.-])/sprintf "%%%02X", ord($1)/gie; + $pidfile = sprintf $$pidfile, $rundir, $host, $opt_port,; + } + else { $pidfile = undef } + + if ($opt_kill) { + warn "Killing process on $opt_addr:$opt_port\n"; + open(my $p, $pidfile) or die "Can't open $pidfile: $!\n"; + defined($_ = <$p>) or die "no pid found in $pidfile\n"; + chomp; + kill -15 => $_ or die "Can't kill pid $_: $!\n"; + + # we can't wait, it's not our process group, so we've to poll + eval { + $SIG{ALRM} = sub { die "TIMEOUT\n" }; + alarm($killtimeout); + for (my $sleep = 1 ; kill -0 => $_ ; $sleep++) { + sleep($sleep > 10 ? 10 : $sleep); + } + alarm(0); + }; + if ($@ eq "TIMEOUT\n") { + warn "Child $_ didn't respond. Using violence.\n"; + kill -9 => $_; + } + exit 0; + } + + pod2usage() if not @ARGV; + + # resolve tags and filenames + foreach (@ARGV) { + $_ = "default=$_" if not /=/ or /^\//; + my ($tag, $file) = split /=/, $_, 2; + die "tag $tag already exists with file $FILE{$tag}\n" + if exists $FILE{$tag}; + $file = getcwd() . "/$file" if $file !~ /^\//; + $FILE{$tag} = $file; + } + + # start the listener + my $listener = new IO::Socket::INET( + LocalAddr => $opt_addr, + LocalPort => $opt_port, + Proto => "tcp", + Listen => 1, + ReuseAddr => 1, + ) or die "Can't create listener socket: $!\n"; + + # go daemon + chdir("/") or die "Can't chdir to /: $!\n"; + + if ($opt_daemon) { + + defined(my $pid = fork()) or die "Can't fork: $!\n"; + + # parent + if ($pid) { + print "listener $pid " + . $listener->sockhost . ":" + . $listener->sockport . "\n"; + undef $pidfile; + exit 0; + } + + # child + setsid() or die "Can't start a new session: $!\n"; + open(STDIN, "/dev/null") or die "Can't read /dev/null: $!\n"; + open(STDOUT, ">/dev/null") or die "Can't write to /dev/null: $!\n"; + + if (defined $logdir) { + open(STDERR, $_ = ">>$errors") or warn "Can't open $_: $!\n"; + } + else { + open(STDERR, ">&STDOUT") or die "Can't dup stdout: $!\n"; + } + + } + + $SIG{INT} = $SIG{TERM} = sub { warn "Got signal $_[0]\n"; exit 0 }; + $SIG{__WARN__} = sub { print STDERR localtime() . " ", @_ }; + $SIG{__DIE__} = sub { print STDERR @_; exit $? }; + + if (defined $pidfile) { + open(PID, ">$pidfile") + or die "Can't open $pidfile: $!\n"; + + print PID "$$\n"; + close PID; + } + + $SIG{CHLD} = sub { + while (waitpid(-1, WNOHANG) > 0) { + } + }; + + while (1) { + my $client = $listener->accept; + next if not defined $client; # may be because of signal + + my $pid = fork(); + die "Can't fork: $!\n" if not defined $pid; + if ($pid == 0) { + $SIG{CHLD} = "DEFAULT"; + $listener->close; + handle_request($client); + exit 0; + } + $client->close; + + # maintenance of logfiles + if (-s $access > $maxlogsize) { + rename $access, "$access.1"; + log_open($access); + } + + if (-s $errors > $maxlogsize) { + rename $errors, "$errors.1"; + open(STDERR, ">>$errors"); + } + } + +} + +sub find_writable_dir(@) { + foreach (@_) { + return $_ if -d and -w _; + return $_ if mkdir $_, 0755; + } + return undef; +} + +{ + my $fh; + + sub log_open($) { + open($fh, $_ = ">>$_[0]") or die "Can't open $_: $!\n"; + } + + sub log_write($) { + $fh->print(localtime() . " $_[0]\n") + if defined $fh; + } + +} + +sub handle_request($) { + my $client = shift; + local $_ = <$client>; + + # should be HTTP/x.x + if (not s/\s+HTTP\/\S+\s*$//) { + $client->print(bad_request); + return; + } + + # should be a GET request + if (not s/GET\s+//) { + $client->print(http "400 Bad Request" => bad_request); + } + + # number of lines and tag to show + my $lines = (s/(\d+)$// ? $1 : $opt_lines); + my $tag = (s/^\/*(\w+)// ? $1 : "default"); + + # read the header(s) and discard + while (<$client>) { last if /^\s*$/ } + + if (not exists $FILE{$tag}) { + $client->print(http "500 unknown file tag", + "Sorry, unknown file tag \"$tag\""); + log_write("unknown tag $tag"); + return; + } + + my %file = analyze($FILE{$tag}); + if (!%file) { + $client->print(http "500 internal error", "internal error"); + return; + } + + log_write($client->peerhost . ":" . $client->peerport . " $tag ($lines)"); + + seek($file{fh}, -($lines + 1) * $file{avglen}, 2); + $file{fh}->getline; + + $client->print(http "200 OK" => join "", <<__EOF, $file{fh}->getlines); +# Proof of concept ;-) +# see https://keller.schlittermann.de/hg/hlog +# +# FILE: @{[sprintf "%s", $file{name}]} +# LENGTH: @{[sprintf "%5d", $file{size}]} +# LINES: @{[sprintf "%5d approx", $file{lines}]} +# LENGTH: @{[sprintf "%5d approx", $file{avglen}]} +# DISPLAY: @{[sprintf "%5d approx", $lines]} +# +# append ? to your request to select the number of displayed +# lines +# +__EOF + +} + +sub analyze($) { + my %r; + $r{name} = shift; + $r{size} = -s $r{name}; + open($r{fh}, $r{name}) or do { + $@ = "Can't open $r{name}: $!\n"; + return (); + }; + + if ($r{size} == 0) { + $r{lines} = 0; + } + else { + my $s; + while (defined($_ = $r{fh}->getline)) { + $s += length; + last if $. == 100; + } + $r{avglen} = $s / $.; + $r{lines} = int($r{size} / $r{avglen}); + } + + seek($r{fh}, 0, 0); + return %r; +} + +sub http($@) { + my $code = shift; + my $date = date1123(); + + my $type = $_[0] =~ /^ + +400 Bad Request + +

Bad Request

+

Your browser sent a request that this server could not understand.
+

+ +__EOF +} + +__END__ + +=head1 NAME + +hlog - simple http server providing access to some logfile + +=head1 SYNOPSIS + + hlog [--[no]daemon] + [-k|--kill] + [-a|--address address] [-p|--port port] + [--lines n] + {file|tag=file ...} + + hlog [-h|--help] [-m|--man] + +=head1 DESCRIPTION + +This script should run as a server providing access to +the last lines of a logfile. It should understand basic HTTP/1.x. + +See the L section for more information on files. + +=head1 OPTIONS + +=over + +=item B<-a>|B<--address> I
+ +The address to listen on. (default: 0.0.0.0) + +=item B<--[no]daemon> + +Do (or do not) daemonize. (default: do) + +=item B<--lines> I + +The number of lines to show. (default: 10) + +=item B<-k>|B<--kill> + +With this option the corresponding (address/port) process gets killed. +(default: off) + +=item B<-p>|B<--port> I + +The port to listen on. (default: 8080) + +=back + +=head1 EXAMPLES + +Using tags makes it possible to access more then one log file +via the same running instance by specifying the tag in the URL. + +Once started as: + + hlog error=/var/log/apache/error.log access=/var/log/apache/access.log + +The following URLs are valid: + + http://:8080/error + http://:8080/access?10 + +=head1 FILES + +The B tool tries to create several files + +=head2 F and F + +These files will be written to F or F<$HOME/.hlog/> if +possible. The mentioned directories (the leave part) will be created, if +possible. It is no fatal error if B fails on this. + +=head2 PID file + +B tries to create a pid file in F or +F<$HOME/.hlog>. It even tries to create the leave part the directory. +Failing on this it not fatal, but then the B<--kill> option will not +work! + +The pid file will be named according to the hostname (see B<--address>) +beeing used. For safety the hostname will be sanitized to avoid +dangerous filenames. + +=cut