Added "hlog" Makefile target.
authorHeiko Schlittermann <hs@schlittermann.de>
Thu, 29 Jan 2009 17:57:38 +0100
changeset 27 b378b5a3ca86
parent 26 6c7fed815e4f
child 28 0bdfabcda857
child 29 754393593d11
Added "hlog" Makefile target. This should install the hlog script with proper permissions, even for local use and even if after checkout the permissions are wrong.
Makefile
hlog
hlog.pl
--- a/Makefile	Thu Jan 29 15:06:24 2009 +0100
+++ b/Makefile	Thu Jan 29 17:57:38 2009 +0100
@@ -12,9 +12,9 @@
 MAN1 	= $(SCRIPT:=.1.gz)
 
 CLEANFILES \
-	= $(MAN1)
+	= $(MAN1) $(SCRIPT)
 
-all:		$(MAN1)
+all:		$(SCRIPT) $(MAN1)
 install:	all
 		# mandatory directories
 		install -m 0755 -d ${DESTDIR}${bindir}
@@ -30,5 +30,11 @@
 
 clean:		; -rm -f $(CLEANFILES)
 
-%.1.gz:	%	; pod2man $< | gzip >$@
+%.1.gz:		%	
+		# $< => $@
+		@pod2man $< | gzip >$@
 
+%:		%.pl
+		@perl -c $<
+		# $< => $@
+		@install -m 0555 $< $@
--- a/hlog	Thu Jan 29 15:06:24 2009 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,441 +0,0 @@
-#! /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
--- /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