# HG changeset patch # User Heiko Schlittermann # Date 1262213282 -3600 # Node ID 2d6cb4466fb6a3b90557da7b2d8579d16d1595e5 # Parent ba9f62859590741a8f662c91c11bb1d81800bd28 auh: use a CPAN module diff -r ba9f62859590 -r 2d6cb4466fb6 hlog.pl --- 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 = ) { - - 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 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] | 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 - -Alternate Name for the HTTP Authentication realm parameter (default: basename($0)) - =item B<--[no]ssl> Enable (or disable) https connections (default: enabled)