#!/usr/bin/perl
# $Id: report-server,v 1.36 2018/06/08 05:57:58 sqko Exp $
use strict;
use warnings;
use RFC::Header;
use RFC::Main;
use RFC::Rig;
use Sys::Hostname;
use Encode;
use Crypt::OpenSSL::Random;
use Crypt::OpenSSL::RSA;
use Crypt::CBC;
use MIME::Base64;
use SemaforeFile;
use IO::Socket::INET;
use File::Touch;
my %last_init = ();
my $debug = 0;
my $pid = $RFC::Header::homedir.'report-server.pid';
my $ssl = 0;
my $str = &get_cv('passwds','force_encryption');
$ssl = 1 if ($str && $str =~ /yes/i);
our $this_host = hostname;
if (scalar(@ARGV) > 0)
{
    for(my $x = 0; $x < scalar(@ARGV);$x++)
    {
	if ($ARGV[$x] =~ /--version/)
	{
	    print "$0 is: $RFC::Header::VERSION\n";
	    exit 0;
	}
	if ($ARGV[$x] =~ /--debug/)
	{
	    $debug = 1;
	}
        if ($ARGV[$x] =~ /--ssl/)
        {
            $ssl = 1;
        }
        if ($ARGV[$x] =~ /--host/)
        {
            $this_host = $ARGV[$x+1];
        }
    } 
}
if (-e $pid)
{
    unlink $pid;
    sleep(1);
}
touch($pid);


chomp $this_host;
our $port      = 4040;
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);

my $fn = $RFC::Header::homedir.'info_table.txt';
my $lock = $RFC::Header::homedir.'info.lock';
my $file = SemaforeFile->new($fn,$lock);

### Set up command list ###
our %cmdlst = ();
$cmdlst{'debug'} = \&debug;
$cmdlst{'search'} = \&search;
$cmdlst{'rigs'} = \&rigs;
$cmdlst{'is_test'} = \&is_test;
$cmdlst{'rig_task'} = \&rig_task;
$cmdlst{'rig_auth'} = \&rig_auth;
$cmdlst{'servers'} = \&servers;
$cmdlst{'list_servers'} = \&list_servers;
$cmdlst{'active_rigs'} = \&active_rigs;
$cmdlst{'quit'} = \&shutdown;
$cmdlst{'version'} = \&version;
$cmdlst{'is_report'} = \&is_report;
$cmdlst{'last_user'} = \&last_user;

my $rsa = undef;
## Create RSA keypair and store keys in /home/ABFdb/ ###
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);
}
unless ($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 0644,$prifile->filename();
}
my $rsa_pub = Crypt::OpenSSL::RSA->new_public_key(join("\n",$pubfile->readlines()));
my $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 (-e $pid);
}

exit;

sub report_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 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 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;
    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 = report_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 ($ssl && $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 ($@)
        {
	    my $errstr = "Error processing request from '$client': $@";
            &errorlog($errstr);
            warn $errstr;
        }
    }
    elsif ($ssl && $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 ($@)
        {
	    my $errstr = "Error processing request from '$client': $@";
            &errorlog($errstr);
            warn $errstr;
        }
    }
    elsif ($ssl)
    {
	$cmdstr = '';
    }
    elsif ($str)
    {
        ### Default if no encryption ###
	$cmdstr = $str;
    }
    ($cmd,@args) = split(/\t+/,$cmdstr);
    eval {
	if ($cmdlst{$cmd})
	{
	    my $ok = $cmdlst{$cmd}->(@args);
	    ## Hack as encrypting a empty string or 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 ($ssl && 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));
		if ($keys{$client})
		{
		    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
		{
		    warn "No encryption key found for client '$client', aborting!\n";
		}
	    }
	    elsif ($ssl)
	    {
                ### for short strings: Transmit request as base64 encoded RSA encrypted request string ###
		print "Encrypting response using RSA only\n" if ($debug && $debug > 1);
		if ($keys{$client})
		{
		    print $remote_host encode_base64($keys{$client}->encrypt($ok));
		}
		else
		{
		    warn "No encryption key found for client '$client', aborting!\n";
		}
	    }
            else
            {
                print "Transmitting in plaintext\n" if ($debug && $debug > 1);
                print $remote_host $ok;
            }
	} 
	else
	{
            print "Unknown command: '$cmd'\n";
            if ($ssl)
            {
                print $remote_host encode_base64($keys{$client}->encrypt(-1));
            }
            else
            {
                print $remote_host -1;
            }
	}
    };
    if ($@)
    {
	my $errstr = "Error processing request from '$client': $@";
	&errorlog($errstr);
	warn $errstr;
    }
    shutdown($remote_host,1);
}

sub rig_auth
{
    my $rig = shift;
    my $user = shift;
    my $res = '';
    if ($user && $rig && $rig =~ /(\d+)/)
    {
	$rig = $1;
	if ($user =~ /(\w+)/)
	{
	    $user = $1;
	}
	else
	{
	    $user = '_nobody_';
	}
      OUTER:
	foreach (split(/\t/,&rigs()))
	{
	    if ($_ == $rig)
	    {
		my $r = RFC::Rig->new($rig);
		my $eqid = $r->get_cv('main','equipmentid');
		my $remote = $r->get_cv('main','authorisation');
		if ($eqid && $remote && $remote =~ /remote/i)
		{
		    ### Use remote autorisation method ##
		    $res = &RFC::Main::passwd_client('equip_auth',$user,$eqid);
		    last OUTER;
		}
		my $taskid = &get_cv('safety_task_access','rig'.$rig);
		unless (defined($taskid) && $taskid)
		{
		    $res = 1;
		    last OUTER;
		}
		if ($taskid =~ /NONE/)
		{
		    $res = 1;
		    last OUTER;
		}
		foreach my $tid (split(/\s*\,\s*/,$taskid))
		{
		    my $res = &RFC::Main::passwd_client('check_task_status',$user,$tid);
		    if (!defined($res) || $res < 0)
		    {
			&errorlog("Check_task_status for task $tid did not return expected value: returned: $res instead!");
			$res = 0;
			last OUTER;
		    }
		    $res = 0 unless ($res);
		}
		last OUTER;
	    }
	}
    }
    return $res;
}



sub last_user
{
    my $rig = shift;
    my $res = '';
    if ($rig && $rig =~ /(\d+)/)
    {
	$rig = $1;
	foreach (split(/\t/,&rigs()))
	{
	    if ($_ == $rig)
	    {
		my $r = RFC::Rig->new($rig);
		## Reinitialise rig instance to reload if new test ##
		my $t = $last_init{$rig};
		unless ($t && $t > time - 10000)
		{
		    $r->init();
		    $last_init{$rig} = time;
		}
		my $dir = $r->webdir();
		my $file = $dir.'proglog';
		eval {
		    my $f = SemaforeFile->new($file);
		    $f->open_readback();
		    while (my $line = $f->readline() && !$res)
		    {
			$line = $f->readline();
			if ($line && $line =~ /user\s+\'([a-zA-Z]+)\'/)
			{
			    $res = $1;
			    last;
			}
		    }
		    $f->close;
		};
		if ($@)
		{
		    &errorlog($@);
		    warn $@;
		}
		last;
	    }
	}
    }
    return $res;
}

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 is_report
{
    my $rig = shift;
    my $test = shift;
    unless ($rig && $test && $rig =~ /\d/ && $test =~ /\d/)
    {
	return '';
    }
    $rig += 0;
    $test += 0;
    my $str = $rig.'test'.$test;
    my $cell = '';
    $file->lock_sh;
    $file->open_read;
    while (my $st = $file->readline)
    {
	next unless ($st =~ /\s$str\s/);
	chomp $st;
	$st =~ /\s$str\s+([\w\-\.]+)/;
	$cell = $1;
	last;
    }
    $file->close;
    $file->lock_un;	
    if ($cell)
    {
	my $st = '';
	my $path = $RFC::Header::publicdir.'rig'.$rig.'/'.$rig.'test'.$test.'/';
	my $psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.ps';
	if (-e($psfile))
	{
	    $st = $cell . ' REPORT';
	}
	$psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.pdf';
	if (-e($psfile))
	{
	    $st = $cell .' PDF';
	}
	my $f = $path . 'report.fin';
	if (-e($f))
	{
	    $st .= ' FINISHED';
	}
	$st .= "\n";
	return $st;
    }
    return '';
}

sub search
{
    my $str = shift;
    $file->lock_sh;
    $file->open_read;
    my $res = '';
    while (my $st = $file->readline)
    {
	next unless ($st =~ /$str/);
	chomp $st;
	$st =~ /\s(\d+)test(\d+)\s+([\w\-\.]+)/;
	my $rig = $1+0;
	my $test = $2+0;
	my $cell = $3;
	$st .= '#';
	my $path = $RFC::Header::publicdir.'rig'.$rig.'/'.$rig.'test'.$test.'/';
	my $psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.ps';
	if (-e($psfile))
	{
	    $st .= ' REPORT';
	}
	$psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.pdf';
	if (-e($psfile))
	{
	    $st .= ' PDF';
	}
	my $f = $path . 'report.fin';
	if (-e($f))
	{
	    $st .= ' FINISHED';
	}
	$st .= "\n";
	$res .= $st;
    }
    $file->close;
    $file->lock_un;
    chomp $res;
    return $res;
}

sub rig_task
{
    my $rig = shift;
    my $taskid = &get_cv('safety_task_access','rig'.$rig);
    chomp $taskid if ($taskid);
    $taskid = '' unless (defined($taskid));
    print $taskid,"\n" if ($debug);
    return $taskid;
}

sub active_rigs
{
    return join("\t",sort {$a <=> $b} (RFC::Main::get_rigs()));
}

sub servers
{
    my @list = split(/\s*\,\s*/,&get_cv('servers','server_names'));
    return join("\t",@list);
}

sub list_servers
{
    my $str = &get_cv('servers','list_server_names');
    $str = &get_cv('servers','listserver') unless ($str);
    my @list = split(/\s*\,\s*/,$str);
    return join("\t",@list);
}

sub rigs
{
    my @list = &RFC::Main::get_rigs(hostname);
    if (@list)
    {
	return join("\t",sort {$a <=> $b} @list);
    }
    else
    {
	return join("\t",sort {$a <=> $b} (RFC::Main::get_rigs()));
    }
}


sub is_test
{
    my $rig = shift;
    my $test = shift;
    my $found = 0;
    my @list = &RFC::Main::get_rigs(hostname);
    @list = RFC::Main::get_rigs() unless (@list);
    foreach my $r (@list)
    {
	next unless ($r == $rig);
	my $path = $RFC::Header::publicdir.'rig'.$rig.'/'.$rig.'test'.$test.'/';
	$found = 1 if (-d $path);
	last;
    }
    return $found;
}


sub version
{
    return $RFC::Header::VERSION;
}

sub shutdown
{
    unlink $pid;
    return "Shutting down server";
}

