# HG changeset patch # User Heiko Schlittermann # Date 1233248258 -3600 # Node ID b378b5a3ca863b35aafa12fec9f2e078de6c290f # Parent 6c7fed815e4f9e5699add53f7332681268b6dd3a 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. diff -r 6c7fed815e4f -r b378b5a3ca86 Makefile --- 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 $< $@ diff -r 6c7fed815e4f -r b378b5a3ca86 hlog --- 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 . -# -# 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 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