merged: 2d6cb4466fb6 (auth/https) from branch foerste
authorHeiko Schlittermann <hs@schlittermann.de>
Wed, 30 Dec 2009 23:52:34 +0100
changeset 49 29532c7f9629
parent 29 754393593d11 (current diff)
parent 48 2d6cb4466fb6 (diff)
child 50 5f464080b942
merged: 2d6cb4466fb6 (auth/https) from branch foerste
modules
--- a/.hgignore	Thu Jan 29 17:58:15 2009 +0100
+++ b/.hgignore	Wed Dec 30 23:52:34 2009 +0100
@@ -1,1 +1,7 @@
-hlog.1.gz
+syntax regexp:
+^hg\.log$
+^hlog\.1\.gz$
+^hlog$
+^htpasswd$
+^t$
+^(key|crt)\.pem$
--- a/.hgtags	Thu Jan 29 17:58:15 2009 +0100
+++ b/.hgtags	Wed Dec 30 23:52:34 2009 +0100
@@ -8,4 +8,6 @@
 8b2d5135c8d8cb42c2694f238bacb67beb40a578 stable
 a725449912253647f62ee9d3c6dcff3e9495bf29 stable
 4fb7b2a136d34d7a7c5f5ad6b642b6783bed7692 stable
-b378b5a3ca863b35aafa12fec9f2e078de6c290f stable
+0000000000000000000000000000000000000000 stable
+e7c1991f7d2ba4840b3223a5cee0523710e930a2 https
+99e8455f50dca66041337a45e30a7272ff40dcde basicauth
--- a/hlog.pl	Thu Jan 29 17:58:15 2009 +0100
+++ b/hlog.pl	Wed Dec 30 23:52:34 2009 +0100
@@ -21,35 +21,53 @@
 use strict;
 use warnings;
 use Getopt::Long;
-use IO::Socket::INET;
 use Pod::Usage;
 use File::Basename;
+use if $ENV{DEBUG} => "Smart::Comments";
 use POSIX qw(:sys_wait_h setsid);
-use Cwd;
-
-my $opt_addr   = "0.0.0.0";
-my $opt_port   = 8080;
-my $opt_lines  = 10;
-my $opt_daemon = 1;
-my $opt_kill   = 0;
+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     = $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_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 $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  = 1000_000_000;    # ca 1 MByte
+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;
 
 END {
     unlink $pidfile
-      if defined $pidfile and not ref $pidfile;
+      if defined $pidfile
+          and not ref $pidfile
+          and defined $masterpid
+          and $masterpid == $$;
 }
 
 sub find_writable_dir(@);
@@ -63,20 +81,42 @@
 sub bad_request();
 sub date1123(;$);
 
+sub authenticated($$);
+
 my %FILE;
 
 MAIN: {
 
     GetOptions(
-        "addr=s"  => \$opt_addr,
+        "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) },
+        "help" => sub { pod2usage(-verbose => 1, -exitval => 0) },
+        "man"  => sub { pod2usage(-verbose => 2, -exitval => 0) },
+        "htpasswd=s" => \$opt_htpasswd,
+        "ssl!"       => \$opt_ssl,
+        "ssl-cert=s" => \$opt_ssl_cert,
+        "ssl-key=s"  => \$opt_ssl_key
     ) or pod2usage();
 
+    if ($opt_kill) {
+        $opt_auth = 0;
+        $opt_ssl  = 0;
+    }
+
+    foreach ($opt_htpasswd, $opt_ssl_key, $opt_ssl_cert) {
+        $_ = abs_path($_) if defined;
+    }
+
+    ### $opt_ssl_key
+    ### $opt_ssl_cert
+    ### $opt_auth
+
     if (defined($logdir = find_writable_dir(@$logdir))) {
         $access = sprintf $$access, $logdir;
         $errors = sprintf $$errors, $logdir;
@@ -119,21 +159,24 @@
     # resolve tags and filenames
     foreach (@ARGV) {
         $_ = "default=$_" if not /=/ or /^\//;
+
         my ($tag, $file) = split /=/, $_, 2;
+
         die "tag $tag already exists with file $FILE{$tag}\n"
           if exists $FILE{$tag};
-        $file = getcwd() . "/$file" if $file !~ /^\//;
+        $file = abs_path($file);
         $FILE{$tag} = $file;
     }
 
-    # start the listener
+    # Start the listener, just a normal INET socket,
+    # SSL will be started later on, if needed..
     my $listener = new IO::Socket::INET(
         LocalAddr => $opt_addr,
         LocalPort => $opt_port,
         Proto     => "tcp",
         Listen    => 1,
         ReuseAddr => 1,
-    ) or die "Can't create listener socket: $!\n";
+    ) or die "Can't create listener: $!\n";
 
     # go daemon
     chdir("/") or die "Can't chdir to /: $!\n";
@@ -147,7 +190,6 @@
             print "listener $pid "
               . $listener->sockhost . ":"
               . $listener->sockport . "\n";
-            undef $pidfile;
             exit 0;
         }
 
@@ -174,6 +216,7 @@
           or die "Can't open $pidfile: $!\n";
 
         print PID "$$\n";
+        $masterpid = $$;
         close PID;
     }
 
@@ -190,11 +233,20 @@
         die "Can't fork: $!\n" if not defined $pid;
         if ($pid == 0) {
             $SIG{CHLD} = "DEFAULT";
-            $listener->close;
+            $listener->close();
+            if ($opt_ssl) {
+                $client = IO::Socket::SSL->new_from_fd(
+                    $client,
+                    SSL_server    => 1,
+                    SSL_key_file  => $opt_ssl_key,
+                    SSL_cert_file => $opt_ssl_cert,
+                );
+                $client->start_SSL;
+            }
             handle_request($client);
             exit 0;
         }
-        $client->close;
+        $client->close();
 
         # maintenance of logfiles
         if (-s $access > $maxlogsize) {
@@ -234,16 +286,19 @@
 
 sub handle_request($) {
     my $client = shift;
+
     local $_ = <$client>;
 
-    # should be HTTP/x.x
-    if (not s/\s+HTTP\/\S+\s*$//) {
+    # should be HTTP(S)/x.x
+    if (not s/\s+HTTPS?\/\S+\s*$//) {
+        log_write("Bad Request: $_") if $opt_debug;
         $client->print(bad_request);
         return;
     }
 
     # should be a GET request
     if (not s/GET\s+//) {
+        log_write("Bad Request: $_") if $opt_debug;
         $client->print(http "400 Bad Request" => bad_request);
     }
 
@@ -251,8 +306,35 @@
     my $lines = (s/(\d+)$//    ? $1 : $opt_lines);
     my $tag   = (s/^\/*(\w+)// ? $1 : "default");
 
-    # read the header(s) and discard
-    while (<$client>) { last if /^\s*$/ }
+    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 (/^Authorization:\s+Basic\s+([[:alnum:]+\/=]+)\r?$/) {
+            $authenticated = authenticate($opt_htpasswd => $1)
+              or log_write("authentication failure from " . $client->peerhost);
+        }
+
+    }
+    ### $authenticated
+
+    unless ($authenticated) {
+
+        $client->print(
+            http {
+                code => "401 Unauthorized",
+                headers =>
+                  { "WWW-Authenticate" => "Basic realm=\"$opt_auth\"", }
+            },
+            "not authorized"
+        );
+        return;
+
+    }
 
     if (not exists $FILE{$tag}) {
         $client->print(http "500 unknown file tag",
@@ -270,7 +352,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 ;-)
@@ -316,8 +399,25 @@
 }
 
 sub http($@) {
-    my $code = shift;
-    my $date = date1123();
+
+    my ($headers, $code, $date) = ('');
+
+    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;
+
+    }
+
+    $date ||= date1123();
 
     my $type = $_[0] =~ /^<!DOCTYPE HTML/ ? "text/html" : "text/plain";
 
@@ -326,17 +426,17 @@
 Date: $date
 Connection: close
 Content-Type: $type
-
+$headers
 __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] ],
-      $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() {
@@ -353,6 +453,13 @@
 __EOF
 }
 
+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__
 
 =head1 NAME
@@ -361,10 +468,16 @@
 
 =head1 SYNOPSIS
     
-    hlog [--[no]daemon] 
+    hlog [--[no]daemon]
+         [--[no]debug] 
 	 [-k|--kill]
          [-a|--address address] [-p|--port port]
 	 [--lines n] 
+         [--htpasswd path]
+         [--[no]ssl]
+	 [--auth=[realm] | --noauth]
+         [--ssl-cert path]
+         [--ssl-key path]
 	 {file|tag=file ...}
 
     hlog [-h|--help] [-m|--man]
@@ -372,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/1.x.
+the last lines of a logfile. It understands basic HTTP(S)/1.x.
 
 See the L<FILES> section for more information on files.
 
@@ -384,23 +497,48 @@
 
 The address to listen on. (default: 0.0.0.0)
 
+=item B<--auth>[ I<realm>] | B<--noauth>
+
+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>
 
 Do (or do not) daemonize. (default: do)
 
-=item B<--lines> I<lines>
+=item B<--[no]debug>
+
+Do (or do not) print debug information to STDOUT/ERR and logfile. (default: dont)
 
-The number of lines to show. (default: 10)
+=item B<--htpasswd> I<path>
+
+Path to alternate htpasswd file (default: htpasswd).
 
 =item B<-k>|B<--kill>
 
 With this option the corresponding (address/port) process gets killed.
 (default: off)
 
+=item B<--lines> I<lines>
+
+The number of lines to show. (default: 10)
+
 =item B<-p>|B<--port> I<port>
 
 The port to listen on. (default: 8080)
 
+=item B<--[no]ssl>
+
+Enable (or disable) https connections (default: enabled)
+
+=item B<--ssl-cert> I<path>
+
+Path to alternate ssl certificate file (default: crt.pem)
+
+=item B<--ssl-key> I<path>
+
+Path to alternate ssl private key file (default: key.pem)
+
 =back
 
 =head1 EXAMPLES
@@ -438,4 +576,8 @@
 beeing used. For safety the hostname will be sanitized to avoid
 dangerous filenames.
 
+=head1 BUGS / TODO
+
+No known bugs.
+
 =cut
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mkcert	Wed Dec 30 23:52:34 2009 +0100
@@ -0,0 +1,4 @@
+#! /bin/bash
+# should(!) create a self signed certificate
+# could be improved :)
+openssl req -x509 -nodes -newkey rsa:1024 -keyout key.pem -out crt.pem
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/modules	Wed Dec 30 23:52:34 2009 +0100
@@ -0,0 +1,9 @@
+Authen::Simple::Passwd
+Cwd
+File::Basename
+Getopt::Long
+IO::Socket::INET
+IO::Socket::SSL
+MIME::Base64
+Pod::Usage
+POSIX