hlog: comparison hlog.pl

equal deleted inserted replaced

-:8f0cb57a65d9
+:5265573638b2
 #    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_addr     = "0.0.0.0";
-my $opt_port   = 8080;
+my $opt_port     = 8080;
-my $opt_lines  = 10;
+my $opt_lines    = 10;
-my $opt_daemon = 1;
+my $opt_daemon   = 1;
-my $opt_kill   = 0;
+my $opt_kill     = 0;
+my $opt_debug    = 0;
+my $opt_ssl      = 1;
+my $opt_ssl_cert = "crt.pem";
+my $opt_ssl_key  = "key.pem";
 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 $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
+# 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;
+# attempt to generalize some interface differences between
+# IO::Socket::{INET,SSL}; currently we need to pass an SSL specific argument
+# when closing an SSL Socket to avoid affecting the socket in
+# parent(s)/children; passing unknown arguments to the 'close' method of non
+# SSL Sockets would result in an runtime error; error reporting is also done
+# differently; note that you cant mix non/SSL Sockets since currently we
+# achieve it by modifying @ISA which is a class variable in the constructor;
+# the right thing to do would probably be to use IO::Socket::SSL for non SSL
+# Sockets too -> TODO: how? ;)
+package IO::Socket::hlog;
+use IO::Socket::INET;
+use IO::Socket::SSL;
+our (@ISA, $DEBUG);
+sub new {
+my $class = shift;
+my %args = @_;
+my $ssl = delete $args{SSL};
+if ($ssl) {
+@ISA = qw(IO::Socket::SSL);
+$IO::Socket::SSL::DEBUG = $DEBUG ? 3 : 0;
+} else {
+%args = _delete_ssl_args(%args);
+@ISA = qw(IO::Socket::INET);
+}
+my $self;
+unless ($self = $class->SUPER::new(%args)) {
+return;
+}
+print "$class: $self created\n" if $DEBUG;
+return $self;
+}
+sub close {
+my $self = shift;
+print "$self: closing\n" if $DEBUG;
+my %args = @_;
+%args = _delete_ssl_args(%args) unless $self->_is_ssl;
+return $self->SUPER::close(%args);
+}
+sub errstr {
+return IO::Socket::SSL::errstr if _is_ssl();
+return $@;
+}
+sub _delete_ssl_args {
+my %args = @_;
+map { delete $args{$_} if /^SSL/; } keys %args;
+return %args;
+}
+sub _is_ssl {
+my $self = shift;
+return $ISA[0] eq "IO::Socket::SSL";
+}
+package main;
 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($);
 my %FILE;
 MAIN: {
 GetOptions(
-"addr=s"  => \$opt_addr,
+"addr=s"     => \$opt_addr,
-"port=i"  => \$opt_port,
+"port=i"     => \$opt_port,
-"lines=i" => \$opt_lines,
+"lines=i"    => \$opt_lines,
-"daemon!" => \$opt_daemon,
+"daemon!"    => \$opt_daemon,
-"kill"    => \$opt_kill,
+"debug!"     => \$opt_debug,
-"help"    => sub { pod2usage(-verbose => 1, -exitval => 0) },
+"kill"       => \$opt_kill,
-"man"     => sub { pod2usage(-verbose => 2, -exitval => 0) },
+"help"       => sub { pod2usage(-verbose => 1, -exitval => 0) },
+"man"        => sub { pod2usage(-verbose => 2, -exitval => 0) },
+"ssl!"       => \$opt_ssl,
+"ssl-cert=s" => \$opt_ssl_cert,
+"ssl-key=s"  => \$opt_ssl_key
 ) or pod2usage();
+$IO::Socket::hlog::DEBUG = $opt_debug;
 if (defined($logdir = find_writable_dir(@$logdir))) {
 $access = sprintf $$access, $logdir;
 $errors = sprintf $$errors, $logdir;
 log_open($access);
 $file = getcwd() . "/$file" if $file !~ /^\//;
 $FILE{$tag} = $file;
 }
 # start the listener
-my $listener = new IO::Socket::INET(
+my $listener = new IO::Socket::hlog(
-LocalAddr => $opt_addr,
+LocalAddr     => $opt_addr,
-LocalPort => $opt_port,
+LocalPort     => $opt_port,
-Proto     => "tcp",
+Proto         => "tcp",
-Listen    => 1,
+Listen        => 1,
-ReuseAddr => 1,
+ReuseAddr     => 1,
-) or die "Can't create listener socket: $!\n";
+SSL           => $opt_ssl,
+SSL_key_file  => $opt_ssl_key,
+SSL_cert_file => $opt_ssl_cert,
+debug         => $opt_debug
+) or die "Can't create listener socket: ", IO::Socket::hlog::errstr, "\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;
+print("listener $listener\n") if $opt_debug;
+$listener->close(SSL_no_shutdown => 1);
 handle_request($client);
 exit 0;
 }
-$client->close;
+print("client $client\n") if $opt_debug;
+$client->close(SSL_no_shutdown => 1);
 # 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);
 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]
+[--[no]ssl]
+[--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 should understand basic HTTP(S)/1.x.
 See the L<FILES> section for more information on files.
 =head1 OPTIONS
 The address to listen on. (default: 0.0.0.0)
 =item B<--[no]daemon>
 Do (or do not) daemonize. (default: do)
+=item B<--[no]debug>
+Do (or do not) print debug information to STDOUT/ERR and logfile. (default: dont)
 =item B<--lines> I<lines>
 The number of lines to show. (default: 10)
 (default: off)
 =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)
+=back
+=item B<--ssl-cert>
+Path to alternate ssl certificate file (default: crt.pem)
+=back
+=item B<--ssl-key>
+Path to alternate ssl private key file (default: key.pem)
 =back
 =head1 EXAMPLES
 beeing used. For safety the hostname will be sanitized to avoid
 dangerous filenames.
 =head1 BUGS / TODO
-This tool should understand HTTPS and basic HTTP authentication.
+This tool should understand basic HTTP authentication.
 =cut

branch	foerste
changeset 34	5265573638b2
parent 32	187167ae27e5
child 35	f237843486d2