# HG changeset patch # User Matthias Förste # Date 1258984690 -3600 # Node ID 5265573638b2c07799733676fd89dc56053b20d5 # Parent 8f0cb57a65d9d3744fc066c1ea893f7febb378c7 added ssl support and related options; added debug option; stopped children from removing the pidfile; hgignored some files; diff -r 8f0cb57a65d9 -r 5265573638b2 .hgignore --- a/.hgignore Wed Oct 28 23:23:02 2009 +0100 +++ b/.hgignore Mon Nov 23 14:58:10 2009 +0100 @@ -1,1 +1,5 @@ -hlog.1.gz +syntax regexp: +^hlog\.1\.gz$ +^hlog$ +^t$ +^(key|crt)\.pem$ diff -r 8f0cb57a65d9 -r 5265573638b2 hlog.pl --- a/hlog.pl Wed Oct 28 23:23:02 2009 +0100 +++ b/hlog.pl Mon Nov 23 14:58:10 2009 +0100 @@ -21,17 +21,20 @@ 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 $opt_addr = "0.0.0.0"; +my $opt_port = 8080; +my $opt_lines = 10; +my $opt_daemon = 1; +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; @@ -39,7 +42,7 @@ 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 @@ -47,9 +50,101 @@ 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(@); @@ -68,15 +163,21 @@ 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) }, + "addr=s" => \$opt_addr, + "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) }, + "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; @@ -127,13 +228,18 @@ } # 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"; + my $listener = new IO::Socket::hlog( + LocalAddr => $opt_addr, + LocalPort => $opt_port, + Proto => "tcp", + Listen => 1, + ReuseAddr => 1, + 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"; @@ -147,7 +253,6 @@ print "listener $pid " . $listener->sockhost . ":" . $listener->sockport . "\n"; - undef $pidfile; exit 0; } @@ -174,6 +279,7 @@ or die "Can't open $pidfile: $!\n"; print PID "$$\n"; + $masterpid = $$; close PID; } @@ -190,11 +296,13 @@ 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) { @@ -236,14 +344,16 @@ 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); } @@ -361,10 +471,14 @@ =head1 SYNOPSIS - hlog [--[no]daemon] + 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] @@ -372,7 +486,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 should understand basic HTTP(S)/1.x. See the L section for more information on files. @@ -388,6 +502,10 @@ 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 The number of lines to show. (default: 10) @@ -401,6 +519,22 @@ 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 @@ -440,6 +574,6 @@ =head1 BUGS / TODO -This tool should understand HTTPS and basic HTTP authentication. +This tool should understand basic HTTP authentication. =cut