--- 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<FILES> 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<lines>
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