# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1262092002 -3600
# Node ID 441273fa1663266da4ee63fb766381109e9d8188
# Parent  487165bdcf58ddb849fbc7e12b111926b6fe9da2
moved packages near the end

diff -r 487165bdcf58 -r 441273fa1663 hlog.pl
--- a/hlog.pl	Tue Dec 29 13:50:05 2009 +0100
+++ b/hlog.pl	Tue Dec 29 14:06:42 2009 +0100
@@ -72,185 +72,6 @@
 # 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;
-
-    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";
-
-    }
-}
-
-{
-
-    # 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};
-
-    }
-}
-
 END {
     unlink $pidfile
       if defined $pidfile
@@ -351,7 +172,9 @@
     }
 
     # start the listener
-    my $listener = new IO::Socket::hlog(
+    my $listener =
+      $opt_ssl
+      ? new IO::Socket::SSL(
         LocalAddr     => $opt_addr,
         LocalPort     => $opt_port,
         Proto         => "tcp",
@@ -360,8 +183,16 @@
         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";
+        #debug         => $opt_debug
+      )
+      : new IO::Socket::INET(
+        LocalAddr => $opt_addr,
+        LocalPort => $opt_port,
+        Proto     => "tcp",
+        Listen    => 1,
+        ReuseAddr => 1,
+        #debug     => $opt_debug,
+      );
 
     # go daemon
     chdir("/") or die "Can't chdir to /: $!\n";
@@ -630,6 +461,187 @@
 __EOF
 }
 
+# PACKAGES
+{
+
+    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";
+
+    }
+}
+
+{
+
+    # 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};
+
+    }
+}
+
+
 __END__
 
 =head1 NAME