--- /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 <http://www.gnu.org/licenses/>.
+#
+# Heiko Schlittermann <hs@schlittermann.de>
+
+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 ?<number> 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] =~ /^<!DOCTYPE HTML/ ? "text/html" : "text/plain";
+
+ return <<__EOF, @_;
+HTTP/1.1 $code
+Date: $date
+Connection: close
+Content-Type: $type
+
+__EOF
+}
+
+sub date1123(;$) {
+ my @now = gmtime(@_ ? shift : time);
+ sprintf "%s, %2d %s %4d %02d:%02d:%02d GMT",
+ qw(Sun Mon Tue Wed Thu Fri Sat Sun) [ $now[6] ],
+ $now[3],
+ qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) [ $now[4] ],
+ $now[5] + 1900, @now[ 2, 1, 0 ];
+}
+
+sub bad_request() {
+ return <<'__EOF';
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
+<html><head>
+<title>400 Bad Request</title>
+</head><body>
+<h1>Bad Request</h1>
+<p>Your browser sent a request that this server could not understand.<br
+/>
+</p>
+</body></html>
+__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<FILES> section for more information on files.
+
+=head1 OPTIONS
+
+=over
+
+=item B<-a>|B<--address> I<address>
+
+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<lines>
+
+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<port>
+
+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://<server>:8080/error
+ http://<server>:8080/access?10
+
+=head1 FILES
+
+The B<hlog> tool tries to create several files
+
+=head2 F<access.log> and F<error.log>
+
+These files will be written to F</var/log/hlog/> or F<$HOME/.hlog/> if
+possible. The mentioned directories (the leave part) will be created, if
+possible. It is no fatal error if B<hlog> fails on this.
+
+=head2 PID file
+
+B<hlog> tries to create a pid file in F</var/run/hlog/> 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