#!/usr/bin/perl
## This program is used to speed up athentication / authorisation in cases where network access is slow
## The user credentials are cached for up to 30 seconde (timeout variable) and are reuesd in that
## peirod so new remote connecions are not nescesarry
## The rest of RFCcotnbrol degrades gracefully if this service is not running (although authitication times 
## amy be longer if it is not running) 
# $Id: auth_cache.pl,v 1.8 2023/08/07 07:16:49 sqko Exp $
use POSIX qw(strftime);
use strict;
use warnings;
use RFC::RFCCGI;
use RFC::Main;
use IO::Socket;
use Data::Dumper;

my $debug = 0;
my $timeout = 600;
my $VERSION = '1.1';
my $reset_time = time;

if (scalar(@ARGV) > 0)
{
    for(my $x = 0; $x < scalar(@ARGV);$x++)
    {
        if ($ARGV[$x] =~ /--version/)
        {
            print "$0 is: $VERSION\n";
            exit 0;
        }
        if ($ARGV[$x] =~ /--debug/)
        {
            $debug = 1;
        }
        if ($ARGV[$x] =~ /--timeout/)
        {
            $timeout = $ARGV[$x+1];
        }
    }
}


my %cmdlst = (
    'ping' => \&ping,
    'login_ok' => \&login_ok,
    'is_admin' => \&is_admin,
    'get_auth' => \&get_auth,
    'set_auth' => \&set_auth,
    'list' => \&list,
);


my %login = ();
my %auth = ();
my %admin = ();

my $local = 'localhost';
my $port = '4042';

my $ip = inet_ntoa(inet_aton($local));
print "Using host $local and port $port\n" if ($debug);
### Bind to socket ###
my $sock = new IO::Socket::INET(
    LocalHost => $local,
    LocalPort => $port,
    Proto  => 'tcp',
    Listen => 10,
    Reuse  => 1
    );
die "Could not create socket: $!\n" unless $sock;
$| = 1;
while ( my $new_sock = $sock->accept() ) 
{
    if ($debug)
    {
        print strftime "%Y:%m:%d:%H:%M:%S", localtime;
    }
    my $other_end = getpeername($new_sock);
    my ( $port, $iaddr ) = unpack_sockaddr_in($other_end);
    my $ip_address = inet_ntoa($iaddr);
    print "  ",$ip_address, "\n" if ($debug);
    if (time > $reset_time + 3600)
    {
	%login = ();
	%auth = ();
	%admin = ();
	$reset_time = time;
    }
    if (my $str = <$new_sock>) {
        my ($cmd,@args) = split (/[\s\t]+/,$str);
        $cmd = lc($cmd);
        print $str if ($debug);
        if ($cmd && $cmdlst{$cmd})
        {
	    my $res = $cmdlst{$cmd}->(@args);
            print "Result: $res\n\n" if ($debug);
            print $new_sock $res if (defined($res));
        }
        close $new_sock;
    }
    else
    {
        close $new_sock;
    }
}
close($sock);
exit;



sub ping
{
    return 'I am alive';
}

sub list
{
    return Dumper \%auth;
}

sub get_auth
{
    my $u = shift;
    my $tab = shift;
    my $t = time;
    if ($u && exists($auth{$u}) && exists($auth{$u}{$tab}) && $t < $auth{$u}{$tab}{'time'} + $timeout )
    {	
	my $mode = $auth{$u}{$tab}{'mode'};
	$auth{$u}{$tab}{'time'} = time;
	print "Returning existing auth for user $u for authorisation $tab ($mode)\n" if ($debug);
	return $mode;
    }
    return undef;
}

sub set_auth
{
    my $u = shift;
    my $tab = shift;
    my $mode = shift;
    if ($u)
    {
	$auth{$u}{$tab}{'mode'} = $mode;
	$auth{$u}{$tab}{'time'} = time;
	print "Setting auth for user $u for authorisation $tab to $mode\n" if ($debug);
    }
    return undef;
}

sub is_admin
{
    my $u = shift;
    my $p = shift;
    my $t = time;
    if (exists($admin{$u}) && $t < $admin{$u}{'time'} + $timeout && $p eq $admin{$u}{'pass'})
    {
	print "Returning existing admin status for user $u\n" if ($debug);
	$admin{$u}{'time'} = time;
	return $admin{$u}{'uid'};
    }
    my $uid = &RFC::Main::passwd_client('isadmin',$u,$p);
    chomp $uid;
    $uid = 0 if (!defined($uid) || $uid < 0);
    if ($uid)
    {
	my %h = (
	    'time' => time,
	    'pass' => $p,
	    'uid' => $uid,
	    );
	$admin{$u} = \%h;
	print "Setting admin status for user $u\n" if ($debug);
	return $uid;
    }
    else
    {
	delete($admin{$u}) if ($u);
	return 0;
    }
}

sub login_ok
{
    my $u = shift;
    my $p = shift;
    my $t = time;
    if ($u && exists($login{$u}) && $t < $login{$u}{'time'} + $timeout && $p eq $login{$u}{'pass'})
    {	
	print "Returning existing login status for user $u\n" if ($debug);
	$login{$u}{'time'} = time;
	return $login{$u}{'uid'};
    }
    my $uid = &RFC::RFCCGI::user_ok($u,$p);
    if ($uid)
    {
	my %h = (
	    'time' => time,
	    'pass' => $p,
	    'uid' => $uid,
	    );
	$login{$u} = \%h;
	print "Setting login status for user $u\n" if ($debug);
	return $uid;
    }
    else
    {
	delete($login{$u}) if ($u);
	return 0;
    }
}
