#!/usr/bin/perl
#$Id: celltest-passwd-server,v 1.45 2023/02/23 10:26:41 sqko Exp $
$SIG{INT} = \&my_sigint;
use strict;
use warnings;
use Tie::DataDumper;
use IO::Socket::INET;
use Sys::Hostname;
use Fcntl qw(:DEFAULT :flock);
use String::Random;
use Crypt::Eksblowfish::Bcrypt qw(en_base64 bcrypt);
use Crypt::OpenSSL::Random;
use Crypt::OpenSSL::RSA;
use Crypt::CBC;
use MIME::Base64;
use RFC::Header;
use SemaforeFile;
use AFM;

my $pid = 1;
my $cost = '08';
my $VERSION = '$Revision: 1.45 $';
my $PROGRAM = 'celltest-passwd-server';
our $debug = 0;
my $ssl = 0;
my $sso = 0;
my $str = &get_cv('passwds','force_encryption');
$ssl = 1 if ($str && $str =~ /yes/i);
if (scalar(@ARGV) > 0)
{
    for(my $x = 0; $x < scalar(@ARGV);$x++)
    {
        if ($ARGV[$x] =~ /--version/)
        {
            print "$PROGRAM is: $VERSION\n";
            exit 0;
        }
        if ($ARGV[$x] =~ /--debug/)
        {
            $debug = 1;
        }
        if ($ARGV[$x] =~ /--ssl/)
        {
            $ssl = 1;
        }
        if ($ARGV[$x] =~ /--sso/)
        {
            $sso = 1;
        }
    }
}

### Setup hash of functions ###
our %cmdlst = ();
$cmdlst{'is_logged_in'} = \&is_logged_in;
$cmdlst{'logout_user'} = \&logout_user;
$cmdlst{'logout_delay'} = \&logout_delay;
$cmdlst{'new_session'} = \&new_session;
$cmdlst{'new_session_cas'} = \&new_session_cas;
$cmdlst{'checkuser'} = \&checkuser;
$cmdlst{'checkuser_sso'} = \&checkuser_sso;
$cmdlst{'get_users'} = \&get_users;
$cmdlst{'isuser'} = \&isuser;
$cmdlst{'isadmin'} = \&isadmin;
$cmdlst{'adduser'} = \&adduser;
$cmdlst{'adduser_nomail'} = \&adduser_nomail;
$cmdlst{'deleteuser'} = \&deleteuser;
$cmdlst{'root_access'} = \&root_access;
$cmdlst{'user_auth'} = \&user_auth;
$cmdlst{'changepwd'} = \&changepwd;
$cmdlst{'resetpwd'} = \&resetpwd;
$cmdlst{'resetpwd_cmd'} = \&resetpwd_cmd;
$cmdlst{'checkauth'} = \&checkauth;
$cmdlst{'multiauth'} = \&multiauth;
$cmdlst{'email'} = \&email;
$cmdlst{'ping'} = \&ping;
$cmdlst{'is_ssl'} = \&is_ssl;
$cmdlst{'public_key'} = \&pubkey;
$cmdlst{'exit'} = \&shutdown;
$cmdlst{'get_per'} = \&get_per;
$cmdlst{'get_admin'} = \&get_admin;
$cmdlst{'pwdstatus'} = \&pwdstatus;
$cmdlst{'debug'} = \&debug;
### Safety task section ###
$cmdlst{'check_task_status'} = \&task_status;
$cmdlst{'check_task_cert'} = \&task_cert;
$cmdlst{'new_task'} = \&new_task;
$cmdlst{'task_name'} = \&task_name;
$cmdlst{'task_valid'} = \&task_valid;
$cmdlst{'get_tasks'} = \&get_tasks;
$cmdlst{'get_task_names'} = \&get_task_names;
$cmdlst{'set_task_auth'} = \&set_task_auth;
$cmdlst{'set_task_cert'} = \&set_task_cert;
$cmdlst{'rev_task_auth'} = \&revoke_task_auth;
$cmdlst{'rev_task_cert'} = \&revoke_task_cert;
$cmdlst{'list_cert'} = \&list_cert;
$cmdlst{'list_auth'} = \&list_auth;

my %allow_remote = (
    'is_logged_in' =>1,
    'logout_user' => 1,
    'logout_delay' => 1,
    'new_session' => 1,
    'checkuser' => 1,
    'checkuser_sso' => 1,
    'get_users' =>1,
    'isuser' => 1,
    'isadmin' => 1,
    'user_auth' => 1,
    'changepwd' => 1,
    'checkauth' => 1,
    'multiauth' => 1,
    'email' => 1,
    'ping' => 1,
    'is_ssl' => 1,
    'public_key' => 1,
    'get_per' => 1,
    'get_admin' => 1,
    'pwdstatus' => 1,
    'debug' => 1,
    'check_task_status' => 1,
    'check_task_cert' => 1,
    'task_name' => 1,
    'task_valid' => 1,
    'get_tasks' => 1,
    'get_task_names' => 1,
    'list_cert' => 1,
    'list_auth' => 1,
);


#### End hash ####

my $passwdfile = &get_cv('passwds','passwdfile');
my $lock = &get_cv('passwds','passwdlock');
our $expire = &get_cv('passwds','expires');
$expire = 180 unless ($expire);

our $delay = &get_cv('global','logoutdelay');
if ($delay && $delay =~ /(\d+)/)
{
    $delay = $1 * 60;
}
else
{
    $delay = 30 * 60;
}
$delay = 120 unless ($delay > 120);  ## Min 2 minutes! #



### Locks file access for other processes ###
sysopen(FH, $lock, O_WRONLY | O_CREAT) or die "Error: can't open file $lock: $!";
flock(FH,LOCK_EX);

tie our @users => 'Tie::DataDumper',$passwdfile;
tie our @tasks => 'Tie::DataDumper','/home/celltest/tasks.txt';

our $this_host = "localhost";
our $remote = 0;
unless (&get_cv('passwds','passwd_server') =~ /localhost/i)
{
    my $str = `hostname -i`;
    if ($str =~ /([\d\.]+)/)
    {
	$this_host = $1;
	$remote = 1;
    }
}
our $port      = &get_cv('passwds','passwd_server_port');
our $user      = "nobody";
print "Using host $this_host and port $port\n" if ($debug);
# Get userid for $user. Abort if userid is zero (superuser) or
# non-existent.#
unless ( our $uid = ( getpwnam($user) )[2] )
{
    die "Attempt to run server as non-existent or superuser\n";
}

my $server = IO::Socket::INET->new(
                                  LocalAddr => $this_host,
                                  LocalPort => $port,
                                  Proto => 'tcp',
                                  Listen => 10,
                                  Reuse => 1,
				   );
die "Could not create socket $!\n" unless ($server);
my $ip = inet_ntoa(inet_aton($this_host));
print "$this_host has ip: $ip\n" if ($debug);

## Create RSA keypair and store keys in /home/celltest/ ###
my $ssl_lock = $RFC::Header::homedir.'ssl.lock';
my $pubfile = SemaforeFile->new($RFC::Header::homedir.'public.key',$ssl_lock);
my $prifile = SemaforeFile->new($RFC::Header::homedir.'secret.key',$ssl_lock);
my $known = SemaforeFile->new($RFC::Header::homedir.'known_hosts',$ssl_lock);
unless ($known->exist)
{
    $known->chmod(0666);
}
foreach ($pubfile,$prifile,$known)
{
    $_->debug($debug);
}
if ($ssl && !$prifile->exist)
{
    my $rsa = Crypt::OpenSSL::RSA->generate_key(2048);
    $pubfile->writeline($rsa->get_public_key_string());
    $prifile->writeline($rsa->get_private_key_string());
    chmod 0640,$prifile->filename();
}
my $rsa_priv;
my $rsa_pub;
if ($ssl)
{
    $rsa_pub = Crypt::OpenSSL::RSA->new_public_key(join("\n",$pubfile->readlines()));
    $rsa_priv = Crypt::OpenSSL::RSA->new_private_key(join("\n",$prifile->readlines()));
}
## Setup hash for key management ###
my %keys = ($ip=>$rsa_pub);
&load_known_hosts();


# Deal with requests #
our $remote_host;
while (1)
{
    # Grab next pending request
    #
    $remote_host = $server->accept();
    die "accept() error: $!\n" unless ($remote_host);
    my $client_address = $remote_host->peerhost();
    my $client_port = $remote_host->peerport();
    my $ltime = localtime;    
    print "$ltime: Connection from $client_address:$client_port\n" if ($debug);
    ### Process request ###
    &request($client_address);
    exit unless ($pid);
}
exit;

sub load_known_hosts()
{
    my $state = 0;
    my @list = ();
    my $host_name = '';
    foreach my $line ($known->readlines())
    {
        if ($state)
        {
            if ($line =~ /^\s*$/)
            {
                $state = 0;
                $keys{$host_name} = Crypt::OpenSSL::RSA->new_public_key(join("\n",@list));
                next;
            }
            push @list,$line;
            next;       
        }
        next if ($line =~ /^\s*$/);
        @list = ();
        $host_name = $line;
        $state = 1;
    }
}


sub passwd_client
{
    my $remote = shift;
    my $port = shift;
    my $out = '';
    eval {
        my $socket = IO::Socket::INET->new(
                                           PeerHost => $remote,
                                           PeerPort => $port,
                                           Proto => 'tcp'
                                           );
        die "Could not conect to server $remote $!\n" unless ($socket);
        $| = 1;
        print $socket join("\t",@_)."\n\n";
        while (my $line = <$socket>)
        {
            $out = $out.$line;
        }
    };
    if ($@)
    {
        warn $@;
    }
    return $out;
}


sub request
{
    my $client = shift;
    # Read client request and get $path
    our @args = ();
    our $cmd = undef;
    my $str = '';
    my $line = <$remote_host>;
    while ($line && $line !~ /^\s*\n$/)
    {
        $str .= $line;
        $line = <$remote_host>;
    }
    chomp $str;
    ### Handle requests without encryption ###
    if ($str && $str =~ /logout_delay/)
    {
        my $result = logout_delay();
        print "'$str'\tResult: $result\n" if ($debug);
        print $remote_host $result;
        shutdown($remote_host,1);
        return;
    }
    if ($str && $str =~ /is_ssl/)
    {
        print "'$str'\tResult: $ssl\n" if ($debug);
        print $remote_host $ssl;
        shutdown($remote_host,1);
        return;
    }
    if ($ssl && $str && $str =~ /public_key/)
    {
        ### Send public key ###
        my $result = $rsa_pub->get_public_key_string();
        print "'$str'\tResult: $result\n" if ($debug);
        print $remote_host $result;
        shutdown($remote_host,1);
        return;
    }
    ### Get public key of client if not already fetched ##
    if ($ssl && !$keys{$client})
    {
        $known->lock_ex;
        ### First reload known_host file and recheck ###
        &load_known_hosts();
        if (!$keys{$client})
        {           
            ### If still no match, get key from host ###
            my $str = passwd_client($client,$port,'public_key');
            if ($str && $str =~ /RSA/)
            {
                $keys{$client} = Crypt::OpenSSL::RSA->new_public_key($str);
                $known->append($client,$str,'');
            }
        }
        $known->lock_un;
    }
    my $cmdstr = '';
    ### Decrypt and process request ###
    ### Detect underscore in result string and process accordingly ###
    if ($str && $str =~ /([\w\+\/\n\s\=]+)_([\w\+\/\s\n\=]+)/m)
    {
	### UseRSA and AES if underscore was found ###
	my $enc_key = $1;
	my $enc_cmd = $2;
	print "Decrypting using RSA and AES\n" if ($debug  && $debug > 1);
	eval {      
	    my $key = $rsa_priv->decrypt(decode_base64($enc_key));
	    ### Detaint key before use ###
	    $key =~ /(\w+)/;
	    $key = $1;
	    my $cipher = Crypt::CBC->new(-key=>$key,-cipher=> 'Crypt::OpenSSL::AES');
	    $cmdstr = $cipher->decrypt(decode_base64($enc_cmd));
	};
	if ($@)
	{
	    &errorlog($@);
	    warn $@;
	}
    }
    elsif ($str && $str =~ /\w+/)
    {
	### use only RSA if no underscore in result ###
	print "Decrypting using RSA only\n" if ($debug  && $debug > 1);
	eval {
	    $cmdstr = $rsa_priv->decrypt(decode_base64($str));
	};
	if ($@)
	{
	    &errorlog($@);
	    warn $@;
	}
    }
    ($cmd,@args) = split(/\t+/,$cmdstr);
    eval {
        if ($cmdlst{$cmd})
        {
            ### Blok requests from remote systems unless it is public ###
            if (&allow_request($client,$cmd))
            {
		my $ok = $cmdlst{$cmd}->(@args);
		## Hack as encrypting a empty string ot undef results in giberish ##
		## Server returns an encrypted space if no result from query      ##
		$ok = ' ' unless (defined($ok) && $ok =~ /\w/);
		print "'$cmd'\tResult: $ok\n" if ($debug);
		if (length($ok) > 32)
		{
		    print "Encrypting response using RSA and AES\n" if ($debug  && $debug > 1);
		    my @chars = ('A'..'Z', 'a'..'z','0'..'9','_');
		    my $key = '';
		    $key .= $chars[rand @chars] for 1..32;
		    my $cipher = Crypt::CBC->new(-key=>$key,-cipher=> 'Crypt::OpenSSL::AES');
		    my $enc_ok = encode_base64($cipher->encrypt($ok));
		    my $enc_key = encode_base64($keys{$client}->encrypt($key));
		    ### Transmit result as base64 encoded RSA encrypted AES key followed by an underscore ###
		    ### and then the base64 encoded AES encrypted request string                          ###
		    print $remote_host $enc_key.'_'.$enc_ok;
		}
		else
		{
		    ### for short strings: Transmit request as base64 encoded RSA encrypted request string ###                           
		    print "Encrypting response using RSA only\n" if ($debug && $debug > 1);
		    print $remote_host encode_base64($keys{$client}->encrypt($ok));
		}
	    }
        } 
        else
        {
            print "Unknown command: '$cmd'\n";
            print $remote_host encode_base64($keys{$client}->encrypt(-1));
        }
    };
    if ($@)
    {
	&errorlog($@);
	warn $@;
    }
    shutdown($remote_host,1);
}


sub allow_request()
{
    my $client = shift;
    my $cmd = shift;
    return 1 if ($allow_remote{$cmd});
    return 1 if ($client eq $ip);
    return 0;
}


sub pubkey
{
    return 0;
}

sub is_ssl
{
    return $ssl;
}


sub new_task
{
    my $ok = 0;
    my $nn = shift; # new task name
    if ($nn)
    {
	my $max = 0;
	foreach (@tasks)
	{
	    ### Find next id ###
	    $max = $$_{'id'} if ($$_{'id'} > $max);
	    ### Check if user already exsists ###
	    return 0 if ($$_{'name'} eq $nn);
	}
	$max++;
	my %certified = ();
	my %authorised = ();
	my %h = ('id'=>$max,'name'=>$nn,'cert'=>\%certified,'auth'=>\%authorised,'valid'=>1);
	push @tasks,\%h;
	tied(@tasks)->save;
	$ok = $max;
    }
    return $ok;
}

sub get_tasks
{
    my @ltask = ();
    my $u = shift;
    my $p = shift;
    my $ok = 0;
    foreach (@tasks)
    {
	push @ltask,$$_{'id'} if ($$_{'valid'});
    }
    return join("\n",@ltask) if (&check_pass($u,$p));
    return -1;
}

sub get_task_names
{
    my @ltask = ();
    my $u = shift;
    my $p = shift;
    my $ok = 0;
    foreach (@tasks)
    {
	push @ltask,$$_{'id'}."\t".$$_{'name'};
    }
    return join("\n",@ltask) if (&check_pass($u,$p));
    return -1;
}

sub list_cert($)
{
    my $ok = '';
    my $u = shift;
    my $p = shift;
    my $t = shift;
    return $ok unless ($u && $t && &check_pass($u,$p));
    my @list = ();
    foreach (@tasks)
    {
	next unless ($$_{'valid'});
	next unless ($$_{'id'} eq $t);
	my %h = %{$$_{'cert'}};
	foreach my $key (keys %h)
	{
	    push @list,$key if $h{$key};
	}
	last;
    }
    return join("\n",@list);
}


sub list_auth($)
{
    my $ok = '';
    my $u = shift;
    my $p = shift;
    my $t = shift;
    return $ok unless ($u && $t && &check_pass($u,$p));
    my @list = ();
    foreach (@tasks)
    {
	next unless ($$_{'valid'});
	next unless ($$_{'id'} eq $t);
	my %h = %{$$_{'auth'}};
	foreach my $key (keys %h)
	{
	    push @list,$key if $h{$key};
	}
	last;
    }
    return join("\n",@list);
}

sub task_name($)
{
    my $ok = -1;
    my $t = shift;
    my $change = 0;
    foreach (@tasks)
    {
	next unless ($$_{'id'} eq $t);
	if (@_)
	{
	    $change = 1;
	    $$_{'name'} = shift;
	}
	$ok = $$_{'name'};	   
	last;
    }
    tied(@tasks)->save if ($change);
    return $ok;
}

sub task_valid($)
{
    my $ok = -1;
    my $u = shift;
    my $p = shift;
    my $t = shift;
    return $ok unless ($u && &check_pass($u,$p));
    my $change = 0;
    foreach (@tasks)
    {
	next unless ($$_{'id'} == $t);
	if (@_ && &isadmin($u,$p))
	{
	    $change = 1;
	    $$_{'valid'} = shift;
	}
	$ok = $$_{'valid'};	   
	last;
    }
    tied(@tasks)->save if ($change);
    return $ok;
}

sub set_task_cert
{
    my $ok = 0;
    my ($ru,$rp,$nu,$r) = @_;
    if ($ru && $rp && $nu && $r)
    {
        my $uid = &isadmin($ru,$rp);
	my $userid = 0;
        return -1 unless ($uid);
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $nu);
	    $userid = $$_{'id'};
	    last;
	}
	return 0 unless ($userid);
	foreach (@tasks)
	{
	    next unless ($$_{'valid'});
	    next unless ($$_{'id'} == $r);
	    $$_{'cert'}{$nu} = 1;
	    $ok = 1;
	    last;
	}
	tied(@tasks)->save;
    }
    return $ok;
}

sub revoke_task_cert
{
    my $ok = 0;
    my ($ru,$rp,$nu,$r) = @_;
    if ($ru && $rp && $nu && $r)
    {
        my $uid = &isadmin($ru,$rp);
	my $userid = 0;
        return -1 unless ($uid);
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $nu);
	    $userid = $$_{'id'};
	    last;
	}
	return 0 unless ($userid);
	foreach (@tasks)
	{
	    next unless ($$_{'valid'});
	    next unless ($$_{'id'} == $r);
	    $$_{'cert'}{$nu} = 0;  
	    $ok = 1;
	    last;
	}
	tied(@tasks)->save;
    }
    return $ok;
}

sub set_task_auth
{
    my $ok = 0;
    my ($ru,$rp,$nu,$r) = @_;
    if ($ru && $rp && $nu && $r)
    {
	my $uid = &isadmin($ru,$rp);
	unless ($uid)
	{
	    foreach (@tasks)
	    {
		next unless ($$_{'valid'});
		next unless ($$_{'id'} == $r);
		my %h = %{$$_{'cert'}};
		$uid = &check_pass($ru,$rp) if (exists($h{$ru}) && $h{$ru});
		last;
	    }	    
	}
	my $userid = 0;
        return -1 unless ($uid);
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $nu);
	    $userid = $$_{'id'};
	    last;
	}
	return 0 unless ($userid);
	foreach (@tasks)
	{
	    next unless ($$_{'valid'});
	    next unless ($$_{'id'} == $r);
	    $$_{'auth'}{$nu} = 1;
	    $ok = 1;
	    last;
	}
	tied(@tasks)->save;
    }
    return $ok;
}

sub revoke_task_auth
{
    my $ok = 0;
    my ($ru,$rp,$nu,$r) = @_;
    if ($ru && $rp && $nu && $r)
    {
	my $uid = &isadmin($ru,$rp);
	unless ($uid)
	{
	    foreach (@tasks)
	    {
		next unless ($$_{'valid'});
		next unless ($$_{'id'} == $r);
		my %h = %{$$_{'cert'}};
		$uid = &check_pass($ru,$rp) if (exists($h{$ru}) && $h{$ru});
		last;
	    }	    
	}
	print $uid,"\n";
	my $userid = 0;
        return -1 unless ($uid);
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $nu);
	    $userid = $$_{'id'};
	    last;
	}
	return 0 unless ($userid);
	foreach (@tasks)
	{
	    next unless ($$_{'valid'});
	    next unless ($$_{'id'} == $r);
	    $$_{'auth'}{$nu} = 0;  
	    $ok = 1;
	    last;
	}
	tied(@tasks)->save;
    }
    return $ok;
}

sub task_status
{
    my $ok = 0;
    my $rid = shift;
    my $tid = shift;
    my %h = ();
    foreach (@tasks)
    {
	next unless ($$_{'valid'});
	next unless ($$_{'id'} == $tid);
	%h = %{$$_{'auth'}};
	last;
    }
    return 1 if ($h{$rid});
    ##  Check for certification if authorisation is not set ###
    ##  (a certified user is automatically authorised)      ###
    return &task_cert($rid,$tid);
}

sub task_cert
{
    my $ok = 0;
    my $rid = shift;
    my $tid = shift;
    my %h = ();
    foreach (@tasks)
    {
	next unless ($$_{'valid'});
	next unless ($$_{'id'} == $tid);
	%h = %{$$_{'cert'}};
	last;
    }
    return 1 if ($h{$rid});
    return $ok;
}

sub ping
{
    return "$PROGRAM on ".hostname." listening on port $port";
}

sub is_logged_in()
{
    my $u = shift;
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	my $val = $$_{'last_login'};
	$val = 0 unless ($val);
	if ($$_{'salt'} && $val + $delay + 30 > time)
	{
	    return 1;
	}
	last;
    }
    return 0;
}

sub logout_user()
{
    my $u = shift;
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	$$_{'salt'} = '';
	return "User '$u' logged out!";
	last;
    }
    return -1;
}

sub logout_delay()
{
    return $delay;
}


sub new_session
{
    my $u = shift;
    my $p = shift;
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	if (length($$_{'passwd'}) > 16)
	{
	    my $hash = bcrypt($p,$$_{'passwd'});
	    return 0 unless ($hash eq $$_{'passwd'});
	    my $rnd = String::Random->new();
	    $$_{'salt'} = $rnd->randpattern('s' x 8);
      	    $$_{'last_login'} = time;
	    $$_{'session'} = bcrypt($hash.$$_{'salt'},$hash);
	    return $$_{'session'};
	}
	else
	{
	    my $hash = crypt($p,$$_{'passwd'});
	    return 0 unless ($hash eq $$_{'passwd'});
	    my $rnd = String::Random->new();
	    $$_{'salt'} = $rnd->randpattern('s' x 8);
      	    $$_{'last_login'} = time;
	    if ($debug)
	    {
		foreach my $key (keys %{$_})
		{
		    print $key,' ',$$_{$key},"\n";
		}
	    }
	    $$_{'session'} = crypt($hash.$$_{'salt'},$hash);
	    return $$_{'session'};
	}
	last;
    }
    return 0;
}



sub new_session_cas
{
    my $u = shift;
    my $p = 'dummy';
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	if (length($$_{'passwd'}) > 16)
	{
	    my $hash = bcrypt($p,$$_{'passwd'});
	    my $rnd = String::Random->new();
	    $$_{'salt'} = $rnd->randpattern('s' x 8);
      	    $$_{'last_login'} = time;
	    $$_{'session'} = bcrypt($hash.$$_{'salt'},$hash);
	    return $$_{'session'};
	}
	else
	{
	    my $hash = crypt($p,$$_{'passwd'});
	    my $rnd = String::Random->new();
	    $$_{'salt'} = $rnd->randpattern('s' x 8);
      	    $$_{'last_login'} = time;
	    if ($debug)
	    {
		foreach my $key (keys %{$_})
		{
		    print $key,' ',$$_{$key},"\n";
		}
	    }
	    $$_{'session'} = crypt($hash.$$_{'salt'},$hash);
	    return $$_{'session'};
	}
	last;
    }
    return 0;
}


sub debug
{
    my $val = shift;
    if (defined($val))
    {
        $debug = $val;
        if ($debug)
        {
            return 'Debug on';
        }
        else
        {
            return 'Debug off';
        }
    }
    if ($debug)
    {
        $debug = 0;
        return 'Debug off';
    }
    else
    {
        $debug = 1;
        return 'Debug on';
    }
}


sub user_auth
{
    my $ok = 0;
    my ($ru,$rp,$nu,$r,$m) = @_;
    if ($ru && $rp && $nu && $r)
    {
        my $uid = &check_pass($ru,$rp);
        return -1 unless ($uid);
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $nu);
	    $$_{'perm'}{$r} = $m;
	    $ok = $$_{'id'};
	    last;
	}
	tied(@users)->save;
    }
    return $ok;
}



sub changepwd
{
    my $ok = -1;
    my $u = shift;
    my $op = shift;
    my $np = shift;
    if (defined($np))
    {
	$ok = 0;
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $u);
	    next unless &check_pass($u,$op);
	    my $rnd = String::Random->new();
	    my $salt = $rnd->randpattern('s' x 16);
	    my $settings = '$2$'.$cost.'$'.en_base64($salt);
	    $$_{'passwd'} = bcrypt($np,$settings);
	    $$_{'last_change'} = time;
	    $$_{'reset'} = 0;
	    $ok = $$_{'id'};
	    last;
	}
	tied(@users)->save;
    }
    return $ok;
}

sub resetpwd
{
    my $ok = 0;
    my $ru = shift;
    my $rp = shift;
    my $nu = shift;
    if (defined($nu))
    {
        my $uid = &check_pass($ru,$rp);
	return -1 unless ($uid);
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $nu);
	    my $email = $$_{'email'};
	    my $pass = int(999999 + rand(9000000));
	    my $rnd = String::Random->new();
	    my $salt = $rnd->randpattern('s' x 16);
	    my $settings = '$2$'.$cost.'$'.en_base64($salt);
	    $uid = $$_{'id'};
	    ### Set new paswd ###
	    $$_{'passwd'} = bcrypt($pass,$settings);
	    $$_{'last_change'} = time;
	    $$_{'reset'} = 1;
	    ### Emil new passwd to user ###
	    my $string = "\n\nNew password: $pass\n\n";
	    eval {
		$ok = &AFM::mail($email,$string);
		die "Mail not sent!" unless ($ok);
	    };
	    if ($@)
	    {
		print $@;
		&errorlog($@);
	    }
	    $ok = $uid;
	    last;
	}
	tied(@users)->save;
    }
    return $ok;
}

sub resetpwd_cmd
{
    my $ok = 0;
    my $nu = shift;
    if (defined($nu))
    {
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $nu);
	    my $email = $$_{'email'};
	    my $pass = int(999999 + rand(9000000));
	    my $rnd = String::Random->new();
	    my $salt = $rnd->randpattern('s' x 16);
	    my $settings = '$2$'.$cost.'$'.en_base64($salt);
	    ### Set new paswd ###
	    $$_{'passwd'} = bcrypt($pass,$settings);
	    $$_{'last_change'} = time;
	    $$_{'reset'} = 1;
	    $ok = "\n\nNew password for $nu: $pass\n\n";
	    last;
	}
	tied(@users)->save;
    }
    return $ok;
}



sub multiauth($$)
{
    my $ok = 0;
    if (@_ > 1)
    {
        my $u = shift;
        my $p = shift;
      USER:
	foreach (@users)
	{
	    next USER unless ($$_{'rid'} eq $u);
	    next USER unless &check_pass($u,$p);
	    my $ret = '';
	    while (@_ > 1)
	    {
		$ok = $$_{'id'} if ($$_{'admin'});
		my $r = shift;
		my $m = shift;
		unless ($ok)
		{
		  PERM:
		    foreach my $key (keys %{$$_{'perm'}})
		    {
			next PERM unless ($key eq $r);
			$ok = $$_{'id'} if ($m <= $$_{'perm'}{$key});
			last PERM;
		    }
		}
		$ret .= $ok."\n";
	    }
	    chomp $ret;
	    $ok = $ret;
	    last USER;
	}
        $ok = 0 if ($ok == -1); ### Default deny ##
    }
    return $ok;
}



sub checkauth($$)
{
    my $ok = 0;
    if (@_ > 1)
    {
        my $u = shift;
        my $p = shift;
      USER:
	foreach (@users)
	{
	    next USER unless ($$_{'rid'} eq $u);
	    next USER unless &check_pass($u,$p);
	    $ok = $$_{'id'};
	    if ($$_{'admin'})
	    {
		### Default allow for admin ###
		last USER;
	    }
	    while ($ok && @_ > 1)
	    {
		$ok = 0; ## Default deny ##
		my $r = shift;
		my $m = shift;
	      PERM:
		foreach my $key (keys %{$$_{'perm'}})
		{
		    next PERM unless ($key eq $r);
		    $ok = $$_{'id'} if ($m <= $$_{'perm'}{$key});
		    last PERM;
		}
	    }
	    last USER;
	}

    }
    return $ok;
}

sub email($)
{
    my $ok = -1;
    my $u = shift;
    return $ok unless ($u);
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	$ok = $$_{'email'};
	last;
    }
    return $ok;
}


sub get_per($$$$)
{
    my $ok = 0;
    if (@_ > 1)
    {
	my $uid = 0;
	my $admin = 0;
        my $u = shift;
        my $p = shift;
	foreach (@users)
	{
	    next unless ($$_{'rid'} eq $u);
	    next unless &check_pass($u,$p);
	    $uid = $$_{'id'};
	    $admin = $$_{'admin'};
	    last;
	}
	if ($uid && $admin)
	{
	    my $nu = shift;
	    my $r = shift;
	    my $m = shift;
	    if ($nu && $r && $m)
	    {
		$ok = 0;
		my $acc = -1;
		foreach (@users)
		{
		    next unless ($nu eq $$_{'rid'});
		    foreach my $key (keys %{$$_{'perm'}})
		    {
			$acc = $$_{'perm'}{$key};
		    }
		    last;
		}
		### Allow if user has equal or higher permision ###
		$ok = $acc if ($m <= $acc);
	    }
	}
    }
    return $ok;
}

sub checkuser_sso($$)
{
    my $ok = "0\n";
    return $ok, unless ($sso);
    my $name = shift;
    my $pass = shift;
    my $dirname = '/usr/local/bin/celltest/sso/';
    return $ok unless (-d $dirname);
    ### Sanitize name and passwd paramters ###
    if ($name =~ /(\w+)/)
    {
        $name = $1;
    }
    else
    {
        $name = '';
    }
    if ($pass =~ /([\w\$\.\/\+\\\-\%\=]+)/)
    {
        $pass = $1;
    }
    else
    {
        $pass = '';
    }
    ## Only try if name and passwd-hash exists ##
    return $ok unless ($name && $pass);
    eval {
        my $token = '';
        opendir my $dir, $dirname or die "Cannot open directory $dirname: $!";
        my @files = grep {!/^\./} readdir $dir;
        closedir $dir;
        my $uid = &isuser($name);
        foreach my $file (@files)
        {
            next if ($file =~ /\~/);
            my $f = $dirname.$file;
            next unless (-e $f && -x $f);
            my $loginok = 0;
            my $cmd = "$f $name '$pass'";
            my $str = `$cmd`;
            if (defined $str)
            {
                chomp $str;
                $loginok = $str;
            }
            if ($loginok)
            {
		foreach (@users)
		{
		    next unless ($$_{'rid'} eq $name);
		    if (length($$_{'passwd'}) > 16)
		    {
			my $hash = bcrypt($pass,$$_{'passwd'});
			my $rnd = String::Random->new();
			$$_{'salt'} = $rnd->randpattern('s' x 8);
			$$_{'last_login'} = time;
			$token = bcrypt($hash.$$_{'salt'},$hash);
		    }
		    else
		    {
			my $hash = crypt($pass,$$_{'passwd'});
			my $rnd = String::Random->new();
			$$_{'salt'} = $rnd->randpattern('s' x 8);
			$$_{'last_login'} = time;
			if ($debug)
			{
			    foreach my $key (keys %{$_})
			    {
				print $key,' ',$$_{$key},"\n";
			    }
			}
			$token = crypt($hash.$$_{'salt'},$hash);
		    }
		    last;
		}
            }
            next unless ($token);
            $ok = $uid."\n".$token;
            last;
        }
    };
    if ($@)
    {
        warn $@;
    }
    return $ok;
}

sub checkuser($$)
{
    my $ok = 0;
    my $u = shift;
    my $p = shift;
    return &check_pass($u,$p);
}

sub pwdstatus($$)
{
    my $ok = 0;
    my $u = shift;
    my $p = shift;
    return 0 unless ($u && $p);
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	next unless &check_pass($u,$p);
	$ok = $$_{'id'};
	$ok = 'RESET' if ($$_{'reset'});
	my $time = (time - $$_{'last_change'})/86400;
	$ok = 'EXPIRED' if ($time > $expire);
	last;
    }
    return $ok;
}


sub get_users
{
    my @lusers = ();
    my $u = shift;
    my $p = shift;
    my $ok = 0;
    foreach (@users)
    {
	push @lusers,$$_{'rid'};
    }
    return join("\n",@lusers) if (&check_pass($u,$p));
    return -1;
}


sub isadmin
{
    my $ok = 0;
    my $u = shift;
    my $p = shift;
    return $ok unless ($u && $p);
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	next unless &check_pass($u,$p);
	$ok = $$_{'admin'};
	last;
    }
    return $ok;
}

sub get_admin
{
    my $ok = 0;
    my $u = shift;
    my $p = shift;
    my $nu = shift;
    return 0 unless ($u && $p && $nu);
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	next unless &check_pass($u,$p);
	$ok = $$_{'admin'};
	last;
    }
    return 0 unless ($ok);
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $nu);
	$ok = $$_{'admin'};
	last;
    }
    return $ok;
}

sub deleteuser
{
    my $ok = 0;
    #### NB Deleteuser does not delete, it merely sets inactive! ###
    my $ru = shift;
    my $rp = shift;
    my $nu = shift;
    if (defined($nu))
    {
        $ok = 0;
        foreach (@users)
        {
	    next unless ($$_{'rid'} eq $ru);
	    next unless &check_pass($ru,$rp);
            next unless ($$_{admin} == 1);
            $ok = 1;
            last;
        }
        ### Only superusers continue ###
        return -1 unless ($ok);
        foreach (@users)
        {
	    next unless ($$_{'rid'} eq $nu); 
	    $$_{'active'} = 0;
	    $ok = $$_{'id'};
	    last;
        }
	tied(@users)->save;
    }
    return $ok;
}

sub root_access
{
    my $ok = 0;
    my $ru = shift;   ### Current user
    my $rp = shift;   ### Current users passwd
    my $nu = shift;   ### Other user whose permissions is to be set
    my $m = shift;    ### Root bit to be set
    if ($ru && $rp && $nu)
    {
        $ok = 0;
        foreach (@users)
        {
	    next unless ($$_{'rid'} eq $ru);
	    next unless &check_pass($ru,$rp);
            next unless ($$_{admin} == 1);
            $ok = 1;
	    last;
        }
        ### Only superusers continue ###
        return -1 unless ($ok);
        foreach (@users)
        {
	    next unless ($$_{'rid'} eq $nu); 
	    $$_{'admin'} = $m;
	    $ok = $$_{'id'};
	    last;
        }
	tied(@users)->save;
    }
    return $ok;
}

sub adduser
{
    my $ok = 0;
    my $nu = shift; # new user rid
    my $nn = shift; # new user name
    my $email = shift;
    ### Sets default email address ###
    $email = $nu.'@dtu.dk' unless ($email); 
    if ($nu && $nn)
    {
	my $max = 0;
	foreach (@users)
	{
	    ### Find next id ###
	    $max = $$_{'id'} if ($$_{'id'} > $max);
	    ### Check if user already exsists ###
	    return 0 if ($$_{'rid'} eq $nu);
	}
	$max++;
	my $time = time;
	my $pass = int(999999 + rand(9000000));
	my $rnd = String::Random->new();
	my $salt = $rnd->randpattern('s' x 16);
	my $settings = '$2$'.$cost.'$'.en_base64($salt);
	my $md5 = bcrypt($pass,$settings);
	my %h2 = ();
	my %h = ('id'=>$max,'rid'=>$nu,'name'=>$nn,'email'=>$email,'passwd'=>$md5,'admin'=>0,'active'=>1,'last_change'=>$time,'reset'=>1,'perm'=>\%h2);
	push @users,\%h;
        ### Emil new passwd to user ###
	my $string = "\n\nNew password: $pass\n\n";
	eval {
		$ok = &AFM::mail($email,$string);
		die "Mail not sent!" unless ($ok);
	};
	if ($@)
	{
	    print $@;
		&errorlog($@);
	}
	tied(@users)->save;
	$ok = $max;
    }
    return $ok;
}

sub adduser_nomail
{
    my $ok = 0;
    my $nu = shift; # new user rid
    my $nn = shift; # new user name
    my $email = 'sofc';  # Default so mails can be sent to local sufc user
    ### Sets default email address ###
    if ($nu && $nn)
    {
	my $max = 0;
	foreach (@users)
	{
	    ### Find next id ###
	    $max = $$_{'id'} if ($$_{'id'} > $max);
	    ### Check if user already exsists ###
	    return 0 if ($$_{'rid'} eq $nu);
	}
	$max++;
	my $time = time;
	my $pass = int(999999 + rand(9000000));
	my $rnd = String::Random->new();
	my $salt = $rnd->randpattern('s' x 16);
	my $settings = '$2$'.$cost.'$'.en_base64($salt);
	my $md5 = bcrypt($pass,$settings);
	my %h2 = ();
	my %h = ('id'=>$max,'rid'=>$nu,'name'=>$nn,'email'=>$email,'passwd'=>$md5,'admin'=>0,'active'=>1,'last_change'=>$time,'reset'=>1,'perm'=>\%h2);
	push @users,\%h;
	$ok = "\n\nNew password for user $nn: $pass\n\n";
	tied(@users)->save;
    }
    return $ok;
}

sub isuser($)
{
    my $u = shift;
    my $ok = 0;
    return 0 unless ($u);
    foreach (@users)
    {
	next unless ($$_{'rid'} eq $u);
	$ok = $$_{'id'};
	last;
    }
    return $ok;
}


sub shutdown
{
    print "\nShutting down server!\n";
    $pid = 0;
    tied(@users)->save;
    tied(@tasks)->save;
    return "Shutting down server!";
}

sub my_sigint
{
    #### Save data before exit ####
    tied(@users)->save;
    tied(@tasks)->save;
    flock(FH,LOCK_UN);
    close(FH);
    die "\n\nShutting down server due to SIGINT!\n";
}



sub check_pass_old($$)
{
    my $name = shift;
    my $pass = shift;
    return 0 unless ($name && $pass);
    my $res = 0;
    foreach my $struct (@users)
    {
	next unless ($$struct{'rid'} eq $name);
	if ($debug)
	{
	    foreach my $key (keys %{$struct})
	    {
		print $key,' ',$$struct{$key},"\n";
	    }
	    print "Key: $pass\n";
	}
	unless ($$struct{'salt'} && $$struct{'last_login'} + $delay + 30 > time)
	{
	    $$struct{'salt'} = '';
	    last;
	}
	print "Passwd length: ".length($$struct{'passwd'})."\n" if ($debug);
	if (length($$struct{'passwd'}) > 16)
	{
	    my $hash = bcrypt($$struct{'passwd'}.$$struct{'salt'},$$struct{'passwd'});
	    print "Hash: $hash\n" if ($debug);
	    unless ($pass eq $hash)
	    {
		$$struct{'salt'} = '';
		last;		
	    }
	}
	else
	{
	    my $hash = crypt($$struct{'passwd'}.$$struct{'salt'},$$struct{'passwd'});
	    unless ($pass eq $hash)
	    {
		$$struct{'salt'} = '';
		last;		
	    }
	}
	$$struct{'last_login'} = time;
	$res = $$struct{'id'};
	last;
    }
    return $res;
}


sub check_pass($$)
{
    my $name = shift;
    my $pass = shift;
    return 0 unless ($name && $pass);
    my $res = 0;
    foreach my $struct (@users)
    {
	next unless ($$struct{'rid'} eq $name);
	if ($debug)
	{
	    foreach my $key (keys %{$struct})
	    {
		print $key,' ',$$struct{$key},"\n";
	    }
	    print "Key: $pass\n";
	}
	unless ($$struct{'salt'} && $$struct{'last_login'} + $delay + 30 > time)
	{
	    $$struct{'salt'} = '';
	    last;
	}
	print "Passwd length: ".length($$struct{'passwd'})."\n" if ($debug);
	if (length($$struct{'passwd'}) > 16)
	{
	    my $hash = $$struct{'session'};
	    print "Hash: $hash\n" if ($debug);
	    unless ($pass eq $hash)
	    {
		$$struct{'salt'} = '';
		last;		
	    }
	}
	else
	{
	    my $hash = $$struct{'session'};
	    unless ($pass eq $hash)
	    {
		$$struct{'salt'} = '';
		last;		
	    }
	}
	$$struct{'last_login'} = time;
	$res = $$struct{'id'};
	last;
    }
    return $res;
}
