# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1262091005 -3600
# Node ID 487165bdcf58ddb849fbc7e12b111926b6fe9da2
# Parent  cd49f3a21d5d031c148ff5814b77117aa5531227
kill/getline
kill - do not use opt_auth/opt_ssl
getline - removed an early getline

diff -r cd49f3a21d5d -r 487165bdcf58 hlog.pl
--- a/hlog.pl	Tue Dec 29 11:23:38 2009 +0100
+++ b/hlog.pl	Tue Dec 29 13:50:05 2009 +0100
@@ -72,182 +72,185 @@
 # IO::Socket::SSL would (probably) require more coding and certainly more
 # background knowledge and might not even address the problems we work around
 # here
-package IO::Socket::hlog;
+{
+
+    package IO::Socket::hlog;
+
+    use IO::Socket::INET;
+    use IO::Socket::SSL;
+
+    our (@ISA, $DEBUG);
 
-use IO::Socket::INET;
-use IO::Socket::SSL;
+    sub new {
+
+        my $class = shift;
 
-our (@ISA, $DEBUG);
+        my %args = @_;
+        my $ssl  = delete $args{SSL};
 
-sub new {
+        if ($ssl) {
 
-    my $class = shift;
+            @ISA = qw(IO::Socket::SSL);
+            $IO::Socket::SSL::DEBUG = $DEBUG ? 3 : 0;
 
-    my %args = @_;
-    my $ssl  = delete $args{SSL};
+        }
+        else {
+
+            %args = _delete_ssl_args(%args);
+            @ISA  = qw(IO::Socket::INET);
+
+        }
 
-    if ($ssl) {
+        my $self;
+        unless ($self = $class->SUPER::new(%args)) {
+
+            return;
 
-        @ISA = qw(IO::Socket::SSL);
-        $IO::Socket::SSL::DEBUG = $DEBUG ? 3 : 0;
+        }
+
+        print "$class: $self created\n" if $DEBUG;
+
+        return $self;
 
     }
-    else {
+
+    sub close {
+
+        my $self = shift;
+        print "$self: closing\n" if $DEBUG;
+
+        my %args = @_;
+
+        %args = _delete_ssl_args(%args) unless $self->_is_ssl;
 
-        %args = _delete_ssl_args(%args);
-        @ISA  = qw(IO::Socket::INET);
+        return $self->SUPER::close(%args);
+
+    }
+
+    sub errstr {
+
+        return IO::Socket::SSL::errstr if _is_ssl();
+
+        return $@;
 
     }
 
-    my $self;
-    unless ($self = $class->SUPER::new(%args)) {
+    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";
+
+    }
+}
+
+{
+
+    # 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;
 
     }
 
-    print "$class: $self created\n" if $DEBUG;
-
-    return $self;
-
-}
-
-sub close {
-
-    my $self = shift;
-    print "$self: closing\n" if $DEBUG;
-
-    my %args = @_;
+    sub authdata {
 
-    %args = _delete_ssl_args(%args) unless $self->_is_ssl;
-
-    return $self->SUPER::close(%args);
-
-}
-
-sub errstr {
+        my $self = shift;
 
-    return IO::Socket::SSL::errstr if _is_ssl();
-
-    return $@;
-
-}
-
-sub _delete_ssl_args {
+        my ($htpasswd) = @_ || $self->{filename} || die "Missing filename";
 
-    my %args = @_;
-    map { delete $args{$_} if /^SSL/; } keys %args;
-    return %args;
-
-}
-
-sub _is_ssl {
-
-    my $self = shift;
-    return $ISA[0] eq "IO::Socket::SSL";
-
-}
-
-# authentication
-package Authen::hlog;
+        $self->{authdata} = {};
 
-use Crypt::PasswdMD5;
-use Digest::SHA1 qw(sha1_base64);
-use MIME::Base64 qw(decode_base64);
-
-sub new {
-
-    my $class = shift;
+        open H, "<$htpasswd" or die "Cant open '<$htpasswd': $!";
+        while (my $line = <H>) {
 
-    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};
+            chomp $line;
 
-    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\}//) {
+            # htpasswd lines may have more than 2 fields
+            my ($u, $p) = split /:/, $line, 3;
 
-        # 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;
+            unless ($u && $p) {
+                warn "invalid htpasswd line in '$htpasswd' at line $.";
+                next;
+            }
 
-    my ($htpasswd) = @_ || $self->{filename} || die "Missing filename";
-
-    $self->{authdata} = {};
-
-    open H, "<$htpasswd" or die "Cant open '<$htpasswd': $!";
-    while (my $line = <H>) {
+            warn
+"duplicate user '$u' in '$htpasswd' at line $. - overriding previous record"
+              if exists $self->{authdata}->{$u};
+            $self->{authdata}->{$u} = $p;
 
-        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};
 
     }
-
-    close H or warn "Cant close '<$htpasswd': $!";
-
-    warn "no authentication data found" unless %{ $self->{authdata} };
-
-    return $self->{authdata};
-
 }
 
-# back to main package
-package main;
-
 END {
     unlink $pidfile
       if defined $pidfile
@@ -290,6 +293,11 @@
 
     $IO::Socket::hlog::DEBUG = $opt_debug;
 
+    if ($opt_kill) {
+        $opt_auth = 0;
+        $opt_ssl  = 0;
+    }
+
     $authdata = new Authen::hlog(filename => $opt_htpasswd, realm => $opt_realm)
       if $opt_auth;
 
@@ -521,7 +529,8 @@
     log_write($client->peerhost . ":" . $client->peerport . " $tag ($lines)");
 
     seek($file{fh}, -($lines + 1) * $file{avglen}, 2);
-    $file{fh}->getline;
+
+    # warum das? $file{fh}->getline;
 
     $client->print(http "200 OK" => join "", <<__EOF, $file{fh}->getlines);
 # Proof of concept ;-)