#!/usr/bin/perl
# $Id: CGI-server,v 1.49 2024/05/28 07:57:30 sqko Exp $
use strict;
use warnings;
use RFC::Rig;
use RFC::Header;
use RFC::Main;
use POSIX qw(:sys_wait_h);
use File::Copy;
use IO::Socket;
use SemaforeFile;
use Fcntl qw/:DEFAULT :flock/;
my $debug = 0;
my $compat = 0;
my $VERSION = '$Revision: 1.49 $';
my $PROGRAM = 'CGI-server';

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] =~ /--compatibility/)
	{
	    $compat = 1;
	}
    } 
}
if (scalar(@ARGV) < 1)
{
    die "not enough parameters for $0\n"; 
}


our $rig = RFC::Rig->new(shift);
exit unless ($rig->check_run);
our %cache_data = ();
my $timeslot_wait = SemaforeFile->new('/home/celltest/Rig_'.$rig->name.'_timeslot_wait');
my $timeslot_start = SemaforeFile->new('/home/celltest/Rig_'.$rig->name.'_timeslot_start');

our $port    =  get_cv('global','CGI_baseaddress')+$rig->name;
our $user      = "nobody";
$user = 'rig'.$rig->name;

# 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";
}

# Initialize C structure
our $server_struct = pack( "S n a4 x8", AF_INET, $port, INADDR_ANY );

# Set up socket
eval {
    our $proto = ( getprotobyname("tcp") )[2];
    socket( SOCK, PF_INET, SOCK_STREAM, $proto )|| die "Failed to initialize socket: $!\n";
    # Bind to address/port and set up pending queue
    setsockopt( SOCK, SOL_SOCKET, SO_REUSEADDR, 1 )  || die "setsockopt() failed: $!\n";
    bind( SOCK, $server_struct ) || die "bind() failed: $!\n";
    listen( SOCK, SOMAXCONN ) || die "listen() failed: $!\n";
};
if ($@)
{
    if ($@ =~ /failed: Address already in use/)
    {
	## Prevent bind errors to cause mails to be sent
	print $@;
	exit;
    }
    else
    {
	die $@;
    }
}

our %cmdlst = ();
$cmdlst{'quit'} = \&quit;
$cmdlst{'ping'} = \&ping;
$cmdlst{'version'} = \&version;
$cmdlst{'measure'} = \&measure;
$cmdlst{'iv'} = \&iv;
$cmdlst{'stop_iv'} = \&stop_iv;
$cmdlst{'custom'} = \&custom;
$cmdlst{'stop_custom'} = \&stop_custom;
if (-d '/usr/local/bin/RFCfurnace')
{
    $cmdlst{'start_furnace'} = \&start_furnace;
    $cmdlst{'stop_furnace'} = \&stop_furnace;
}
$cmdlst{'cmdlog'} = \&cmdlog;
$cmdlst{'logbook'} = \&logbook;
$cmdlst{'debug'} = \&debug;
$cmdlst{'impedance_ok'} = \&imp_ok;
$cmdlst{'touch_file'} = \&touch;
$cmdlst{'crontab_read'} = \&crontab_read;
$cmdlst{'crontab_file'} = \&crontab_file;
$cmdlst{'timeslot_begin'} = \&timeslot_begin;
$cmdlst{'timeslot_end'} = \&timeslot_end;
$cmdlst{'get_data_cache'} = \&get_data_cache;
$cmdlst{'set_data_cache'} = \&set_data_cache;
$cmdlst{'create_data_archive'} = \&create_zip;
if ($compat)
{
    $cmdlst{'current'} = \&current;
    $cmdlst{'voltage'} = \&voltage;
    $cmdlst{'set_temp'} = \&temp;
    $cmdlst{'set_ramp'} = \&ramp;
    $cmdlst{'gas'} = \&gas;
    $cmdlst{'water'} = \&water;
    $cmdlst{'relay'} = \&relay;
    $cmdlst{'set_H2mailfile'} = \&set_H2mailfile;
    $cmdlst{'set_mailfile'} = \&set_mailfile;
    $cmdlst{'unlink_mailfile'} = \&unlink_mailfile;
    $cmdlst{'unlink_H2mailfile'} = \&unlink_H2mailfile;
}


# Deal with requests #
our $remote_host;
our $dot_addr;
for ( ; ; ) {

    # Grab next pending request
    #
    $remote_host = accept( NEWSOCK, SOCK );
    die "accept() error: $!\n" unless ($remote_host);
    ### Process request ###
    &request();
    close(NEWSOCK);
}

# Close master socket
close(SOCK);
exit;


sub request
{
    # Resolve hostname of remote machine before calling chroot()
    our $raw_addr = ( unpack( "S n a4 x8", $remote_host ) )[2];
    $dot_addr = join ( ".", unpack( "C4", $raw_addr ) );
    our $name = ( gethostbyaddr( $raw_addr, AF_INET ) )[0];
    # Read client request and get $path
    our @args = ();
    our $cmd = undef;
    my $ltime = localtime;
    print "$ltime\t$dot_addr\t$name\t" if ($debug);
    my $str = <NEWSOCK>;
    chomp $str;
    ($cmd,@args) = split(/\t+/,$str);
    if ($cmdlst{$cmd})
    {
        my $ok = $cmdlst{$cmd}->(@args);
	chomp $ok;
        print "'$cmd'\tResult: $ok\n" if ($debug);
        print NEWSOCK $ok;
    }
    else
    {
        print "Unknown command: '$cmd'\n";
        print NEWSOCK -1;
    }
}

sub quit
{
    print NEWSOCK "quit command received, exiting\n";
    close NEWSOCK;
    exit;
}

sub ping
{
    if ($compat)
    {
	return "$0 listning on port $port running in compatibility mode";
    }
    else
    {
	return "$0 listning on port $port ";
    }
}

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

sub create_zip
{
    my $test = shift;
    my $user = shift;
    my $email = &RFC::Main::passwd_client('email',$user);
    if ($email)
    {
	$email =~ s/@/\\@/g;
    }
    my $cmd = join(' ','/usr/local/bin/celltest/create_all_data.bash',$rig->name,$test,$email);
    if ($debug)
    {
	$cmd .= " > /dev/null &";
    }
    else
    {
	$cmd .= " > /dev/null 2> /dev/null &";
    }
    system($cmd);
    return 'Creating data archive for '.$rig->name.'test'.$test;
}


sub get_data_cache
{
    my $dev = shift;
    my $name = shift;
    my $delay = shift;
    $delay = 30 unless ($delay);
    return undef unless ($dev && $name && $delay);
    if (exists($cache_data{$dev.'_'.$name}) && exists($cache_data{$dev.'_'.$name}{'time'}) && exists($cache_data{$dev.'_'.$name}{'data'}))
    {
	return $cache_data{$dev.'_'.$name}{'data'} if ($cache_data{$dev.'_'.$name}{'time'} > time - $delay);
    }
    return '';
}

sub set_data_cache($$$)
{
    my $dev = shift;
    my $name = shift;
    my $value = shift;
    return undef unless ($dev && $name);
    $cache_data{$dev.'_'.$name}{'data'} = $value;
    $cache_data{$dev.'_'.$name}{'time'} = time;
    return '';
}


sub timeslot_begin()
{
    $timeslot_wait->lock_ex();
    my $fn = $timeslot_wait->filename;
    unlink($fn) if (-e $fn);
    ## Use unsafe open/close as timeslot_start shares semafore with timeslot_wait ###
    $timeslot_start->open_write_unsafe();
    $timeslot_start->close_unsafe();
    $timeslot_wait->lock_un();
    return "Ok\n";
}


sub timeslot_end()
{
    $timeslot_start->lock_ex();
    my $fn = $timeslot_start->filename;
    my $isfile = 0;
    if (-e $fn)
    {
	$isfile = 1;
	unlink($fn) 
    }
    $timeslot_start->lock_un();
    if ($isfile)
    {
	$rig->proglog("Warning! Timeslot ended before synchronised commands had finished, some commands may be inclomplete!",$PROGRAM);
	return "Time slot semafore removed\n";
    }
    else
    {
	return "Time slot semafore already removed!\n";
    }
}

sub crontab_read
{
    my $cmd =  '/usr/bin/crontab -l 2>/dev/null';
    return `$cmd`;
}

sub crontab_file
{
    my $filename = shift;
    my $cmd = '/usr/bin/crontab '.$filename. ' 2>&1';
    my $res = `$cmd`;
    $res = 'Crontab installed' if ($res =~ /^[\s\t\n]*$/);
    return $res;
}


sub touch
{
    my $file = shift;
    my $f = SemaforeFile->new($userdir.'rig'.$rig->name.'/'.$file,'/home/celltest/Gas_rig'.$rig->name.'.lock');
    $f->lock_ex;
    unless (-e $f->filename)
    {
        ### Create file with rw for all           ###
        ### Yes I know 666 is the number of evil! ###
	$f->writeline('');
    }
    chmod 0666, $f->filename;
    $f->unlock;
    return 'OK';
}

sub custom
{
    my $file = shift;
    my $user = shift;
    my $errfile = $rig->webdir().'/program_error.txt';
    my $cmd = $RFC::Header::libdir.'custom_prog.pl '.$rig->name.' '.$file.' '.$user.' >/dev/null 2>>'.$errfile.' &';
    system($cmd);
    return "Program $file activated";
}

sub stop_custom
{
    my $cmd = '/bin/ps -efl | /bin/grep custom_prog.pl';
    my @list = `$cmd`;
    print @list if ($debug);
    my $r = $rig->name;
    for my $st (@list)
    {
	chomp $st;
	### Finding the right processid to kill ###
	if ($st =~ /^\d+\s+\w+\s+rig$r\s+(\d+)\s+.*\/custom_prog\.pl\s+$r\s+/ )
	{
	    my $pid = $1+0;
	    ### Using a SIGINT (kill -s 2) to emulate a Ctrl+C to custom_prog.pl ###
	    my $command = "/bin/kill -s 2 $pid &";
	    my $res = &run_cmd($command);
	    return "Custom program $pid stopped with kill -2 signal, result: $res";
	}   
    }
    return "No process found to stop!";
}


sub start_furnace
{
    my $file = shift;
    my $user = shift;
    my $errfile = $rig->webdir().'/furnace_error.txt';
    my $cmd = '/usr/local/bin/RFCfurnace/run_furnace.pl '.$rig->name.' '.$file.' '.$user.' >/dev/null 2>>'.$errfile.' &';
    system($cmd);
    return "Program $file activated";
}

sub stop_furnace
{
    my $cmd = '/bin/ps -efl | /bin/grep run_furnace.pl';
    my @list = `$cmd`;
    print @list if ($debug);
    my $r = $rig->name;
    for my $st (@list)
    {
	chomp $st;
	### Finding the right processid to kill ###
	if ($st =~ /^\d+\s+\w+\s+rig$r\s+(\d+)\s+.*\/run_furnace\.pl\s+$r\s+/ )
	{
	    my $pid = $1+0;
	    ### Using a SIGINT (kill -s 2) to emulate a Ctrl+C to custom_prog.pl ###
	    my $command = "/bin/kill -s 2 $pid &";
	    my $res = &run_cmd($command);
	    return "Furnace program $pid stopped with kill -2 signal, result: $res";
	}   
    }
    return "No process found to stop!";
}

sub iv
{
    my $ivprog = $rig->get_cv('IV_control','iv_program');
    if ($ivprog)
    {
	$ivprog =~ s/[\s\r\n\t]+/ /g;
	my $command = 'env DISPLAY=dumb '. $ivprog.'  > /dev/null 2> /dev/null &';
	system($command);	
    }
    else
    {
	my $command = 'env DISPLAY=dumb '. $RFC::Header::libdir.'iV_curve.pl '.$rig->name.' > /dev/null 2> /dev/null &';
	system($command);	
    }
    return "i-V curve started";
}

sub stop_iv
{
    $rig->iv_stop;
    return "Stopping any running i-V curve";
}


sub water
{
    my $name = shift;
    my $status = shift;
    my $controler = $rig->water($name);
    return "No control found for water bubler '$name'!" unless ($controler);
    return $controler->setstatus($status);
}

sub gas
{
    my $name = shift;
    my $flow = shift;
    my $controler = $rig->gas($name);
    return "No gas control found for gas '$name'!" unless ($controler);
    $flow = '' unless defined ($flow);
    return "Illegal flow '$flow' attempted for gas $name!" if ( $flow < 0 || $flow eq '');
    return $controler->setflow($flow);
}

sub measure
{
    ### find location of logfile.pl lockfile             ###
    ### and wait for no logfile.pl program to be running ### 
    my $test = $rig->session();
    my $lockfile = '/home/celltest/rig_'.$rig->name.'_logfile.lock';
    sysopen( MYFH, $lockfile, O_WRONLY | O_CREAT ) or die errorlog("can't open filename: $lockfile $!");
    my $is_locked = flock( MYFH, LOCK_EX | LOCK_NB );
    my $not_running = $is_locked;
    while ( $is_locked == 0 ) 
    {
        sleep 1;
        $is_locked = flock( MYFH, LOCK_EX | LOCK_NB );
    }
    flock(MYFH,LOCK_UN);
    close MYFH;
    my $res;
    if ($not_running)
    {
	my $cmd = get_cv('global','logfile').' '.$rig->name.' ignore';
	$res = &run_cmd($cmd);
    }
    else
    {
	eval {
	    ## Get last line from raw data file ##
	    my $dat = `date +"%Y:%m:%d"`;
	    $dat =~ /([\d\:]*)/;
	    $dat = $1;
	    my $homedir = $RFC::Header::publicdir . 'rig' . $rig->name . "/" . $rig->name . 'test' . $test;
	    my $raadata = $homedir.'/raadata.'.$dat;
	    my $lockfile = '/home/celltest/rig_'.$rig->name.'_logfile.lock';
	    my $f = SemaforeFile->new($raadata,$lockfile);
	    if ($f->exist)
	    {
		$f->open_readback();
		$res = $f->readline();
		$f->close();
	    }
	};
	if ($@)
	{
	    $rig->errorlog($@);
	    return undef;
	}
    }
    chomp $res;
    return $res;
}

sub relay
{
    my $name = shift;
    my $status = shift;
    my $relay = $rig->relay($name);
    return "No relay found with name '$name' for rig ".$rig->name unless ($relay);
    return $relay->set($status);
}

sub temp
{
    return $rig->set_temp(@_);
}

sub ramp
{
    return $rig->set_ramp(@_);
}


sub current
{
    return $rig->current(@_);
}

sub voltage
{
    return $rig->voltage(@_);
}


sub imp_ok
{
    my $ip = shift;
    my $user = shift;
    my $mode = shift;
    my $session = shift;
    my $fileid = shift;
    my $cmd = get_cv('impedance','remote_client')." $ip $user get_file_now $mode $session $fileid";
    my $res = &run_cmd($cmd);
    my $test = $rig->session;
    my $homedir = $RFC::Header::publicdir.'rig'.$rig->name.'/imp_comp/';
    my $host = &get_host($ip);
    my $dir = $RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$test.'/impedance/raw/';
    if (!-d($dir))
    {
	system("/bin/mkdir $dir");
    }
    my $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2b';
    open OUTIMP, '>', $file or die errorlog("Could not open file $file for writing!!\n");
    print OUTIMP $res;
    close(OUTIMP);
    if (length($res) > 100)
    {
	### Only do compensation for impedance files ###
	my $command = get_cv('impedance','comp_program')." -S $homedir".'short_multiplex.i2b '.$file;
	&run_cmd($command);
	my $outfile = $file;
	$outfile =~ s/\.i2b$/_cor.i2b/;
	$command = get_cv('impedance','comp_program')." -M $homedir".'shunt_multiplex.i2b '.$outfile;
	&run_cmd($command);
	my $unlinkfile = $outfile;
	$outfile =~ s/\.i2b$/_cor.i2b/;
	my $newfile = $outfile;
	$newfile =~ s/\/raw\//\//;
	move($outfile,$newfile);
	unlink $unlinkfile if (-e $unlinkfile);
    }

}


sub cmdlog(@)
{
    my $m = join(' ',@_);
    return $rig->proglog("Remote message from $dot_addr: ".$m,$PROGRAM);
}

sub logbook(@)
{
    my $m = join(' ',@_);
    my $f = $RFC::Header::publicdir.'rig'.$rig->name.'/logbook.txt';
    my $l = $rig->riglock; 
    my $file = SemaforeFile->new($f,$l);
    $file->append("Remote message from $dot_addr: ".$m);
    return $rig->proglog("Remote message from $dot_addr: ".$m,$PROGRAM);
}

sub unlink_mailfile()
{
    return $rig->unset_warning('mailfile');
}

sub unlink_H2mailfile()
{
    return $rig->unset_warning('H2mailfile');
}

sub set_mailfile()
{
    return $rig->set_warning('mailfile');
}

sub set_H2mailfile()
{
    return $rig->set_warning('H2mailfile');
}

sub debug
{
    if (@_)
    {
	$debug = shift;
    }
    else
    {
	if ($debug)
	{
	    $debug = 0;
	}
	else
	{
	    $debug = 1;
	}
    }
    $rig->debug($debug);
    return "Debug: $debug";
}


sub get_host($)
{
    my $adr = shift;
    if ($adr =~ /([\d\.\:]+)/)
    {
        my $cmd = get_cv('impedance','remote_client')." $1 ping";
        my $res = `$cmd`;
        if ($res =~ /localhost.* on addr:\s*([\d\.]+)/)
        {
            return $1;
        }
        if ($res =~ /on ([\w\-\.]+) on addr:/)
        {
            return $1;
        }
    }
    if ($adr =~ /([\w\.]+)/)
    {
        my $ip = $1;
        my $res = `/usr/bin/nslookup $ip`;
        if ($res && $res =~ /name\s+\=\s+([\w\-\+]+)/)
        {
            return $1;
        }
	return $ip;
    }
    return $adr;
}


sub run_cmd($)
{
    my $cmd = shift;
    my $errfile = '/tmp/CGI_server'.$$.'.txt';
    unless ($cmd =~ /\&/)
    {
	$cmd .= ' 2>'.$errfile;
    }
    my $err = undef;
    my $res = undef;
    eval {
	print $cmd,"\n" if ($debug);
	$res = `$cmd`;
	chomp $res;
	if (-e $errfile)
	{
	    my $f = SemaforeFile->new($errfile);
	    $err = join("\n",$f->readlines);
	    unlink $errfile;
	}
    };
    if ($@)
    {
	warn $@,"\n";
	return $res."\t".$@;
    }
    if ($err)
    {
	warn $err,"\n";
	return $res."\t".$err;
    }
    print $res,"\n" if ($debug);
    return $res;
}
