diff -r 9465d503d498 -r 97c0f39be179 hlog.pl
--- a/hlog.pl	Tue Dec 01 10:33:26 2009 +0100
+++ b/hlog.pl	Tue Dec 29 11:23:22 2009 +0100
@@ -42,8 +42,8 @@
 my $opt_ssl_key  = "key.pem";
 
 # these vars will be filled with the real dirs later
-my $rundir = [ "/var/run/$ME", "$ENV{HOME}/.$ME" ];
-my $logdir = [ "/var/log/$ME", "$ENV{HOME}/.$ME" ];
+my $rundir = ["/var/run/$ME", "$ENV{HOME}/.$ME"];
+my $logdir = ["/var/log/$ME", "$ENV{HOME}/.$ME"];
 
 my $maxlogsize  = 1_000_000;    # ca 1 MByte
 my $killtimeout = 3;
@@ -51,7 +51,7 @@
 # these are refs to detect if they're converted already
 my $access  = \"%s/access.log";
 my $errors  = \"%s/error.log";
-my $pidfile = \"%s/%s.%s.pid";     # %dir/%ip.%port
+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
@@ -81,69 +81,70 @@
 
 sub new {
 
-  my $class = shift;
-  
-  my %args = @_;
-  my $ssl = delete $args{SSL};
+    my $class = shift;
+
+    my %args = @_;
+    my $ssl  = delete $args{SSL};
 
-  if ($ssl) {
+    if ($ssl) {
 
-    @ISA = qw(IO::Socket::SSL);
-    $IO::Socket::SSL::DEBUG = $DEBUG ? 3 : 0;
+        @ISA = qw(IO::Socket::SSL);
+        $IO::Socket::SSL::DEBUG = $DEBUG ? 3 : 0;
 
-  } else {
+    }
+    else {
 
-    %args = _delete_ssl_args(%args);
-    @ISA = qw(IO::Socket::INET);
+        %args = _delete_ssl_args(%args);
+        @ISA  = qw(IO::Socket::INET);
 
-  }
+    }
 
-  my $self;
-  unless ($self = $class->SUPER::new(%args)) {
+    my $self;
+    unless ($self = $class->SUPER::new(%args)) {
 
-    return;
+        return;
 
-  }
+    }
 
-  print "$class: $self created\n" if $DEBUG;
+    print "$class: $self created\n" if $DEBUG;
 
-  return $self;
+    return $self;
 
 }
 
 sub close {
 
-  my $self = shift;
-  print "$self: closing\n" if $DEBUG;
+    my $self = shift;
+    print "$self: closing\n" if $DEBUG;
 
-  my %args = @_;
+    my %args = @_;
 
-  %args = _delete_ssl_args(%args) unless $self->_is_ssl;
+    %args = _delete_ssl_args(%args) unless $self->_is_ssl;
 
-  return $self->SUPER::close(%args);
+    return $self->SUPER::close(%args);
 
 }
 
 sub errstr {
 
-  return IO::Socket::SSL::errstr if _is_ssl();
+    return IO::Socket::SSL::errstr if _is_ssl();
 
-  return $@;
+    return $@;
 
 }
 
 sub _delete_ssl_args {
 
-  my %args = @_;
-  map { delete $args{$_} if /^SSL/; } keys %args;
-  return %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";
+    my $self = shift;
+    return $ISA[0] eq "IO::Socket::SSL";
 
 }
 
@@ -156,84 +157,92 @@
 
 sub new {
 
-  my $class = shift;
-  
-  my $self = { @_ };
+    my $class = shift;
+
+    my $self = {@_};
 
-  die "At least one of 'filename' or 'authdata' parameters is required" unless $self->{filename} || $self->{authdata};
+    die "At least one of 'filename' or 'authdata' parameters is required"
+      unless $self->{filename} || $self->{authdata};
 
-  bless $self, $class;
-  $self->authdata if $self->{filename};
+    bless $self, $class;
+    $self->authdata if $self->{filename};
 
-  return $self;
+    return $self;
 
 }
 
 sub verify_base64 {
 
-  my $self = shift;
-  return $self->verify(split /:/, decode_base64($_[0]));
+    my $self = shift;
+    return $self->verify(split /:/, decode_base64($_[0]));
 
 }
-  
 
 sub verify {
 
-  my $self = shift;
+    my $self = shift;
+
+    my ($u, $p) = @_;
 
-  my ($u, $p) = @_; 
+    my $hp = $self->{authdata}->{$u};
 
-  my $hp = $self->{authdata}->{$u};
+    # crypt?
+    if (length $hp == 13) {
+        return crypt($p, $hp) eq $hp;
 
-  # 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<<<";
-  }
+        # apache md5?
+    }
+    elsif (length $hp == 37 && $hp =~ /^\$apr/) {
+        return apache_md5_crypt($p, $hp) eq $hp;
+    }
+    elsif ($hp =~ s/^\{SHA\}//) {
 
-  return;
+        # 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 $self = shift;
+
+    my ($htpasswd) = @_ || $self->{filename} || die "Missing filename";
 
-  my ($htpasswd) = @_ || $self->{filename} || die "Missing filename";
+    $self->{authdata} = {};
 
-  $self->{authdata} = {};
+    open H, "<$htpasswd" or die "Cant open '<$htpasswd': $!";
+    while (my $line = <H>) {
+
+        chomp $line;
 
-  open H, "<$htpasswd" or die "Cant open '<$htpasswd': $!";
-  while (my $line = <H>) {
+        # htpasswd lines may have more than 2 fields
+        my ($u, $p) = split /:/, $line, 3;
 
-    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;
+        }
 
-    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;
+
     }
 
-    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': $!";
 
-  close H or warn "Cant close '<$htpasswd': $!";
+    warn "no authentication data found" unless %{ $self->{authdata} };
 
-  warn "no authentication data found" unless %{$self->{authdata}};
+    return $self->{authdata};
 
-  return $self->{authdata};
-  
 }
 
 # back to main package
@@ -241,7 +250,10 @@
 
 END {
     unlink $pidfile
-      if defined $pidfile and not ref $pidfile and defined $masterpid and $masterpid == $$;
+      if defined $pidfile
+          and not ref $pidfile
+          and defined $masterpid
+          and $masterpid == $$;
 }
 
 sub find_writable_dir(@);
@@ -278,7 +290,8 @@
 
     $IO::Socket::hlog::DEBUG = $opt_debug;
 
-    $authdata = new Authen::hlog(filename => $opt_htpasswd, realm => $opt_realm) if $opt_auth;
+    $authdata = new Authen::hlog(filename => $opt_htpasswd, realm => $opt_realm)
+      if $opt_auth;
 
     if (defined($logdir = find_writable_dir(@$logdir))) {
         $access = sprintf $$access, $logdir;
@@ -337,12 +350,11 @@
         Listen        => 1,
         ReuseAddr     => 1,
         SSL           => $opt_ssl,
-        SSL_key_file  => $opt_ssl_key, 
+        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";
 
@@ -463,24 +475,33 @@
 
     my $authorized;
     $authorized = 1 unless $opt_auth;
-    # read and verify (first) authentication header and discard any other headers
-    while (<$client>) { 
-      
-      if (!defined $authorized && /^Authorization: Basic ([[:alnum:]+\/=]+)\r?$/) {
-        $authorized = $authdata->verify_base64($1);
-        log_write("authentication failure from " . $client->peerhost) unless $authorized;
-      }
-      last if /^\s*$/;
-      
+
+   # read and verify (first) authentication header and discard any other headers
+    while (<$client>) {
+
+        if (!defined $authorized
+            && /^Authorization: Basic ([[:alnum:]+\/=]+)\r?$/)
+        {
+            $authorized = $authdata->verify_base64($1);
+            log_write("authentication failure from " . $client->peerhost)
+              unless $authorized;
+        }
+        last if /^\s*$/;
+
     }
 
     unless ($authorized) {
 
-      $client->print(http {
-        code => "401 Unauthorized",
-        headers => { "WWW-Authenticate" => "Basic realm=\"$authdata->{realm}\"" }
-        }, "not authorized");
-      return;
+        $client->print(
+            http {
+                code    => "401 Unauthorized",
+                headers => {
+                    "WWW-Authenticate" => "Basic realm=\"$authdata->{realm}\""
+                }
+            },
+            "not authorized"
+        );
+        return;
 
     }
 
@@ -551,17 +572,19 @@
 
     if (ref $_[0] eq "HASH") {
 
-      my $h;
-      ($code, $date, $h) = @{$_[0]}{'code', 'date', 'headers'};
-      $headers = ( join "\n", map { "$_: $h->{$_}" } keys %{$h} ) . "\n" if defined $h;
-      shift;
-
-    } else {
-
-      $code = shift;
+        my $h;
+        ($code, $date, $h) = @{ $_[0] }{ 'code', 'date', 'headers' };
+        $headers = (join "\n", map { "$_: $h->{$_}" } keys %{$h}) . "\n"
+          if defined $h;
+        shift;
 
     }
-    
+    else {
+
+        $code = shift;
+
+    }
+
     $date ||= date1123();
 
     my $type = $_[0] =~ /^<!DOCTYPE HTML/ ? "text/html" : "text/plain";
@@ -578,10 +601,10 @@
 sub date1123(;$) {
     my @now = gmtime(@_ ? shift : time);
     sprintf "%s, %2d %s %4d %02d:%02d:%02d GMT",
-      qw(Sun Mon Tue Wed Thu Fri Sat Sun) [ $now[6] ],
+      qw(Sun Mon Tue Wed Thu Fri Sat Sun) [$now[6]],
       $now[3],
-      qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) [ $now[4] ],
-      $now[5] + 1900, @now[ 2, 1, 0 ];
+      qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) [$now[4]],
+      $now[5] + 1900, @now[2, 1, 0];
 }
 
 sub bad_request() {