--- a/hlog.pl Thu Jan 29 17:58:15 2009 +0100
+++ b/hlog.pl Wed Dec 30 23:52:34 2009 +0100
@@ -21,35 +21,53 @@
use strict;
use warnings;
use Getopt::Long;
-use IO::Socket::INET;
use Pod::Usage;
use File::Basename;
+use if $ENV{DEBUG} => "Smart::Comments";
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;
+use Cwd qw(abs_path getcwd);
+use Authen::Simple::Passwd;
+use MIME::Base64 qw(decode_base64);
+use IO::Socket::INET;
+use IO::Socket::SSL;
my $ME = basename $0;
+my $opt_addr = "0.0.0.0";
+my $opt_auth = $ME;
+my $opt_port = 8080;
+my $opt_lines = 10;
+my $opt_daemon = 1;
+my $opt_kill = 0;
+my $opt_debug = 0;
+my $opt_htpasswd = "htpasswd";
+my $opt_ssl = 1;
+my $opt_ssl_cert = "crt.pem";
+my $opt_ssl_key = "key.pem";
+
# 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 $rundir = ["/var/run/$ME", "$ENV{HOME}/.$ME"];
+my $logdir = ["/var/log/$ME", "$ENV{HOME}/.$ME"];
-my $maxlogsize = 1000_000_000; # ca 1 MByte
+my $maxlogsize = 1_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
+my $pidfile = \"%s/%s.%s.pid"; # %dir/%ip.%port
+
+# remember the pid that is actually written to the pid file so we can ensure
+# that only the process with that pid is attempting to remove the pidfile at
+# exit
+my $masterpid;
END {
unlink $pidfile
- if defined $pidfile and not ref $pidfile;
+ if defined $pidfile
+ and not ref $pidfile
+ and defined $masterpid
+ and $masterpid == $$;
}
sub find_writable_dir(@);
@@ -63,20 +81,42 @@
sub bad_request();
sub date1123(;$);
+sub authenticated($$);
+
my %FILE;
MAIN: {
GetOptions(
- "addr=s" => \$opt_addr,
+ "addr=s" => \$opt_addr,
+ "auth:s" => sub { $opt_auth = $_[1] eq '' ? $ME : $_[1] },
+ "noauth" => sub { undef $opt_auth },
"port=i" => \$opt_port,
"lines=i" => \$opt_lines,
"daemon!" => \$opt_daemon,
+ "debug!" => \$opt_debug,
"kill" => \$opt_kill,
- "help" => sub { pod2usage(-verbose => 1, -exitval => 0) },
- "man" => sub { pod2usage(-verbose => 2, -exitval => 0) },
+ "help" => sub { pod2usage(-verbose => 1, -exitval => 0) },
+ "man" => sub { pod2usage(-verbose => 2, -exitval => 0) },
+ "htpasswd=s" => \$opt_htpasswd,
+ "ssl!" => \$opt_ssl,
+ "ssl-cert=s" => \$opt_ssl_cert,
+ "ssl-key=s" => \$opt_ssl_key
) or pod2usage();
+ if ($opt_kill) {
+ $opt_auth = 0;
+ $opt_ssl = 0;
+ }
+
+ foreach ($opt_htpasswd, $opt_ssl_key, $opt_ssl_cert) {
+ $_ = abs_path($_) if defined;
+ }
+
+ ### $opt_ssl_key
+ ### $opt_ssl_cert
+ ### $opt_auth
+
if (defined($logdir = find_writable_dir(@$logdir))) {
$access = sprintf $$access, $logdir;
$errors = sprintf $$errors, $logdir;
@@ -119,21 +159,24 @@
# 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 = abs_path($file);
$FILE{$tag} = $file;
}
- # start the listener
+ # Start the listener, just a normal INET socket,
+ # SSL will be started later on, if needed..
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";
+ ) or die "Can't create listener: $!\n";
# go daemon
chdir("/") or die "Can't chdir to /: $!\n";
@@ -147,7 +190,6 @@
print "listener $pid "
. $listener->sockhost . ":"
. $listener->sockport . "\n";
- undef $pidfile;
exit 0;
}
@@ -174,6 +216,7 @@
or die "Can't open $pidfile: $!\n";
print PID "$$\n";
+ $masterpid = $$;
close PID;
}
@@ -190,11 +233,20 @@
die "Can't fork: $!\n" if not defined $pid;
if ($pid == 0) {
$SIG{CHLD} = "DEFAULT";
- $listener->close;
+ $listener->close();
+ if ($opt_ssl) {
+ $client = IO::Socket::SSL->new_from_fd(
+ $client,
+ SSL_server => 1,
+ SSL_key_file => $opt_ssl_key,
+ SSL_cert_file => $opt_ssl_cert,
+ );
+ $client->start_SSL;
+ }
handle_request($client);
exit 0;
}
- $client->close;
+ $client->close();
# maintenance of logfiles
if (-s $access > $maxlogsize) {
@@ -234,16 +286,19 @@
sub handle_request($) {
my $client = shift;
+
local $_ = <$client>;
- # should be HTTP/x.x
- if (not s/\s+HTTP\/\S+\s*$//) {
+ # should be HTTP(S)/x.x
+ if (not s/\s+HTTPS?\/\S+\s*$//) {
+ log_write("Bad Request: $_") if $opt_debug;
$client->print(bad_request);
return;
}
# should be a GET request
if (not s/GET\s+//) {
+ log_write("Bad Request: $_") if $opt_debug;
$client->print(http "400 Bad Request" => bad_request);
}
@@ -251,8 +306,35 @@
my $lines = (s/(\d+)$// ? $1 : $opt_lines);
my $tag = (s/^\/*(\w+)// ? $1 : "default");
- # read the header(s) and discard
- while (<$client>) { last if /^\s*$/ }
+ my $authenticated = defined $opt_auth ? 0 : 1;
+ ### $authenticated
+
+ # read and verify (first) authentication header and discard any other headers
+ while (<$client>) {
+ last if /^\s*$/;
+ next if $authenticated;
+
+ if (/^Authorization:\s+Basic\s+([[:alnum:]+\/=]+)\r?$/) {
+ $authenticated = authenticate($opt_htpasswd => $1)
+ or log_write("authentication failure from " . $client->peerhost);
+ }
+
+ }
+ ### $authenticated
+
+ unless ($authenticated) {
+
+ $client->print(
+ http {
+ code => "401 Unauthorized",
+ headers =>
+ { "WWW-Authenticate" => "Basic realm=\"$opt_auth\"", }
+ },
+ "not authorized"
+ );
+ return;
+
+ }
if (not exists $FILE{$tag}) {
$client->print(http "500 unknown file tag",
@@ -270,7 +352,8 @@
log_write($client->peerhost . ":" . $client->peerport . " $tag ($lines)");
seek($file{fh}, -($lines + 1) * $file{avglen}, 2);
- $file{fh}->getline;
+
+ # warum das? $file{fh}->getline;
$client->print(http "200 OK" => join "", <<__EOF, $file{fh}->getlines);
# Proof of concept ;-)
@@ -316,8 +399,25 @@
}
sub http($@) {
- my $code = shift;
- my $date = date1123();
+
+ my ($headers, $code, $date) = ('');
+
+ if (ref $_[0] eq "HASH") {
+
+ my $h;
+ ($code, $date, $h) = @{ $_[0] }{ 'code', 'date', 'headers' };
+ $headers = (join "\n", map { "$_: $h->{$_}" } keys %{$h}) . "\n"
+ if defined $h;
+ shift;
+
+ }
+ else {
+
+ $code = shift;
+
+ }
+
+ $date ||= date1123();
my $type = $_[0] =~ /^<!DOCTYPE HTML/ ? "text/html" : "text/plain";
@@ -326,17 +426,17 @@
Date: $date
Connection: close
Content-Type: $type
-
+$headers
__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] ],
+ 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 ];
+ 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() {
@@ -353,6 +453,13 @@
__EOF
}
+sub authenticate($$) {
+ my ($htpasswd, $userinfo) = @_;
+ my $auth = new Authen::Simple::Passwd(path => $htpasswd)
+ or die "Can't open \"$htpasswd\": $!\n";
+ $auth->authenticate(split /:/, decode_base64($userinfo));
+}
+
__END__
=head1 NAME
@@ -361,10 +468,16 @@
=head1 SYNOPSIS
- hlog [--[no]daemon]
+ hlog [--[no]daemon]
+ [--[no]debug]
[-k|--kill]
[-a|--address address] [-p|--port port]
[--lines n]
+ [--htpasswd path]
+ [--[no]ssl]
+ [--auth=[realm] | --noauth]
+ [--ssl-cert path]
+ [--ssl-key path]
{file|tag=file ...}
hlog [-h|--help] [-m|--man]
@@ -372,7 +485,7 @@
=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.
+the last lines of a logfile. It understands basic HTTP(S)/1.x.
See the L<FILES> section for more information on files.
@@ -384,23 +497,48 @@
The address to listen on. (default: 0.0.0.0)
+=item B<--auth>[ I<realm>] | B<--noauth>
+
+Do (or do not) authorize all access. Optional you may pass the
+name of a authentication realm. (default: do, realm is hlog)
+
=item B<--[no]daemon>
Do (or do not) daemonize. (default: do)
-=item B<--lines> I<lines>
+=item B<--[no]debug>
+
+Do (or do not) print debug information to STDOUT/ERR and logfile. (default: dont)
-The number of lines to show. (default: 10)
+=item B<--htpasswd> I<path>
+
+Path to alternate htpasswd file (default: htpasswd).
=item B<-k>|B<--kill>
With this option the corresponding (address/port) process gets killed.
(default: off)
+=item B<--lines> I<lines>
+
+The number of lines to show. (default: 10)
+
=item B<-p>|B<--port> I<port>
The port to listen on. (default: 8080)
+=item B<--[no]ssl>
+
+Enable (or disable) https connections (default: enabled)
+
+=item B<--ssl-cert> I<path>
+
+Path to alternate ssl certificate file (default: crt.pem)
+
+=item B<--ssl-key> I<path>
+
+Path to alternate ssl private key file (default: key.pem)
+
=back
=head1 EXAMPLES
@@ -438,4 +576,8 @@
beeing used. For safety the hostname will be sanitized to avoid
dangerous filenames.
+=head1 BUGS / TODO
+
+No known bugs.
+
=cut