hlog: comparison hlog.pl

equal deleted inserted replaced

-:9465d503d498
+:97c0f39be179
 my $opt_ssl      = 1;
 my $opt_ssl_cert = "crt.pem";
 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 $rundir = ["/var/run/$ME", "$ENV{HOME}/.$ME"];
-my $logdir = [ "/var/log/$ME", "$ENV{HOME}/.$ME" ];
+my $logdir = ["/var/log/$ME", "$ENV{HOME}/.$ME"];
 my $maxlogsize  = 1_000_000;    # ca 1 MByte
 my $killtimeout = 3;
 # 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
 # exit
 my $masterpid;
 our (@ISA, $DEBUG);
 sub new {
 my $class = shift;
 my %args = @_;
-my $ssl = delete $args{SSL};
+my $ssl  = delete $args{SSL};
 if ($ssl) {
 @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 %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 Digest::SHA1 qw(sha1_base64);
 use MIME::Base64 qw(decode_base64);
 sub new {
 my $class = shift;
-my $self = { @_ };
+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]));
 }
 sub verify {
 my $self = shift;
 my ($u, $p) = @_;
 my $hp = $self->{authdata}->{$u};
 # crypt?
 if (length $hp == 13) {
-return crypt ($p, $hp) eq $hp;
+return crypt($p, $hp) eq $hp;
-# apache md5?
-} elsif (length $hp == 37 && $hp =~ /^\$apr/) {
+# apache md5?
-return apache_md5_crypt ($p, $hp) eq $hp;
+}
-} elsif ($hp =~ s/^\{SHA\}//) {
+elsif (length $hp == 37 && $hp =~ /^\$apr/) {
-# remove trailing equality signs because sha1_base64 refuses to add any
+return apache_md5_crypt($p, $hp) eq $hp;
-$hp =~ s/=*$//;
+}
-return sha1_base64($p) eq $hp;
+elsif ($hp =~ s/^\{SHA\}//) {
-} else {
-warn "unknown hash format: >>>$hp<<<";
+# remove trailing equality signs because sha1_base64 refuses to add any
-}
+$hp =~ s/=*$//;
+return sha1_base64($p) eq $hp;
-return;
+}
+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;
+# 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 $.";
+unless ($u && $p) {
-next;
+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': $!";
+}
-warn "no authentication data found" unless %{$self->{authdata}};
+close H or warn "Cant close '<$htpasswd': $!";
-return $self->{authdata};
+warn "no authentication data found" unless %{ $self->{authdata} };
+return $self->{authdata};
 }
 # back to main package
 package main;
 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(@);
 sub log_open($);
 "ssl-key=s"  => \$opt_ssl_key
 ) or pod2usage();
 $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;
 $errors = sprintf $$errors, $logdir;
 log_open($access);
 LocalPort     => $opt_port,
 Proto         => "tcp",
 Listen        => 1,
 ReuseAddr     => 1,
 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";
 # go daemon
 chdir("/") or die "Can't chdir to /: $!\n";
 if ($opt_daemon) {
 my $lines = (s/(\d+)$//    ? $1 : $opt_lines);
 my $tag   = (s/^\/*(\w+)// ? $1 : "default");
 my $authorized;
 $authorized = 1 unless $opt_auth;
-# read and verify (first) authentication header and discard any other headers
-while (<$client>) {
+# 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);
+if (!defined $authorized
-log_write("authentication failure from " . $client->peerhost) unless $authorized;
+&& /^Authorization: Basic ([[:alnum:]+\/=]+)\r?$/)
-}
+{
-last if /^\s*$/;
+$authorized = $authdata->verify_base64($1);
+log_write("authentication failure from " . $client->peerhost)
+unless $authorized;
+}
+last if /^\s*$/;
 }
 unless ($authorized) {
-$client->print(http {
+$client->print(
-code => "401 Unauthorized",
+http {
-headers => { "WWW-Authenticate" => "Basic realm=\"$authdata->{realm}\"" }
+code    => "401 Unauthorized",
-}, "not authorized");
+headers => {
-return;
+"WWW-Authenticate" => "Basic realm=\"$authdata->{realm}\""
+}
+},
+"not authorized"
+);
+return;
 }
 if (not exists $FILE{$tag}) {
 $client->print(http "500 unknown file tag",
 my ($headers, $code, $date) = ('');
 if (ref $_[0] eq "HASH") {
 my $h;
-($code, $date, $h) = @{$_[0]}{'code', 'date', 'headers'};
+($code, $date, $h) = @{ $_[0] }{ 'code', 'date', 'headers' };
-$headers = ( join "\n", map { "$_: $h->{$_}" } keys %{$h} ) . "\n" if defined $h;
+$headers = (join "\n", map { "$_: $h->{$_}" } keys %{$h}) . "\n"
-shift;
+if defined $h;
+shift;
-} else {
+}
-$code = shift;
+else {
-}
+$code = shift;
+}
 $date ||= date1123();
 my $type = $_[0] =~ /^<!DOCTYPE HTML/ ? "text/html" : "text/plain";
 return <<__EOF, @_;
 }
 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] ],
+qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) [$now[4]],
-$now[5] + 1900, @now[ 2, 1, 0 ];
+$now[5] + 1900, @now[2, 1, 0];
 }
 sub bad_request() {
 return <<'__EOF';
 <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">

branch	foerste
changeset 42	97c0f39be179
parent 40	99e8455f50dc
child 44	487165bdcf58