hlog: comparison hlog.pl

equal deleted inserted replaced

-:754393593d11
+:29532c7f9629
 #    Heiko Schlittermann <hs@schlittermann.de>
 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;
+use Cwd qw(abs_path getcwd);
+use Authen::Simple::Passwd;
-my $opt_addr   = "0.0.0.0";
+use MIME::Base64 qw(decode_base64);
-my $opt_port   = 8080;
+use IO::Socket::INET;
-my $opt_lines  = 10;
+use IO::Socket::SSL;
-my $opt_daemon = 1;
-my $opt_kill   = 0;
 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 $rundir = ["/var/run/$ME", "$ENV{HOME}/.$ME"];
-my $logdir = [ "/var/log/$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(@);
 sub log_open($);
 sub http($@);
 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) },
+"help" => sub { pod2usage(-verbose => 1, -exitval => 0) },
-"man"     => sub { pod2usage(-verbose => 2, -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;
 log_open($access);
 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 = 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";
 if ($opt_daemon) {
 # 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";
 if (defined $pidfile) {
 open(PID, ">$pidfile")
 or die "Can't open $pidfile: $!\n";
 print PID "$$\n";
+$masterpid = $$;
 close PID;
 }
 $SIG{CHLD} = sub {
 while (waitpid(-1, WNOHANG) > 0) {
 my $pid = fork();
 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) {
 rename $access, "$access.1";
 log_open($access);
 }
 sub handle_request($) {
 my $client = shift;
 local $_ = <$client>;
-# should be HTTP/x.x
+# should be HTTP(S)/x.x
-if (not s/\s+HTTP\/\S+\s*$//) {
+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);
 }
 # 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
+my $authenticated = defined $opt_auth ? 0 : 1;
-while (<$client>) { last if /^\s*$/ }
+### $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",
 "Sorry, unknown file tag \"$tag\"");
 log_write("unknown tag $tag");
 }
 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 ;-)
 # see https://keller.schlittermann.de/hg/hlog
 #
 seek($r{fh}, 0, 0);
 return %r;
 }
 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";
 return <<__EOF, @_;
 HTTP/1.1 $code
 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] ],
+qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) [$now[4]],
-$now[5] + 1900, @now[ 2, 1, 0 ];
+$now[5] + 1900, @now[2, 1, 0];
 }
 sub bad_request() {
 return <<'__EOF';
 <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
 </p>
 </body></html>
 __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
 hlog - simple http server providing access to some logfile
 =head1 SYNOPSIS
 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]
 =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.
 =head1 OPTIONS
 =item B<-a>|B<--address> I<address>
 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>
-The number of lines to show. (default: 10)
+Do (or do not) print debug information to STDOUT/ERR and logfile. (default: dont)
+=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
 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.
+=head1 BUGS / TODO
+No known bugs.
 =cut

changeset 49	29532c7f9629
parent 48	2d6cb4466fb6
child 53	807117b2de7e
child 58	3f0838843487