auth-server

#!/usr/bin/perl -w

# Don Aug  2 20:26:53 CEST 2007
(my $email='XXX%YYY,ch')=~ tr/%,/@./;

use strict;

$0=~ /(.*?)([^\/]+)\z/s or die "?";
my ($mydir, $myname)=($1,$2);
sub usage {
    print STDERR map{"$_\n"} @_ if @_;
    print "$myname socketpath statedir [logfile]

  Opens the unix socket at the given path, listens for connections,
  writes into statedir the last attempt(s) for a particular user
  to prevent dictionary attacks, returns whether the password is
  valid.

  Only checks /etc/{passwd,shadow}.

  Prevents authentification queries for users resolving to the uid 0.

  (Christian Jaeger <$email>)
";
exit (@_ ? 1 : 0);
}

my @args;
my $DEBUG=0;
for (my $i=0; $i<=$#ARGV; $i++) {
    local $_=$ARGV[$i];
    if (/^--?h(elp)?$/) {
    	usage
    } elsif ($_ eq '--') {
    	push @args, @ARGV[$i+1..$#ARGV];
    	last;
    } elsif (/^--?d(ebug)?$/) {
	$DEBUG=1;
#     } elsif (/^--?X(?:XXX(?:=(.*))?)?$/) {
#         if (defined $1) {
#             $XXX=$1
#         } else {
#             $XXX=$ARGV[++$i] or usage "missing argument for '$_' option";
#         }
    } elsif (/^-./) {
    	usage("Unknown option '$_'\n");
    } else {
    	push @args, $_
    }
}
usage unless (@args==2 or @args==3);

our ($socketpath,$statedir,$maybe_logfile)=@args;

use Chj::Unix::Authenticate;
use POSIX 'EINTR';
use Chj::FileStore::PIndex;
use Chj::Log ':all';
use Chj::singlequote;

our $auth= Chj::Unix::Authenticate->new(service=>"login");#(the sole service supportded by that module)

our $state= new Chj::FileStore::PIndex $statedir;
# wenn successful, zwar numfails rücksetzen aber zeitpunkt der letzten failure nicht?
# ps. für multiuser so  doch auch noch sleepen besser wohl.
# also wenn mal n ok kommt, wieder zulassen .
# hm number of failures isch egal?nein. nur wenn time kurz ist UND numfailures >= 3 ist, abblocken.

sub lastfailed_get {
    my ($user)=@_;
    if (defined(my $val= $state->get($user))) {
	my ($numfails,$lastfail)=split " ",$val;
	($numfails,$lastfail)
    } else {
	return
    }
}

sub lastfailed_clear {
    my ($user)=@_;
    if (my ($numfails,$lastfail)= lastfailed_get($user)) {
	$state->set($user,"0 $lastfail");  ##ehr was wollte ich ?   ich mein   bei erstem wiederfailure gleich wieder oder ehr  was wollte ich.  muss  damit ok durchkommt  ja eh warten. --sollte ich numfails lassen und lastfail auf 0 ??
	# ps. parallelität? luckily bin ich singly hier.
    }
}

our $failsleep= 3;
our $basewait= 1; # weils einen wert braucht.   und der verdoplet sich on each.

sub lastfailed_check { # false if it's ok, error string otherwise.
    my ($user)=@_;
    if (my ($numfails,$lastfail)= lastfailed_get($user)) {
	my $t=time;
	# "nun, exponentialoderso?"
	my $waittime= $basewait * 2**$numfails;
	my $oktime= $lastfail + $waittime;
	if ($t >= $oktime) {
	    return   #  '()  vs #f eben.
	} else {
	    "failed authentification $numfails times; please wait until ".localtime($oktime) # well non localtime "would be better"..
	}
    } else {
	return
    }
}

sub lastfailed_fail {
    my ($user)=@_;
    my $t=time;
    if (my ($numfails,$lastfail)= lastfailed_get($user)) {
	$state->set($user,($numfails+1)." $t");
    } else {
	$state->set($user,"1 $t");
    }
}

use IO::Socket::UNIX;

$SIG{PIPE}= sub { };

unlink $socketpath;
our $sock= IO::Socket::UNIX->new(
				 Type=> SOCK_STREAM,
				 Local=> $socketpath,
				 Listen=> 10, # not a boolean, but a queue length right?.
				 #ReuseAddr=> 1, doesn't help. thus unlink above.
				)
  or die "new: $!";#!

sub parse_singlequote_from_buf {
    my ($bufrf,$startpos)=@_;
    pos($$bufrf)=$startpos;
    #while ($$bufrf=~ m/(?!<\\)\'/sg) {  und PROMPT veergessen anzupasen.  Langs welche costly fn calls haben sucken.
    while ($$bufrf=~ m/(?<!\\)\'/sg) {
	my $pos0=pos ($$bufrf);
	while ($$bufrf=~ m/(?<!\\)\'/sg) {
	    my $pos1= pos ($$bufrf);
	    my $substr= substr ($$bufrf,$pos0,$pos1-$pos0-1);
	    $substr=~ s/\\(.)/$1/sg;
	    #return wantarray ? ($substr,$pos1) : $substr
	    return ($substr,$pos1)
	}
	die "missing end of string";
    }
    return
}


sub handle_conn {
    local our ($conn)=@_;
    #$conn->timeout(1); #ok?  grrr warum nützt das nichts?????. weder auf senden noch lesen!!
    #use Chj::repl;repl;

    my $buf;
    defined ($conn->recv($buf,1024)) or die "recv: $!"; # the defined is relevant! (man perlfunc)
    # assume that the whole message has fit into the buffer.
    $buf=~ s/^check // or die "invalid query, does not start with 'check '";
    my $error=sub {
	my $msg= join " ",@_;
	warn "sending error reply ".singlequote($msg)."\n";
	$conn->send($msg)
	  or die "error send ($msg): $!";
    };
    if (my ($user,$pos)= parse_singlequote_from_buf(\$buf,0)) {
	if (my ($pass,$pos)= parse_singlequote_from_buf (\$buf,$pos)) {
	    if (parse_singlequote_from_buf (\$buf,$pos)) {
		&$error ("superfluous string");
	    } else {
		warn "user ".singlequote($user)."\n";
		if (my $errmsg= lastfailed_check($user)) {
		    &$error ($errmsg);
		} else {
		    my $reply= do {
			if (my $u= $auth->authenticate ($user,$pass)) {
			    if ($u->uid != 0) {
				"1"
			    } else {
				"0"
			    }
			} else {
			    "0"
			}
		    };
		    if ($reply) {
			warn "ok\n";
			lastfailed_clear($user)
		    } else {
			warn "invalid\n";# a message has already been logged from $auth, though.
			lastfailed_fail($user);
			sleep $failsleep;
		    }
		    $conn->send($reply)
		      or die "send: $!";
		}
	    }
	} else {
	    &$error ("missing pass");
	}
    } else {
	&$error ("missing user and pass");
    }
}

our $timeout= $failsleep + 2; # seconds

our $do_alarm=0;
$SIG{ALRM}= sub { die "ALRM\n" if $do_alarm };

sub main {
    warn "accepting connections\n";
  loop: {
	while (local our $conn= $sock->accept) {
	    eval {
		{
		    local $do_alarm=1;# is this better against races?
				      # (than switching alarm off or
				      # removing signal handler)
		    alarm $timeout;
		    handle_conn($conn);
		}
	    };
	    if (ref $@ or $@) {
		warn "got exception: $@";
	    }
	    eval {
		{
		    alarm $timeout;
		    local $do_alarm=1;
		    $conn->close
		      or die "close: $!";
		}
	    };
	    if (ref $@ or $@) {
		warn "got exception in closing stage: $@";
	    }
	}
	if ($! == EINTR) {
	    #warn "accept: got EINTR";
	    redo loop;
	} else {
	    die "accept: $!"
	}
    }
}

if ($maybe_logfile) {
    timedlogging_to $maybe_logfile, \&main;
} else {
    &main;
}