#!/usr/bin/perl

## @file
# Camera probing daemon
#  * Runs on every node
#  * Looks for probing requests in $QUEUE
#  * Places requests being processed to $STAGE
#  * Writes task logs to $LOG
#  * Both request and response are plain files in "name=value" format
#  * Response contains all the fields of requests combined with new response-specific ones
#
# Request-specific parameters
#    DEVIP: camera IP or hostname
#    HTTP_PORT: HTTP port
#    USRNAME: camera auth data
#    PASSWD: camera auth data
#    CAMERA: camera input number [optional]
#    force_probing: If true, do not use cached results. Boolean value, default is 0 [optional]
#    CAMERAMODEL: suggested camera manufacturer name (e.g. Axis, Arecont, etc.) [optional]
#    probe_single_brand: if suggested manufacturer name is specified, 
#			 probe only that model and do not proceed if failed [optional]
#
# Response-specific parameters
#    state: probing task state
#    error: if probing failed, this field will contain pre-defined brief error description
#    started_at: probing start timestamp
#    finished_at: probing finish timestamp
#    pid: process ID of child task
#
# Error codes
#    PDE-0001  - Connection to a specified HTTP port failed: camera unreachable
#    PDE-0002  - Unknown camera type
#    PDE-0003  - Timeout for task execution expired
#    PDE-0004  - Interrupted because of application shut down
#    PDE-0401  - Camera authentication failed
#    PDE-0404  - Cannot retrieve camera configuration
# 
# Task states
#    OK         - Completed. Camera was probed successfully
#    ERROR      - Completed. Probing failed
#    scheduled  - Task is scheduled for execution
#    inprogress - Task is being executed
#
use strict;
use warnings;

use IO::Socket::INET;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request::Common;
use SKM::Common;
use Device::Conf;

#------------------------- CONS -----------------------------
#
my $APL   = $ENV{APL};
my $ROOT  = "$APL/var/probe";
my $QUEUE = "$ROOT/queue";
my $STAGE = "$ROOT/stage";
my $IMAGE = "$ROOT/image";
my $LOG   = "$ROOT/log";
my $FOUND = "$ROOT/found";

my $SLEEP        = 2;	 # Main loop sleep time
my $CAM_TIMEOUT  = 2;    # Camera connection timeout (sec)
my $TSK_TIMEOUT  = 120;  # Time limit for probing task (sec)
my $TSK_LIFESPAN = 3600; # Completed probe results in stage area are preserved for (sec)
my $GC_CALL_TIME = 60;   # Interval between garbage collector calls (sec)
my $SCRIPT_PATH  = "$APL/mgears/bin";
#------------------------- VARS -----------------------------
#
my %Tasks; # is filled by 'get_tasks'
my $Last_GC_Time = 0;
my $Last_Discovery_Time = 0;
my $Task_Name_Pattern = qr/^.+_\d+_\d+$/;

#------------------------- SIGNALS --------------------------
#
$SIG{CHLD} = 'IGNORE';
$SIG{HUP}  = \&scan_queue;
$SIG{TERM} = $SIG{INT} = \&finalize;

#------------------------- MAIN -----------------------------
#
main();

#------------------------- PROC -----------------------------
#

## @fn get_tasks()
# Read all active tasks into %Tasks global hash
sub get_tasks
{
	%Tasks = ();
	if (opendir(DH, $STAGE)) {
		foreach my $tid (grep {/$Task_Name_Pattern/o} readdir DH) {
			next unless open(FH, "$STAGE/$tid");
			my %tsk = map {/^(\w+)=(.+)$/} grep {/^\w+=.+$/} <FH>;
			close(FH);
			$Tasks{$tid} = \%tsk;
		}
		close(DH);
	}
}

## @fn $ cam_peek(hashref task)
# Quick camera connection test
# @param task hashref with task params
# @return 1 if connection OK, 0 otherwise
sub cam_peek
{
	my ($task) = shift;
	return 1 if $task->{CAMERAMODEL} eq 'DEMO'; # no check for DEMO
	
	my $sock = IO::Socket::INET->new(
		PeerHost => $task->{DEVIP},
		PeerPort => $task->{HTTP_PORT},
		Timeout  => $CAM_TIMEOUT
	);
	if ($sock) {
		$sock->shutdown(2);
		return 1;
	}
	$task->{state}  = 'ERROR';
	$task->{error} = 'PDE-0001';
	return 0;
}

## @fn cam_probe(hashref task)
# Perform full camera probing
# @param task hashref with task params
sub cam_probe
{
	my ($task) = @_;
	
	my $model = $task->{CAMERAMODEL};
	my $host  = $task->{DEVIP};
	my $port  = $task->{HTTP_PORT};
	my $user  = $task->{USRNAME};
	my $pass  = $task->{PASSWD}; 
	
	# Retrieve list of available cartrdges and sort it
	my @list=grep {$_->{PROBE} ne 'NONE'} @{Cartridges('camera')};
	@list = sort {$b->{NAME} eq $model} @list if $model;
	@list = grep {$_->{NAME} eq $model} @list if $model and $task->{probe_single_brand}; # Probe only for suggested brand
	
	log_task($task, "startprobe");
        #print Dumper \@list;
	foreach my $cartridge (@list) {
		next if not defined $cartridge->{PROBE} or $cartridge->{PROBE} eq 'NONE';
		next if not defined $cartridge->{PROBEORDER} and not $task->{probe_single_brand}; # exlude from probe
		my %result;
		if (open(DEF, "$cartridge->{PROBE} DEVIP='$host' HTTP_PORT='$port' USRNAME='$user' PASSWD='$pass' PROBE=DEFINE |")) {
		
			%result = map {/(^\w+)=(.*)/} grep {/^\w+=.*/} <DEF>;
			close(DEF);
			my ($found, $err_code) = (0, '');
			my $status = delete $result{STATUS};
			if ($status eq 'OK') {
				$found = 1;
			}
			elsif ($status =~ /^ERROR: (\S+)\s/) {
				$err_code = $1;
				$found = 1 if $err_code=~/^PCE-04(01|04)$/;
			}
			log_task($task, "probe: $cartridge->{NAME}");
			next unless $found;
			
			# Found matching model
			#
			log_task($task, "match: $cartridge->{NAME}");
			$task->{CAMERAMODEL} = $cartridge->{NAME};
			$task->{error} = 'PDE-0401' if $err_code eq 'PCE-0401';
			$task->{error} = 'PDE-0404' if $err_code eq 'PCE-0404';
			%$task = (%$task, %result);			
			last;
		}
		else {
			warn("Failed to run define script: $cartridge->{PROBE}: $!");
		}
	}
	
	$task->{state} = $task->{MODELID} ? 'OK' : 'ERROR';
	$task->{error} = 'PDE-0002' if $task->{state} eq 'ERROR' and not $task->{error};
}

## @fn discovery()
# Find cameras over the network
# Results for $MODELNAME are written to file $PROBEDIR/discovery/$MODELNAME
sub discovery
{
	$Last_Discovery_Time = time;
	
	# Create child process and return
	return if fork;
	
	# Retrieve list of available cartrdges and sort it
	my @list=grep {$_->{FIND} ne 'NONE'} @{Cartridges('camera')};
	
	foreach my $cartridge (@list) {
		next if not defined $cartridge->{FIND} or $cartridge->{FIND} eq 'NONE';
		if (open(FIND, "$cartridge->{FIND} |")) {
		    local $/ = undef;
		    my $list = <FIND>;
		    close FIND;
		    open (FOUND, ">$FOUND/$cartridge->{NAME}") or warn("Failed to write: $!"),next;
		    print FOUND $list;
		    close FOUND;
		}
		else {
			warn("Failed to run define script: $cartridge->{PROBE}: $!");
		}
	}
	
	exit 0;
}

## @fn log_task(hashref task, scalar msg)
# Writes message to a task log file
# @param task hashref with task params
# @param msg scalar string
sub log_task
{
	my ($task, $msg) = @_;
	
	if(open(FH, ">>$LOG/$task->{id}")) {
		print FH "$msg\n";
		print STDERR "$msg\n";
		close(FH);
	}
}

## @fn write_task(hashref task, scalar loc)
# Stores task parameter to a file
# @param task hashref with task params
# @param loc log directory where to place log file
sub write_task
{
	my ($task, $loc) = @_;
	$loc = $STAGE unless defined $loc;
	
	my $path = "$loc/$task->{id}";
	if (open(FH, '<', $path)) {
		%$task =  ( (map {/^(\w+)=(.+)$/} grep {/^\w+=.+$/} <FH>), %$task );
		close(FH);
	}
	if (open(FH, '>', $path)) {
		print FH "$_=$task->{$_}\n" foreach sort keys %$task;
		close(FH);
	}
	else {
		warn("Cannot write task $task->{id} to file: $!");
	}
}

## @fn complete_task(hashref task, scalar state, scalar error)
# Simply sets task params and writes it to disk
# @param task hashref with task params
# @param state task state
# @param error brief error description
sub complete_task
{
	my ($task, $state, $error) = @_;
	
	$task->{state}  = $state   if $state;
	$task->{error}  = $error   if $error;
	
	$task->{finished_at} = time;
	
	log_task($task, "finish");
	warn("result: ".Dumper($task));
	write_task($task);
}

## @fn execute_task(hashref task)
# Analyzes task data and runs probing if needed
# @param task hashref with task params
sub execute_task
{
	my ($task) = @_;
	
	log_task($task, "start");
	
	$task->{state} = 'scheduled';
	$task->{started_at} = time;
	write_task($task);
	
	# Find out if probing for the target camera already scheduled
	#
	get_tasks;
	
	my $do_probe = 1;
	foreach my $tid (keys %Tasks) {
		last if $task->{force_probing};
		next if $tid eq $task->{id};
		
		my $tsk = $Tasks{$tid};
		if ($tsk->{DEVIP} eq $task->{DEVIP} 
		    && $tsk->{HTTP_PORT} == $task->{HTTP_PORT})
		{
			if ($tsk->{state} eq 'OK' 
			    && $tsk->{USRNAME} eq $task->{USRNAME}
			    && $tsk->{PASSWD} eq $task->{PASSWD}
			    && $tsk->{CAMERAMODEL} ne 'vChain') # TODO: find better way to turn off caching for vChain cams
			{
				$do_probe = 0;
				
				# Read probe result from cache
				#
				%$task = (%$tsk, %$task);
				$task->{CAMERAMODEL} = $tsk->{CAMERAMODEL}; # Take from cache
				$task->{state} = 'OK';
			}
			elsif ($tsk->{state} !~ /^(OK|ERROR)$/
				&& $tsk->{USRNAME} eq $task->{USRNAME}
				&& $tsk->{PASSWD} eq $task->{PASSWD})
			{
				$do_probe = 0;
				
				# Duplicated task found
				#
				$task->{duplicate} = $tid;
				$task->{state} = 'ERROR';
			}
			
			# Nothing more to do if duplicated or
			# cached results found
			#
			unless ($do_probe) {
				complete_task($task);
				last;
			}
		}
	}
	
	# Actually, run probing process
	#
	if ($do_probe) {
		
		# Actual probing will be performed by a child process
		# Parent do not interact with that child, it can only
		# view probe results in stage files
		#
		if (fork == 0) {
			
			local $SIG{HUP} = 'IGNORE';
			local $SIG{CHLD};
			
			$task->{state} = 'inprogress';
			$task->{pid} = $$;
			write_task($task);
		
			# First just try to establish connection to a camera
			# If OK, run full probing
			#
			cam_probe($task) if cam_peek($task);
			
			# Finalize
			#
			complete_task($task);
			exit 0;
		}
	}
}

## @fn gc()
# Garbage collector. Removes old task results, images and log files
sub gc
{
	my $time = time;
	return if $time - $Last_GC_Time < $GC_CALL_TIME;
	$Last_GC_Time = $time;
	
	# Read params of all tasks inside STAGE directory into single hash
	#
	get_tasks;
	
	foreach my $tid (keys %Tasks) {
		my $tsk = $Tasks{$tid};
		
		if ($tsk->{state} =~ /^(OK|ERROR)$/) {
			my $ts_fin = $tsk->{finished_at} || 0;
			if ($time - $ts_fin > $TSK_LIFESPAN) {
				# Remove probe results, logs and images
				#
				unlink "$STAGE/$tid", "$LOG/$tid";
				unlink "$IMAGE/$tsk->{SAMPLE}" if $tsk->{SAMPLE};
			}
		}
		elsif ($time - $tsk->{started_at} > $TSK_TIMEOUT) {
			# Interrupt task execution
			#
			kill(9 => $tsk->{pid}) if $tsk->{pid};
			complete_task($tsk,'ERROR','PDE-0003');
		}
	}
	
	# Additional cleaning for old images and logs
	#
	my $mmin = int($TSK_LIFESPAN / 60);
	`find $IMAGE -type f -mmin +${mmin} -name '*.*' -delete`;
	`find $LOG -type f -mmin +${mmin} -delete`;
}

## @fn finalize()
# Interrupts all running tasks and quits
sub finalize
{
	# Run for parent process only
	#
	return if $$ ne ReadPid;
	
	# Interrupt all active tasks
	#
	get_tasks;
	
	foreach my $tid (keys %Tasks) {
		my $tsk = $Tasks{$tid};
		next if $tsk->{state} =~ /^(OK|ERROR)$/;
		
		kill(9 => $tsk->{pid}) if $tsk->{pid};
		complete_task($tsk,'ERROR','PDE-0004');
	}
	
	RemovePid;
	exit 1;
}

## @fn scan_queue()
# Scans 'queue' directory for new scheduled tasks
sub scan_queue
{
	if (opendir(DH, $QUEUE)) {
		my @files = grep {/$Task_Name_Pattern/o} readdir(DH);
		closedir(DH);
		foreach my $tid (sort @files) {
			if (-f "$STAGE/$tid") {
				warn ("Task $tid already scheduled for execution");
			}
			elsif (open(FH, "$QUEUE/$tid")) {
				my %task = map {/^(\w+)=(.+)$/} grep {/^\w+=.+$/} <FH>;
				close(FH);
				$task{id} = $tid;
				#$task{CAMERA} ||= 1;
				execute_task(\%task);
			}
			else {
				warn("Cannot read task $tid: $!");
			}
		}
		continue {
			unlink "$QUEUE/$tid";
		}
	}
	else {
		warn("Cannot open $QUEUE: $!");
	}
}

## @fn main()
# Main routine
sub main
{
	
        # Pid control
        #
        die "Concurrent run detected!" if CheckPid;
        WritePid;

	
	# Find cameras over the network
	# Run discovery oncee on daemon start
	#
	#discovery unless $Last_Discovery_Time;

        # Main loop
        #
        while (1) {
    		# Process incoming probe requests
    		#
    		scan_queue;
		
		# Collect garbage
		#
		gc;
	
		# Sleep for a while
		#
		sleep $SLEEP;
	}
}

END {
	finalize;
}
