--- a/hlog.pl Wed Dec 30 22:15:36 2009 +0100
+++ b/hlog.pl Wed Dec 30 23:48:02 2009 +0100
@@ -26,18 +26,21 @@
use if $ENV{DEBUG} => "Smart::Comments";
use POSIX qw(:sys_wait_h setsid);
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 = 1;
+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_realm = $ME;
my $opt_ssl = 1;
my $opt_ssl_cert = "crt.pem";
my $opt_ssl_key = "key.pem";
@@ -59,20 +62,6 @@
# exit
my $masterpid;
-# usernames & password hashes
-my $authdata;
-
-# 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; currently we achieve that by setting @ISA in the constructor to
-# either qw(IO::Socket::INET) or qw(IO::Socket::SSL); that means you cant mix
-# SSL and non SSL Sockets in the program (@ISA is a class variable); using just
-# IO::Socket::SSL would (probably) require more coding and certainly more
-# background knowledge and might not even address the problems we work around
-# here
END {
unlink $pidfile
if defined $pidfile
@@ -92,43 +81,41 @@
sub bad_request();
sub date1123(;$);
+sub authenticated($$);
+
my %FILE;
MAIN: {
GetOptions(
- "addr=s" => \$opt_addr,
- "auth!" => \$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) },
+ "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) },
"htpasswd=s" => \$opt_htpasswd,
- "realm=s" => \$opt_realm,
"ssl!" => \$opt_ssl,
"ssl-cert=s" => \$opt_ssl_cert,
"ssl-key=s" => \$opt_ssl_key
) or pod2usage();
- $IO::Socket::hlog::DEBUG = $opt_debug;
-
if ($opt_kill) {
$opt_auth = 0;
$opt_ssl = 0;
}
- foreach ($opt_ssl_key, $opt_ssl_cert) {
+ foreach ($opt_htpasswd, $opt_ssl_key, $opt_ssl_cert) {
$_ = abs_path($_) if defined;
}
### $opt_ssl_key
### $opt_ssl_cert
-
- $authdata = new Authen::hlog(filename => $opt_htpasswd, realm => $opt_realm)
- if $opt_auth;
+ ### $opt_auth
if (defined($logdir = find_writable_dir(@$logdir))) {
$access = sprintf $$access, $logdir;
@@ -319,31 +306,29 @@
my $lines = (s/(\d+)$// ? $1 : $opt_lines);
my $tag = (s/^\/*(\w+)// ? $1 : "default");
- my $authorized;
- $authorized = 1 unless $opt_auth;
+ 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 (!defined $authorized
- && /^Authorization: Basic ([[:alnum:]+\/=]+)\r?$/)
- {
- $authorized = $authdata->verify_base64($1);
- log_write("authentication failure from " . $client->peerhost)
- unless $authorized;
+ if (/^Authorization:\s+Basic\s+([[:alnum:]+\/=]+)\r?$/) {
+ $authenticated = authenticate($opt_htpasswd => $1)
+ or log_write("authentication failure from " . $client->peerhost);
}
- last if /^\s*$/;
}
+ ### $authenticated
- unless ($authorized) {
+ unless ($authenticated) {
$client->print(
http {
- code => "401 Unauthorized",
- headers => {
- "WWW-Authenticate" => "Basic realm=\"$authdata->{realm}\""
- }
+ code => "401 Unauthorized",
+ headers =>
+ { "WWW-Authenticate" => "Basic realm=\"$opt_auth\"", }
},
"not authorized"
);
@@ -468,105 +453,11 @@
__EOF
}
-# PACKAGES
-{
-
- # authentication
- package Authen::hlog;
-
- use Crypt::PasswdMD5;
- use Digest::SHA1 qw(sha1_base64);
- use MIME::Base64 qw(decode_base64);
-
- sub new {
-
- my $class = shift;
-
- my $self = {@_};
-
- die "At least one of 'filename' or 'authdata' parameters is required"
- unless $self->{filename} || $self->{authdata};
-
- bless $self, $class;
- $self->authdata if $self->{filename};
-
- return $self;
-
- }
-
- sub verify_base64 {
-
- my $self = shift;
- return $self->verify(split /:/, decode_base64($_[0]));
-
- }
-
- sub verify {
-
- my $self = shift;
-
- my ($u, $p) = @_;
-
- my $hp = $self->{authdata}->{$u};
-
- # crypt?
- if (length $hp == 13) {
- return crypt($p, $hp) eq $hp;
-
- # apache md5?
- }
- elsif (length $hp == 37 && $hp =~ /^\$apr/) {
- return apache_md5_crypt($p, $hp) eq $hp;
- }
- elsif ($hp =~ s/^\{SHA\}//) {
-
- # remove trailing equality signs because sha1_base64 refuses to add any
- $hp =~ s/=*$//;
- return sha1_base64($p) eq $hp;
- }
- else {
- warn "unknown hash format: >>>$hp<<<";
- }
-
- return;
-
- }
-
- sub authdata {
-
- my $self = shift;
-
- my ($htpasswd) = @_ || $self->{filename} || die "Missing filename";
-
- $self->{authdata} = {};
-
- open H, "<$htpasswd" or die "Cant open '<$htpasswd': $!";
- while (my $line = <H>) {
-
- chomp $line;
-
- # htpasswd lines may have more than 2 fields
- my ($u, $p) = split /:/, $line, 3;
-
- unless ($u && $p) {
- warn "invalid htpasswd line in '$htpasswd' at line $.";
- next;
- }
-
- warn
-"duplicate user '$u' in '$htpasswd' at line $. - overriding previous record"
- if exists $self->{authdata}->{$u};
- $self->{authdata}->{$u} = $p;
-
- }
-
- close H or warn "Cant close '<$htpasswd': $!";
-
- warn "no authentication data found" unless %{ $self->{authdata} };
-
- return $self->{authdata};
-
- }
+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__
@@ -583,8 +474,8 @@
[-a|--address address] [-p|--port port]
[--lines n]
[--htpasswd path]
- [--realm realm]
[--[no]ssl]
+ [--auth=[realm] | --noauth]
[--ssl-cert path]
[--ssl-key path]
{file|tag=file ...}
@@ -594,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(S)/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.
@@ -606,9 +497,10 @@
The address to listen on. (default: 0.0.0.0)
-=item B<--[no]auth>
+=item B<--auth>[ I<realm>] | B<--noauth>
-Do (or do not) authorize all access. (default: do)
+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>
@@ -635,10 +527,6 @@
The port to listen on. (default: 8080)
-=item B<--realm> I<realm>
-
-Alternate Name for the HTTP Authentication realm parameter (default: basename($0))
-
=item B<--[no]ssl>
Enable (or disable) https connections (default: enabled)