hlog.pl
changeset 27 b378b5a3ca86
parent 25 4fb7b2a136d3
child 30 08f9f9d14aec
--- /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