#!/usr/bin/perl
#
# Vargus - the surveillance program
#
#####################
#    Copyright (C) 2010-2012 Michael A. Kangin <mak@complife.ru>
#
#    Copyright: Vargus is under GNU GPL, the GNU General Public License.
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; version 2 dated June, 1991.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    http://www.gnu.org/licenses/gpl-2.0.html
#

use IO::Handle;
use IO::Select;
use IO::Socket::INET;
use File::Basename;
use File::Temp qw(tempfile);
use File::Path qw(make_path);
use File::Find;
use Filesys::Df;
use Sys::Hostname;
use Cwd 'abs_path';
use Time::HiRes qw(sleep gettimeofday tv_interval);
use Proc::Daemon;
use Privileges::Drop;
use Getopt::Long;
use DBI;
use Sys::Syslog qw(LOG_DAEMON LOG_ERR LOG_WARNING LOG_NOTICE LOG_INFO LOG_DEBUG);
use POSIX;

use Vargus::Common;
use Vargus::Objects;

use strict subs;

sub close_control_channel;
sub get_hostid;

sub check_my_daemon {
	return 1 if not $heartbeat;
	-d("/proc/$daemon_pid") or log_n_die("No process with PID $daemon_pid found");
	-r("/proc/$daemon_pid/exe" ) or log_n_die("Can't read process (PID $daemon_pid) information");
	readlink("/proc/$daemon_pid/exe") =~ /vlc$/ or 
		log_n_die("Process with PID $daemon_pid is not VLC");

	open(TCPCONN, "/proc/net/tcp");
	@tcpconn = <TCPCONN>;
	close(TCPCONN);

	my $hex_telnet_port = uc(sprintf("%x", $telnet_port));

	foreach (glob("/proc/$daemon_pid/fd/*")) {
		$fdlink = readlink($_);
		$fdlink =~ /socket:\[[0-9]+\]/ or next;
		$sockid = (split(":", $fdlink))[1];
		$sockid =~ s/[\[\]]//g;
		grep(/:$hex_telnet_port .* $sockid /, @tcpconn) and return 1;
	}
	return 0;

}



sub init_daemon_cfg {
	my (
		@lua_section,
		@vargus_section,
		$lua_config
	);

	@daemon_cfg_body = ();
	s_log(LOG_INFO, "Configuring with $daemon_cfg");
	open(D_CFG, $daemon_cfg) or log_n_die("Error reading daemon config $daemon_cfg");
	chomp(@daemon_cfg_body = <D_CFG>);
	close(D_CFG);
	@daemon_cfg_body=cleance_config(@daemon_cfg_body);

	@lua_section = expand_macroses(get_cfg_section("lua", @daemon_cfg_body));
	@lua_section or log_n_die("No [lua] section found in config $daemon_cfg");

	$lua_config = get_option("lua-config", @lua_section);

	$telnet_port = get_option("telnet-port", @lua_section);
	if ( not $telnet_port ) {
		$telnet_port = $lua_config;
		$telnet_port =~ s/.*?telnet={(.*?)}.*/$1/ or undef $telnet_port;
		$telnet_port =~ s/.*?host='(.*?)'.*/$1/ or undef $telnet_port;
		$telnet_port =~ s/.*:// or undef $telnet_port;
	}

	$telnet_port or log_n_die("No telnet port found");


	$telnet_password = get_option("telnet-password", @lua_section);
	if ( not $telnet_password ) {
		$telnet_password = $lua_config;
		$telnet_password =~ s/.*?telnet={(.*?)}.*/$1/ or undef $telnet_password;
		$telnet_password =~ s/.*?password='(.*?)'.*/$1/ or undef $telnet_password;
	}

	if (not $telnet_password) {
		s_log(LOG_NOTICE, "No telnet password found, will use default");
		$telnet_password="admin";
	}

	@vargus_section = get_cfg_section("vargus", @daemon_cfg_body);
	$video_storage = get_option("video-storage", @vargus_section);
	$vlm_config = get_option("vlm-config", @vargus_section);
	$allowed_group = get_option("allowed-group", @vargus_section);
	$allowed_group or $allowed_group = "vlc";

	$revive_in = get_option("revive-in", @vargus_section) if $time_control;
	$time_to_live = $revive_in;

	my $process_model = get_option("process-model", @vargus_section);
	if ($process_model) {
		if ($process_model eq 'separated') {
			$common_process = 0;
		} elsif ($process_model eq 'common') {
			$common_process = 1;
		} else {
			log_n_die("Unknown process model: $process_model");
		}
	}

	my $sql_archive = get_option("sql-archive", @vargus_section);
	if ($sql_archive) {
		$sql_access{host} = get_option("sql-host", @vargus_section);
		$sql_access{db} = get_option("sql-db", @vargus_section) 
			or log_n_die("No SQL database specified");
		$sql_access{user} = get_option("sql-user", @vargus_section) 
			or log_n_die("No SQL user specified");
		$sql_access{password} = get_option("sql-password", @vargus_section) 
			or log_n_die("No SQL password specified");

		$sql_access{dsn} = "DBI:mysql:$sql_access{db}";
		$sql_access{dsn} .= ":$sql_access{host}" if $sql_access{host};
	}

	$use_postprocess = get_option("postprocessing", @vargus_section);
	
	if ($use_postprocess) {
		$postprocess_threads = get_option("postprocess-threads", @vargus_section);
		$postprocess_threads or $postprocess_threads = 1;
	}

	if ($use_postprocess && ! %sql_access) {
		log_n_die("postprocessing require configured sql-archive option");
	}

	$use_check_integrity = get_option("check-integrity", @vargus_section);
	if ($use_check_integrity && ! %sql_access) {
		log_n_die("check-integrity require configured sql-archive option");
	}

	$keep_free_space = get_option("keep-free-space", @vargus_section);

	if ($keep_free_space) {
		if ($keep_free_space =~ /[kK]$/) {
			$keep_free_space =~ s/.$//;
		}

		if ($keep_free_space =~ /[mM]$/) {
			$keep_free_space =~ s/.$//;
			$keep_free_space *= 1024;
		}

		if ($keep_free_space =~ /[gG]$/) {
			$keep_free_space =~ s/.$//;
			$keep_free_space *= 1024 * 1024;
		}

		if ($keep_free_space =~ /[tT]$/) {
			$keep_free_space =~ s/.$//;
			$keep_free_space *= 1024 * 1024 * 1024;
		}

		if ($keep_free_space =~ /%$/) {
		$keep_free_space =~ s/.$//;
		my $df_info = df($video_storage);
		defined $df_info or log_n_die("Error get disk free info for video storage ($video_storage)");
		$keep_free_space = $keep_free_space * $df_info->{blocks} / 100;
		}
	}

	$max_vlc_memory = get_option("max-vlc-memory", @vargus_section);
	if ($max_vlc_memory) {
		if ($max_vlc_memory =~ /[0-9]$/) {
			$max_vlc_memory /= 1024;
		}

		if ($max_vlc_memory =~ /[kK]$/) {
			$max_vlc_memory =~ s/.$//;
		}

		if ($max_vlc_memory =~ /[mM]$/) {
			$max_vlc_memory =~ s/.$//;
			$max_vlc_memory *= 1024;
		}

		if ($max_vlc_memory =~ /[gG]$/) {
			$max_vlc_memory =~ s/.$//;
			$max_vlc_memory *= 1024 * 1024;
		}
	}

	$min_vlc_load = get_option("min-vlc-load", @vargus_section);

	my $tmpcfg;
	($tmpcfg, $tmp_daemon_cfg) = tempfile("/tmp/" . basename($daemon_cfg) . ".XXXXX");
	foreach (expand_macroses(delete_cfg_section("vargus", @daemon_cfg_body))) {
		print $tmpcfg $_ . "\n";
	}
	close($tmpcfg);

}

sub start_vlc_common_process {
	pipe(PIPE_R, PIPE_W);
	PIPE_W->autoflush(1);

	$watchdog_pid = fork();
	defined($watchdog_pid) or log_n_die("Error run watchdog process ($!)");

	if ($watchdog_pid) {
		close(PIPE_W);
		($daemon_pid) = <PIPE_R>;
		close(PIPE_R);
		s_log(LOG_INFO, "VLC daemon started ($daemon_pid)");
		return
	}

	close(PIPE_R);

	close_control_channel;

	$daemon_pid = fork();
	defined($daemon_pid) or log_n_die("Can't fork to run VLC daemon ($!)");

	my @vlc_options = (
		"--config",
		$tmp_daemon_cfg
	);

	push(@vlc_options, ("--vlm-conf", $vlm_config)) if $vlm_config;

	$daemon_pid or exec('/usr/bin/vlc', @vlc_options);

	my $p_pid = getppid();
	s_log(LOG_INFO, "Watchdog process started (from $p_pid, with care of $daemon_pid)");
	print PIPE_W $daemon_pid;
	close(PIPE_W);
	$need_die = 0;
	$SIG{TERM} = $SIG{INT} = sub { $need_die = 1 };
	waitpid($daemon_pid, 0);
	s_log(LOG_WARNING, "VLC daemon's death was detected.");
	exit if $need_die;
	kill(1, $p_pid);
	exit
}


sub kill_vlc_daemon {
	my $pid_to_kill = shift;

	s_log(LOG_DEBUG, "Try to kill VLC daemon $pid_to_kill");

	foreach (1..3) {
		kill 15, $pid_to_kill or s_log(LOG_INFO, "VLC daemon ($pid_to_kill) probably alive");

		eval {
			local $SIG{ALRM} = sub { die "alarm\n" };
			alarm(5);
			waitpid($pid_to_kill, 0);
			alarm(0);
		};
		last unless $@;
	}

	if ($@ and $@ eq "alarm\n") {
		s_log(LOG_WARNING, "VLC $pid_to_kill don't accept his die, kill with SIGKILL");
		kill 9, $pid_to_kill;
	}
}

sub start_vlc_daemon {
	local $daemon_config = shift;
	local $vlm_config = shift;
	my $ttl = shift;

	sub cleanup {
		s_log(LOG_DEBUG, "Unlink temporary VLC daemon config $daemon_config");
		unlink $daemon_config;
		s_log(LOG_DEBUG, "Unlink temporary VLM config $vlm_config");
		unlink $vlm_config;
		exit;
	}

	my $watchdog_pid = fork();
        defined($watchdog_pid) or log_n_die("Error run watchdog process ($!)");

	if ($watchdog_pid) {
		$watchdogs_pid{$watchdog_pid}{pid} = $watchdog_pid;
		$watchdogs_pid{$watchdog_pid}{start} = [gettimeofday()];
		$watchdogs_pid{$watchdog_pid}{filename} = $last_filename if $last_filename;
		return;
	}

	local $need_to_die = 0;

	my $proc_title = $main_proc_title . " $daemon_role watchdog $vlm_desc{name}";
	$proc_title .= ($vlm_desc{overlap} ? "_" . $channel_variants[$vlm_desc{variant}] : "") . " ($main_pid)";
	$0 = $proc_title;

	my @vlc_options = (
		"--config",
		$daemon_config
	);
	push(@vlc_options, ("--vlm-conf", $vlm_config)) if $vlm_config;

	$SIG{CHLD} = 'IGNORE';
	$SIG{TERM} = $SIG{INT} = $SIG{PIPE} = sub { 
		$need_to_die = 1; 
		kill_vlc_daemon($daemon_pid); 
		sleep(0.1);
		kill(SIGALRM, $p_pid); 
		cleanup; 
	};

	$SIG{HUP} = sub {
		s_log(LOG_INFO, "$daemon_role watchdog $vlm_desc{name} received SIGHUP, will try to reload daemon");
		kill_vlc_daemon($daemon_pid);
	};


	do {
		local $daemon_pid = fork();
		defined($daemon_pid) or log_n_die("Can't fork to run VLC daemon ($!)");
		$daemon_pid or exec('/usr/bin/vlc', @vlc_options);

		my $p_pid = getppid();
		s_log(LOG_INFO, "Watchdog process started (from $p_pid, with care of $daemon_pid)");

		$SIG{USR1} = sub{
			open(STATFILE, "/proc/$daemon_pid/statm") or do {
				s_log(LOG_WARNING, "Can't open proc status file for $daemon_pid: $!");
				return;
			};
			my @mem_info = <STATFILE> or do {
				s_log(LOG_WARNING, "Can't open proc status file for $daemon_pid: $!");
				close(STATFILE);
				return;
			};
			close(STATFILE);

			my $rss;
			(undef, $rss) = split(' ', @mem_info[0]);
			$rss *= 4;
			if ($rss > $max_vlc_memory) {
				s_log(LOG_WARNING, "Memcheck: VLC $daemon_pid ($daemon_role/$vlm_desc{name}) consumed ${rss}K, that more then limit ${max_vlc_memory}K, will be killed");
				kill_vlc_daemon($daemon_pid);
			} else {
				s_log(LOG_DEBUG, "Memcheck: VLC $daemon_pid ($daemon_role/$vlm_desc{name}) consumed ${rss}K, limit is ${max_vlc_memory}K, ok.");
			}
		};

		$SIG{USR2} = sub {
			sub get_cpu_times {
				open STAT, "/proc/stat" or return;
				my $cpu_line = <STAT> or return;
				my $cpu_counter = 0;
				while (<STAT> =~ /^cpu\d+\s/) {
					$cpu_counter++;
				}
				close(STAT);
				my @total_times = split(/\s+/, $cpu_line);
				shift(@total_times);
				my $sum_total_times;
				map {$sum_total_times += $_} @total_times;
				return $sum_total_times / $cpu_counter;
			}

			sub get_proc_times {
				my $pid = shift;
				open STAT, "/proc/$pid/stat" or return;
				my $stat_line = <STAT> or return;
				close(STAT);
				my @stats = split(/\s+/, $stat_line);
				my $sum_total_times;
				map {$sum_total_times += $_} @stats[13,14,15,16];
				return $sum_total_times;
			}
			
			my $cpu_load_1 = get_cpu_times;
			my $proc_load_1 = get_proc_times($daemon_pid);

			sleep 5;

			my $cpu_load_2 = get_cpu_times;
			my $proc_load_2 = get_proc_times($daemon_pid);

			my $current_load;
			if ($cpu_load_1 && $cpu_load_2 && $proc_load_1 && $proc_load_2) {
				$current_load = ($proc_load_2 - $proc_load_1) * 100 / ($cpu_load_2 - $cpu_load_1);
			}

			if ($current_load < $min_vlc_load) {
				s_log(LOG_WARNING, "Current CPU load of VLC $daemon_pid ($daemon_role/$vlm_desc{name}) is too small ($current_load), will be killed");
				kill_vlc_daemon($daemon_pid);
			} else {
				s_log(LOG_DEBUG, "CPU load of VLC $daemon_pid ($daemon_role/$vlm_desc{name}) is $current_load, ok.");
			}
		};
		
		eval {
			local $SIG{ALRM} = sub { die "alarm\n" };
			alarm($ttl) if $ttl;
			waitpid($daemon_pid, 0);
			alarm(0);
		};

		$SIG{USR1} = 'IGNORE';

		if ($@ and $@ eq "alarm\n") {
			kill_vlc_daemon($daemon_pid);
		} elsif (!$need_to_die) {
			s_log(LOG_WARNING, "VLC daemon $daemon_pid die unexpectedly, will reborn");
			kill(SIGKILL, $daemon_pid); # But dead must be REALLY dead
			$need_to_die = !$vlm_desc{loop};
			kill(SIGALRM, $p_pid) if $ttl || $need_to_die;
			sleep(3);
		}
	} until $ttl || $need_to_die;
	
	cleanup;
}
	


sub vlm_launcher {
	local %vlm_desc = @_;
	my @telnet_dialog;
	my $tmpcfg;
	my $vlm_config = '';
	my $tmp_daemon_cfg;
	
	%watchdogs_pid = ();

	sub cleanup_watchdog {
		my %pid = @_;
		my $file_duration;
		my $watchdog_duration = tv_interval($pid{start});

		s_log(LOG_DEBUG, "Watchdog $pid{pid} ($pid{filename}) was running $watchdog_duration seconds");
		if ($pid{filename}) {
			$file_duration=`mediainfo --Inform="General;%Duration%" $pid{filename}` / 1000;
		}

		# если $file_duration определить не удалось, значит он повреждён. Возможно, VLC пришлось прибивать некорректно, 
		# и он не успел записать заголовки. Если файл всё-таки имеет какой-нибудь значащий размер, попробуем его сохранить.
		unless ($file_duration) {
			if ((stat($pid{filename}))[7] > 10240) {
				$file_duration = $watchdog_duration if (stat($pid{filename}))[7] > 10240; 
				s_log(LOG_WARNING, "Can't detect file duration for $pid{filename}, file damaged, but not empty");
			}
		}


		if (%sql_access && $file_duration) {
			my $sql_ok = 1;

			$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) 
				or do {
					s_log(LOG_WARNING, "Error connect to SQL database $sql_access{db} ($DBI::errstr)");
					$sql_ok = 0;
				};

			my $status = 8;
			$status = 1 if $vlm_desc{postprocess};

			get_hostid unless $db_hostid;
			$sql_ok = 0 unless $db_hostid;

			if ($dbh and $db_hostid) {
				s_log(LOG_DEBUG, "Update SQL record for $pid{filename} (start=$pid{start}[0], duration=$file_duration)");

				my $sql_query = "update archive set filename='$pid{filename}', hostid=$db_hostid, start_time=FROM_UNIXTIME(" . $pid{start}[0] . "), ";
				$sql_query .= 	"end_time=FROM_UNIXTIME(" . ($pid{start}[0] + $file_duration) . "), duration=$file_duration, status=$status ";
				$sql_query .= 	"where filename='$pid{filename}';";

				my $rows_cnt = $dbh->do($sql_query) or do {
					s_log(LOG_WARNING, "SQL query error: " . $dbh->errstr);
					$sql_ok = 0;
				};

				s_log(LOG_WARNING, "Integrity warning: update for $pid{filename} affected $rows_cnt rows") if $rows_cnt > 1;

				if ($rows_cnt eq '0E0') {
					s_log(LOG_DEBUG, "No records found for $pid{filename}, will insert the new one");
					$sql_query =  "insert into archive (filename, hostid, camera, start_time, end_time, duration, vitality, status) values ";
					$sql_query .= "('$pid{filename}', $db_hostid, '$vlm_desc{obj_name}', FROM_UNIXTIME(" . $pid{start}[0] . "), ";
					$sql_query .= "FROM_UNIXTIME(" . ($pid{start}[0] + $file_duration) . "), $file_duration, $vlm_desc{vitality}, $status)";

					$dbh->do($sql_query) or do {
						s_log(LOG_WARNING, "SQL query error: " . $dbh->errstr);
						$sql_ok = 0;
					};
				}

				$dbh->disconnect();
			}

			eval {
				open(OUTFILE, ">> $tmp_db_file") or do {
					s_log(LOG_WARNING, "Error open temporary DB file, metainfo about file $pid{filename} will be lost");
					die;
				};
				
				my $flocked = 0;
				foreach(1..10) {
					flock(OUTFILE, 2) and do {
						$flocked = 1;
						last;
					};
					sleep(1);
				}

				unless ($flocked) {
					s_log(LOG_INFO, "Can't lock exclusive temorary DB file");
					die;

				}

				print(OUTFILE join(";", $pid{filename}, $vlm_desc{obj_name}, $pid{start}[0], 
						$pid{start}[0] + $file_duration, $file_duration, $vlm_desc{vitality}, $status . "\n")) 
					or s_log(LOG_INFO, "Error write temporary DB content");
				
				close(OUTFILE);
			} unless $sql_ok;

		}

		if ($pid{filename}) {
			unless ($file_duration) {
				s_log(LOG_WARNING, "Warning!! Strange or damaged file: $pid{filename}");
	#			unlink($pid{filename});
				if (%sql_access) {
					$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) or
						s_log(LOG_WARNING, "writer/damaged/CHECKME: Error connect to SQL database $sql_access{db} ($DBI::errstr)");
					$dbh->do("delete from archive where filename='$pid{filename}';") if $dbh;
					$dbh->disconnect if $dbh;
				}
			}
		}

	}


	my $chan_name = $vlm_desc{name};
	$info{activity}{$vlm_desc{obj_name}} = $vlm_desc{active};
	$info{write}{$vlm_desc{obj_name}} = $vlm_desc{write_ok};

	if (!$vlm_desc{active}) {
		s_log(LOG_NOTICE, "Object $chan_name is not active, skip...");
		return;
	}

	if ($daemon_role eq 'writer' and !$vlm_desc{write_ok}) {
		s_log(LOG_NOTICE, "Write for object $chan_name is disabled, skip...");
		return;
	}

	my $launcher_pid = fork();
	defined($launcher_pid) or log_n_die("Error run launcher process ($!)");

	if ($launcher_pid) {
		$launchers_pid{$launcher_pid} = $vlm_desc{obj_name};
		s_log(LOG_INFO, "VLM $vlm_desc{name} launcher started ($launcher_pid)");
		return
	}

	close_control_channel;
	$0 = $main_proc_title . " $daemon_role vlm_launcher $chan_name ($main_pid)";

	$SIG{HUP} = 'IGNORE';
	$SIG{ALRM} = 'IGNORE';
	$SIG{TERM} = $SIG{INT} = $SIG{PIPE} = sub {
		$SIG{TERM} = $SIG{INT} = $SIG{PIPE} = $SIG{CHLD} = $SIG{ALRM} = "IGNORE";
		my $sig_name = shift;
		s_log(LOG_DEBUG, "VLM $vlm_desc{name} launcher: receive SIG$sig_name signal");

		foreach my $watchdog (keys %watchdogs_pid) {
			s_log(LOG_DEBUG, "Try to kill watchdog $watchdog");
			kill(15, $watchdog) or s_log(LOG_WARNING, "Problem to kill watchdog $watchdog, check it");
			waitpid($watchdog, 0);
			foreach(1..15) {
				sleep(0.01);
			}
			cleanup_watchdog(%{$watchdogs_pid{$watchdog}});
		}
		exit;
	};

	$SIG{CHLD} = sub {
		local ($!,$?);
		my $pid = waitpid(-1, WNOHANG);
		return if $pid == -1;
		return unless defined $watchdogs_pid{$pid};
		cleanup_watchdog(%{$watchdogs_pid{$pid}});
		delete $watchdogs_pid{$pid};
	};

	sleep($vlm_desc{countdown});

	while (1) {
		@telnet_dialog = ();
		my $chan_name = $vlm_desc{name};
		if ($vlm_desc{overlap}) {
			$chan_name .= "_" . $channel_variants[$vlm_desc{variant}];
			$vlm_desc{variant} ^= 1;
		}
		push(@telnet_dialog, init_telnet_dialog($chan_name, %vlm_desc));
		push(@telnet_dialog, IO_telnet_dialog($chan_name, %vlm_desc));

		$last_filename = '';
		$vlm_output_line = (grep /setup $chan_name output/, @telnet_dialog)[0];
		if ($vlm_output_line =~ /std{access=file,dst=/) {
			$last_filename = $vlm_output_line;
			$last_filename =~ s/.*std{access=file,dst=//;
			$last_filename =~ s/}$//;
		}

		if ($video_storage && $last_filename) {
			my $df_info = df($video_storage);
			if ($df_info->{bavail} < 1024 * 500) {
				s_log(LOG_WARNING, "Freespace hard limit: Can't write, if less then 500M available (only " . $df_info->{bavail} / 1024 . ")");
				sleep(60);
				next;
			}
		}

		($tmpcfg, $vlm_config) = tempfile("/tmp/" . basename($daemon_cfg) . ".$chan_name.vlm.conf.XXXXX");
		print $tmpcfg join("\n", @telnet_dialog);
		close($tmpcfg);

		my @cfg_body = @daemon_cfg_body;
		foreach (@cfg_body) {
			$_ =~ /\(get_port:/ or next;
			$_ =~ s/get_port:rc:/get_port:rc-$vlm_desc{chan_num}-$vlm_desc{variant}:/ if $_ =~ /:rc:/;
			$_ =~ s/get_port:telnet:/get_port:telnet-$vlm_desc{chan_num}-$vlm_desc{variant}:/ if $_ =~ /:telnet:/;
		}

		($tmpcfg, $tmp_daemon_cfg) = tempfile("/tmp/" . basename($daemon_cfg) . ".$vlm_desc{chan_num}.XXXXX");
		foreach (expand_macroses(delete_cfg_section("vargus", @cfg_body))) {
			print $tmpcfg $_ . "\n";
		}
		close($tmpcfg);

		if (%sql_access and $db_hostid) {
			$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) 
				or s_log(LOG_WARNING, "Error connect to SQL database $sql_access{db} ($DBI::errstr)");

			if ($dbh) {
				($now_time) = gettimeofday();
				$sql_query =  "insert into archive (filename, hostid, camera, vitality, start_time, status) values ";
				$sql_query .= "('$last_filename', $db_hostid, '$vlm_desc{obj_name}', $vlm_desc{vitality}, FROM_UNIXTIME($now_time), 0)";

				$dbh->do($sql_query) or s_log(LOG_WARNING, "SQL query error: " . $dbh->errstr);

				$dbh->disconnect();
			}
		}

		my $has_transcode = grep /transcode{/, @telnet_dialog;

		start_vlc_daemon($tmp_daemon_cfg, $vlm_config, $vlm_desc{ttl});

		eval {
			local $SIG{ALRM} = sub { alarm(0); die "alarm\n" };
			alarm($vlm_desc{repeat_interval}) if $vlm_desc{repeat_mode};
			while (1) {
				sleep(90);
				foreach my $watchdog (keys %watchdogs_pid) {
					kill(SIGUSR1, $watchdog) if $max_vlc_memory;
					kill(SIGUSR2, $watchdog) if $min_vlc_load && $has_transcode;
				}
			}
			alarm(0);
		};

	}
}


sub start_vlc {
	if ($common_process) {
		start_vlc_common_process;
	} else {
		foreach (@vlm_channels) {
			vlm_launcher(%{$_});
			sleep 0.2;
		}
	}
}



sub say_to_daemon {

	foreach my $i (1..10) {
		check_my_daemon and last;
	} continue {
		s_log(LOG_INFO, "Daemon not found, my death is closer ($i)");
		sleep(0.5);
		log_n_die("My daemon is dead, exit") if ($i == 3);
	}

	s_log(LOG_INFO, "My daemon found, I will live more...") if ($i > 1);

	$last_child_pid = fork();
	defined($last_child_pid) or log_n_die("Fork error ($!)");
	$daemon_is_work = 1;
	return if $last_child_pid;

	$SIG{INT} = $SIG{TERM} = $SIG{PIPE} = 'IGNORE';

	do_telnet_exchange($telnet_port, $telnet_password, @_);
	s_log(LOG_DEBUG, "The death of a child");
	exit;
}


sub IO_telnet_dialog {
	my $chan_name = shift;
	my %vlm_desc = @_;
	my @telnet_dialog;
	
	$obj_name = $vlm_desc{obj_name} if $vlm_desc{obj_name};

	my @input_strs = split(' ', expand_macroses($vlm_desc{input}[$vlm_desc{variant}]));
	$vlm_desc{aggressive} or push(@input_strs, "vlc://pause:1s");

	my $path = expand_macroses($vlm_desc{path}) if $vlm_desc{path} && $vlm_desc{obj_name};
	my $output_str = expand_macroses($vlm_desc{output});

	$path = "$video_storage/$path";
	-d $path or make_path($path, { mode => 0775}) or s_log(LOG_WARNING, "Error creatind directory $path ($!)");

	push(@telnet_dialog, "setup $chan_name inputdel all");
	foreach my $input_str (@input_strs) {
		push(@telnet_dialog, "setup $chan_name input $input_str");
	}
	unless ($common_process) {
		$vlm_desc{loop} or push(@telnet_dialog, "setup $chan_name input vlc://pause:3s");
		$vlm_desc{loop} or push(@telnet_dialog, "setup $chan_name input vlc://quit");
	}
	push(@telnet_dialog, "setup $chan_name output $output_str");

	if ($vlm_desc{slave_input}) {
		foreach my $slv (keys($vlm_desc{slave_input})) {
			my $chname = $chan_name . "_slave_" . $slv;
			push(@telnet_dialog, "control $chname play");
		}
	}

	push(@telnet_dialog, "control $chan_name play");

	return @telnet_dialog;
}



sub init_telnet_dialog {
	my $chan_name = shift;
	my %vlm_desc = @_;
	my @telnet_dialog;

	if ($vlm_desc{slave_input}) {
		foreach my $slv (keys($vlm_desc{slave_input})) {
			my %slave_input = %{$vlm_desc{slave_input}{$slv}};
			my $chname = $chan_name . "_slave_" . $slv;
			push(@telnet_dialog, "new $chname broadcast enabled");
			if ($slave_input{vlc_options}) {
				foreach my $vlc_option (@{$slave_input{vlc_options}}) {
					push(@telnet_dialog, "setup $chname option $vlc_option");
				}
			}
			push(@telnet_dialog, "setup $chname loop") if $slave_input{loop};
			push(@telnet_dialog, "setup $chname inputdel all");

			my @input_strs = split(' ', expand_macroses($slave_input{input}));
			$slave_input{aggressive} or push(@input_strs, "vlc://pause:1s");
			$slave_input{loop} or push(@input_strs, "vlc://pause:3s");
			$slave_input{loop} or push(@input_strs, "vlc://quit");
			foreach my $input_str (@input_strs) {
				push(@telnet_dialog, "setup $chname input $input_str");
			}

			push(@telnet_dialog, "setup $chname output #bridge-out{id=$slv}");
			push(@telnet_dialog, "");
		}
	}


	push(@telnet_dialog, "new $chan_name broadcast enabled");
	if ($vlm_desc{vlc_options}) {
	foreach my $vlc_option (@{$vlm_desc{vlc_options}}) {
		push(@telnet_dialog, "setup $chan_name option $vlc_option");
	}}
	push(@telnet_dialog, "setup $chan_name loop") if $vlm_desc{loop};
	push(@telnet_dialog, "setup $chan_name option run-time=$vlm_desc{ttl}") if $vlm_desc{ttl};
	return @telnet_dialog;
}


sub init_vlm_channels {
	my @telnet_dialog = ();
	my @vlm_channels_configs = glob($conf_dir . "/$daemon_role.*.cfg");
	
	@vlm_channels = ();

	push(@telnet_dialog, "del all");
	get_vlm_from_objects if $has_objects && grep /^$daemon_role$/, @object_capable_names;

	foreach my $vlm_channels_config (@vlm_channels_configs) {
		open(V_CFG, $vlm_channels_config) or log_n_die("Error reading VLM config $vlm_channels_config");
		chomp(my @cfg_body = <V_CFG>);
		close(V_CFG);

		my @main_options = get_cfg_section("main", @cfg_body);

		if (not @main_options) {
			#This is native vlm config
			push(@telnet_dialog, @cfg_body);
			next;
		}

		@cfg_body=cleance_config(@cfg_body);
		my @main_options = get_cfg_section("main", @cfg_body);

		my %vlm_desc = ();
		$vlm_desc{chan_num} = $#vlm_channels + 2;
		$vlm_desc{config} = $vlm_channels_config;
		$vlm_desc{name} = "channel$vlm_desc{chan_num}";

	# Main section parameters ###########################################################
		$vlm_desc{repeat_mode} = (get_option("repeat", @main_options) == 1);

		if ($vlm_desc{repeat_mode}) {
			$vlm_desc{repeat_interval} = get_option("repeat-interval", @main_options) or 
				$vlm_desc{repeat_interval} = 60;
			$vlm_desc{repeat_interval} =~ /^[0-9]+$/ or 
				log_n_die("Bad repeat interval $vlm_desc{repeat_interval}");
			$vlm_desc{countdown} = $vlm_desc{chan_num};
			$vlm_desc{countdown} = int(rand(10)) + 1 if 
				(get_option("random-init-delay", @main_options) == 1);
		};


		$vlm_desc{overlap} = get_option("overlap", @main_options);
		$vlm_desc{loop} = get_option("loop", @main_options);

		$vlm_desc{variant} = 0;

		$vlm_desc{ttl} = get_option("ttl", @main_options);
		if ( $vlm_desc{ttl} eq '') {
			$vlm_desc{ttl} = 86400;
		}

		$vlm_desc{sleep_controlled} = get_option("sleep-controlled", @main_options);

		if (not $vlm_desc{sleep_controlled}) {
			if ( $vlm_desc{repeat_interval} and ($vlm_desc{repeat_interval} < $vlm_desc{ttl})) {
					$vlm_desc{ttl} = $vlm_desc{repeat_interval} + $vlm_desc{overlap};
			}
		}

	######################################################################################

		$vlm_desc{vlc_options} = [get_cfg_section("vlc-options", @cfg_body)];

		$vlm_desc{input}[0] = get_cfg_section_as_string("input", @cfg_body);
		$vlm_desc{input}[0] or $vlm_desc{input}[0] = get_cfg_section_as_string("input_A", @cfg_body);
		$vlm_desc{input}[0] or log_n_die("No 'input' section in config $vlm_channels_config");
		$vlm_desc{input}[1] = get_cfg_section_as_string("input_B", @cfg_body) if $vlm_desc{repeat_mode};

		my $output_subchannel = "output";
		if ($subchannel) {
			s_log(LOG_WARNING, "Will use subchannel $subchannel");
			$output_subchannel .= $subchannel;
		}

		$vlm_desc{output} = get_cfg_section_as_string($output_subchannel, @cfg_body);
		if (not $vlm_desc{output}) {
			if (not $subchannel) {
				$subchannel = 1;
			} elsif ($subchannel == 1) {
				$subchannel = '';
			}
			$output_subchannel = "output" . $subchannel;
			$vlm_desc{output} = get_cfg_section_as_string($output_subchannel, @cfg_body);
		}

		$vlm_desc{output} or log_n_die("No '$output_subchannel' section in config $vlm_channels_config");
		$vlm_desc{output} = '#' . $vlm_desc{output};

		$vlm_desc{counter} = 0;
		
		push(@vlm_channels, {%vlm_desc});
	}

	@vlm_channels or s_log(LOG_INFO, "WARNING: No VLM channels found");

	if ($common_process) {
		foreach (@vlm_channels) {
			my %vlm_desc = %{$_};
			my $chan_name = $vlm_desc{name};
			$chan_name .= "_" . $channel_variants[0] if $vlm_desc{overlap};
			push(@telnet_dialog, init_telnet_dialog($chan_name, %vlm_desc));
			push(@telnet_dialog, init_telnet_dialog($vlm_desc{name} . "_" . $channel_variants[1], %vlm_desc)) if 
				$vlm_desc{overlap};
			push(@telnet_dialog, IO_telnet_dialog($chan_name, %vlm_desc)) if !$vlm_desc{repeat_mode};
		}
			
		my $tmpcfg;
		($tmpcfg, $vlm_config) = tempfile("/tmp/" . basename($daemon_cfg) . ".vlm.conf.XXXXX");
		print $tmpcfg join("\n", @telnet_dialog);
		close($tmpcfg);
	}
}

sub update_DB_from_file {
	my $sql_query;

	unless (-e $tmp_db_file) {
		s_log(LOG_INFO, "No temorary DB file");
		return;
	}
	
	unless (%sql_access) {
		s_log(LOG_WARNING, "No SQL access configured");
		return
	}

	if ( -z $tmp_db_file ) {
		s_log(LOG_INFO, "Remove empty temporary DB file");
		unlink($tmp_db_file);
		return;
	}

	get_hostid unless ($db_hostid);
	return unless ($db_hostid);

	s_log(LOG_INFO, "Try to move videofiles metainfo into SQL database");

	open(INFILE, "< $tmp_db_file") or do {
		s_log("Error reading temorary DB file");
		return
	};

	my $flocked = 0;
	foreach(1..5) {
		flock(INFILE, 2) and do {
			$flocked = 1;
			last;
		};
		sleep(1);
	}

	unless ($flocked) {
		s_log(LOG_INFO, "Can't lock exclusive temorary DB file");
		return;
	}

	$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password})
		or do {
			s_log(LOG_WARNING, "Error connect to SQL database $sql_access{db} ($DBI::errstr)");
			close(INFILE);
			return;
		};

	my @failed_records;

	foreach (<INFILE>) {
		chomp($_);
		my ($filename, $camera, $start_time, $end_time, $duration, $vitality, $status) = split(';', $_);

		next unless -e $filename;

		my $sql_ok = 1;

		$sql_query =  "update archive set filename='$filename', hostid=$db_hostid, ";
		$sql_query .= "start_time=FROM_UNIXTIME($start_time), end_time=FROM_UNIXTIME($end_time), ";
		$sql_query .= "duration=$duration, status=$status where filename='$filename';";

		my $rows_cnt = $dbh->do($sql_query) or $sql_ok = 0;

		s_log(LOG_WARNING, "Integrity warning: update for $filename affected $rows_cnt rows") if $rows_cnt > 1;

		if ($rows_cnt eq '0E0') {
			s_log(LOG_DEBUG, "No records found for $filename, will insert the new one");
			$sql_query =  "insert into archive (filename, hostid, camera, start_time, end_time, duration, vitality, status) values ";
			$sql_query .= "('$filename', $db_hostid, '$camera', FROM_UNIXTIME($start_time), FROM_UNIXTIME($end_time), $duration, $vitality, $status);";

			$dbh->do($sql_query) or	$sql_ok = 0;
		}

		unless ($sql_ok) {
			s_log("SQL query error: " . $dbh->errstr);
			push(@failed_records, join(';', $filename, $camera, $start_time, $end_time, $duration, $vitality, $status . "\n"));
		};
	}

	$dbh->disconnect();

	close(INFILE);


	unless (@failed_records) {
		s_log(LOG_INFO, "All records moved into SQL database successfully, remove temporary DB file");
		unlink($tmp_db_file) or s_log(LOG_INFO, "Error remove temporary DB file");
		return;
	}

	open(OUTFILE, "> $tmp_db_file") or do {
		s_log("Error recreate temorary DB file");
		return;
	};

	my $flocked = 0;
	foreach(1..5) {
		flock(OUTFILE, 2) and do {
			$flocked = 1;
			last;
		};
		sleep(1);
	}

	unless ($flocked) {
		s_log(LOG_INFO, "Can't lock exclusive temporary DB file");
		return;
	}

	print(OUTFILE @failed_records) or s_log(LOG_INFO, "Error write temporary DB content");
	close(OUTFILE);
}







sub start_postprocessor {
	my $postprocessor_pid = fork();
	defined($postprocessor_pid) or log_n_die("Error run postprocessor process ($!)");

	return $postprocessor_pid if $postprocessor_pid;

	close_control_channel;
	$0 = $main_proc_title . " $daemon_role postprocessor ($main_pid)";
	s_log(LOG_DEBUG, "Postprocessor $$ started");

	local $tmp1, $tmp2, $executor_pid, $file_in_process, @p_childs;
	sub cleanup_postprocessor;

	sub run_postprocess {
		my $postprocess_command = shift or return;
		my @executor_options = split(' ', $postprocess_command);

		$executor_pid = fork();
		defined($executor_pid) or do {
			s_log(LOG_INFO, "Error run postprocessor executor process ($!)");
			cleanup_postprocessor;
			next;
		};

		unless ($executor_pid) {
			if ($postprocess_command =~ /['"]/) {
				# Compatible mode, run with shell
				exec("/bin/nice $postprocess_command");
			} else {
				exec('/bin/nice', @executor_options);
			}
		}

		s_log(LOG_DEBUG, "Start postprocess executor $executor_pid for $file_in_process with command $postprocess_command");

		my $start_time, $stop_time;
		($start_time) = gettimeofday();
		eval {
			local $SIG{ALRM} = sub { die "alarm\n" };
			alarm($postprocessing_maxtime);
			waitpid($executor_pid, 0);
			alarm(0);
		};

		if ($@ and $@ eq "alarm\n") {
			s_log(LOG_WARNING, "Executor $executor_pid was run more than $postprocessing_maxtime seconds, will be terminated by timeout");
			kill(15, $executor_pid);
			eval {
				local $SIG{ALRM} = sub { die "alarm\n" };
				alarm(3);
				waitpid($executor_pid, 0);
				alarm(0);
			};

			if ($@ and $@ eq "alarm\n") {
				s_log(LOG_WARNING, "Executor $executor_pid will be killed.");
				kill(9, $executor_pid);
			}
		} else {
			($stop_time) = gettimeofday();
			s_log(LOG_DEBUG, "Postprocessor executor $executor_pid for " . basename($file_in_process) . " was running " . ($stop_time - $start_time) . " seconds");
		}

		sleep(1);
	}

	sub cleanup_postprocessor {
		unlink $tmp2 if -e $tmp2;

		foreach my $child (@p_childs) {
			unlink ${$child}{filename} if -e ${$child}{filename};
		}

		if (-e $tmp1 && ! -e $file_in_process) {
			rename $tmp1, $file_in_process;
			$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password})
				or s_log(LOG_WARNING, "Postprocessor: Error connect to SQL database $sql_access{db} ($DBI::errstr)");
			$dbh->do("delete from postproc where tmpname='$tmp1';") if $dbh;
			$dbh->disconnect if $dbh;
		}
		unlink $tmp1 if -e $tmp1;
	}

	$SIG{TERM} = $SIG{INT} = $SIG{PIPE} = sub {
		s_log(LOG_DEBUG, "Postprocessor $$ prepare to die...");
		if ($executor_pid) {
			kill(15, $executor_pid) or s_log(LOG_INFO, "May be a problem to kill postprocessor executor $executor_pid");
			
			eval {
				local $SIG{ALRM} = sub { die "alarm\n" };
				alarm(3);
				waitpid($executor_pid, $executor_pid);
				alarm(0);
			};

			if ($@ and $@ eq "alarm\n") {
				s_log(LOG_WARNING, "Postprocessor executor $pid_to_kill don't accept his die, kill with SIGKILL");
				kill 9, $executor_pid;
			}
		}
		cleanup_postprocessor;
		exit;
	};

	my $pp_pid = $$;
	my $pp_host = hostname;
	foreach(glob("$video_storage/postprocess.$pp_host.$pp_pid.*")) {
		unlink;
	}

	$SIG{CHLD} = $SIG{HUP} = 'IGNORE';

	while (1) {
		sleep(10 + rand(15));

		$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) 
			or do {
				s_log(LOG_WARNING, "Postprocessor: Error connect to SQL database $sql_access{db} ($DBI::errstr)");
				next;
			};

		my %vargus_servers = ();
		my $servers_filter = "";

		get_hostid;
		$sth = $dbh->prepare("select id, hostname, storage from servers;");
		$sth->execute;

		while (my @entry = $sth->fetchrow_array()) {
			$vargus_servers{$entry[0]}{hostname} = $entry[1];
			$vargus_servers{$entry[0]}{storage} = $entry[2] if $entry[2];
		}
		$sth->finish; 

		unless(%vargus_servers) {
			s_log(LOG_WARNING, "No vargus server hostnames found, skip cycle...");
			next;
		}

		my $lockfile_name = "check_integrity_request.flag";


		foreach my $id (keys(%vargus_servers)) {

			my $srv = $vargus_servers{$id}{hostname};
			my $lockfile = "$vargus_servers{$id}{storage}/$lockfile_name";

			unless ($id == $db_hostid || $vargus_servers{$id}{storage}) {
				s_log(LOG_DEBUG, "Can't recognize storage of remote server $srv, skip this server");
				next;
			}

			if ($id == $db_hostid) {
				$vargus_servers{$id}{storage} = $video_storage unless $vargus_servers{$id}{storage};
			}

			if (-e $lockfile) {
				my ($now_time) = gettimeofday();
				if ((stat($lockfile))[9] + $check_integrity_interval < $now_time) {
					s_log(LOG_WARNING, "Integrity check lockfile for server $srv has been expiried, will be ignored and deleted");
					unlink $lockfile;
				} else {
					s_log(LOG_DEBUG, "Postprocessor: check_integrity_request for server $srv found, skip this server");
					next;
				}
			}


			if ($vargus_servers{$id}{storage}) {
				my $df_info = df($vargus_servers{$id}{storage});
				if ($df_info->{bavail} < 1024 * 50) {
					s_log(LOG_WARNING, "Freespace hard limit for server $srv:");
					s_log(LOG_WARNING, "Can't postprocess, if less then 50M available (only " . $df_info->{bavail} / 1024 . ")");
					next;
				}

				$vargus_servers{$id}{ok} = 1;
				$servers_filter .= " or " if $servers_filter;
				$servers_filter .= "hostid = $id";
			}
		}

		next unless $servers_filter;

		my $query = "select id, filename, hostid, camera, UNIX_TIMESTAMP(start_time), " . 
			    "UNIX_TIMESTAMP(end_time), vitality, fail_cnt, status from archive " .
			    "where fail_cnt < 3 and status >= 1 and status < 8";

		# try to postprocess local files first

		my @results = ();
		my @alerts = ();
		my $total_start, $total_end;

		if ($vargus_servers{$db_hostid}{ok}) {
			$sth = $dbh->prepare($query . " and hostid = $db_hostid");
			$sth->execute;
		}

		while (my @entry = $sth->fetchrow_array()) {
			$total_start = $entry[4] if $entry[4] < $total_start || ! $total_start;
			$total_end = $entry[5] if $entry[5] > $total_end || ! $total_end;
			push(@results, \@entry);
		}

		unless (@results) {
			$sth = $dbh->prepare($query . " and ($servers_filter)");
			$sth->execute;
			while (my @entry = $sth->fetchrow_array()) {
				$total_start = $entry[4] if $entry[4] < $total_start || ! $total_start;
				$total_end = $entry[5] if $entry[5] > $total_end || ! $total_end;
				push(@results, \@entry);
			}
		}
	
		$sth->finish; 

		(my $now_time) = gettimeofday();

		if (@results) {
			$sth = $dbh->prepare("select camera, UNIX_TIMESTAMP(start_time), UNIX_TIMESTAMP(end_time), message from alerts
				where UNIX_TIMESTAMP(end_time) > $total_start and UNIX_TIMESTAMP(start_time) < $total_end
					order by start_time");
			$sth->execute and do {
				while (my @entry = $sth->fetchrow_array()) {
					my %alert = ();
					($alert{camera}, $alert{start_time}, $alert{end_time}, $alert{message}) = @entry;
					push(@alerts, {%alert});
				}
			};
		}

		$dbh->disconnect;

		foreach(@results) {
			my @entry = @{$_};
			my $camera, $hostid, $start_time, $end_time, $postprocess_template, $file_duration, $file_path, $start_pos;
			my $out_filename, $fail_cnt, $vitality, $alerts_vitality, $status, $original_duration;
			my $file_extension, $orig_extension, $alerts_before, $alerts_postprocess_template;
			my $record_id, $preprocess;

			($record_id, $file_in_process, $hostid, $camera, $start_time, $end_time, $vitality, $fail_cnt, $status) = @entry;
			$original_duration = $end_time - $start_time;

			if (-e "$vargus_servers{$hostid}{storage}/check_integrity_request.flag") {
				s_log(LOG_DEBUG, "Postprocessor: check_integrity_request detected for server $vargus_servers{$hostid}{hostname}, skip...");
				last;
			}

			unless (-e $file_in_process) {
				next;
			}

			my $camera_info = do_remote_query(
				$vargus_servers{$hostid}{hostname}, 
				"query !expand camera;$camera;" . 
				"write:prepostprocess,write:postprocess,write:length,write:start,write:filename,write:path," . 
				"alerts:vitality,alerts:before,alerts:postprocess"
			);

			unless ($camera_info) {
				s_log(LOG_WARNING, "Can't acquire information for $camera from host " . $vargus_servers{$hostid}{hostname} . ", skip");
				next;
			}

			chomp($camera_info);
			(
				$preprocess,
				$postprocess_template, 
				$file_duration, 
				$start_pos,
				$out_filename, 
				$file_path, 
				$alerts_vitality, 
				$alerts_before,
				$alerts_postprocess_template, 
			) = split(';', $camera_info);
			$postprocess_template =~ s/%/;/g;
			$alerts_postprocess_template =~ s/%/;/g;

			if ($preprocess) {
				$preprocess =~ s/_INFILE_/$file_in_process/g;
				run_postprocess($preprocess);
				$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) 
					or do {
						s_log(LOG_WARNING, "Postprocessor: Error connect to SQL database $sql_access{db} ($DBI::errstr)");
						next;
					};
				$sth = $dbh->prepare("select filename, UNIX_TIMESTAMP(start_time), UNIX_TIMESTAMP(end_time) " . 
					"from archive where id=$record_id;");
				$sth->execute;
				($file_in_process, $start_time, $end_time) = $sth->fetchrow_array();
				$original_duration = $end_time - $start_time;
				$sth->finish if $sth;
				$dbh->disconnect if $dbh;
				unless (-e $file_in_process) {
					s_log(LOG_DEBUG, "File $file_in_process lost after preprocess");
					next;
				}
			}


			if ($start_time + $alerts_before >= $now_time) {
				s_log(LOG_DEBUG, "File $file_in_process is too young, future alerts is possible, skip");
				next;
			}

			$file_duration += $fail_cnt == 0 ? 0.3 : 10;
			$file_duration = $original_duration if $file_duration > $original_duration;
			$out_filename =~ s/\..*//;
			$out_filename = "$vargus_servers{$hostid}{storage}/$file_path/$out_filename";
			$obj_name = $camera;



			$start_pos = "0" unless $start_pos;
			my $insignificant_fragment_time = 5;
			my $joint_compensation_time = 0.5;
			my @file_fragments = ();
			my %non_alert = ();
			my %alert = ();
			if ($status == 1) {
				foreach my $alert_entry (@alerts) {
					next unless ${$alert_entry}{camera} eq $camera;
					next if ${$alert_entry}{end_time} <= ($start_time + $start_pos);
					next if ${$alert_entry}{start_time} >= $end_time;

					%alert = %{$alert_entry};

					if ($alert{start_time} > $end_time - $insignificant_fragment_time) {
						$alert{start_time} = $end_time - $insignificant_fragment_time;
					}
					if ($alert{end_time} < $start_time + $start_pos + $insignificant_fragment_time) {
						$alert{end_time} = $start_time + $start_pos + $insignificant_fragment_time;
					}

					if (@file_fragments) {
						my $last_end = ${$file_fragments[-1]}{end_time};
						next if $last_end >= $alert{end_time};

						if ($last_end + $insignificant_fragment_time >= $alert{start_time}) {
							${$file_fragments[-1]}{end_time} = $alert{end_time};
							next;
						}

						%non_alert = ();
						$non_alert{camera} = $camera;
						$non_alert{start_time} = $last_end;
						$non_alert{end_time} = $alert{start_time};
						$non_alert{is_alert} = 0;
						push(@file_fragments, {%non_alert});
					}

					$alert{is_alert} = 1;
					$alert{message} = ${$alert_entry}{message};
					push(@file_fragments, {%alert});
				}
			}

			my $file_have_fragments = @file_fragments;
			if (@file_fragments) {
				my $best_end = $start_time + $start_pos + $file_duration;
				$best_end = $end_time if $end_time < $best_end;

				if (${$file_fragments[0]}{start_time} <= $start_time + $start_pos + $insignificant_fragment_time) {
					${$file_fragments[0]}{start_time} = $start_time + $start_pos;
				}

				if (${$file_fragments[-1]}{end_time} >= $best_end - $insignificant_fragment_time) {
					${$file_fragments[-1]}{end_time} = $best_end;
				}

				if (${$file_fragments[0]}{start_time} > $start_time + $start_pos) {
					%non_alert = ();
					$non_alert{camera} = $camera;
					$non_alert{start_time} = $start_time + $start_pos;
					$non_alert{end_time} = ${$file_fragments[0]}{start_time};
					$non_alert{is_alert} = 0;
					unshift(@file_fragments, {%non_alert});
				}

				if (${$file_fragments[-1]}{end_time} < $best_end) {
					%non_alert = ();
					$non_alert{camera} = $camera;
					$non_alert{start_time} = ${$file_fragments[-1]}{end_time};
					$non_alert{end_time} = $best_end;
					$non_alert{is_alert} = 0;
					push(@file_fragments, {%non_alert});
				}
			}


			my $duration = $file_duration;
			($orig_extension = $file_in_process) =~ s/.*\.//;
			@p_childs = ();
			my $result_is_ok;

			(undef, $tmp1) = tempfile("$vargus_servers{$hostid}{storage}/postprocess.$pp_host.$pp_pid.infile.XXXXX", OPEN => 0);

			unless (-e $file_in_process) {
				s_log(LOG_INFO, "File for postprocess $file_in_process is suddenly vanished");
				next;
			}

			if (rename($file_in_process, $tmp1)) {
				if ($dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password})) {
					my $sql_query = "insert into postproc (filename, tmpname) values ('$file_in_process', '$tmp1');";
					$dbh->do($sql_query);
					$dbh->disconnect;
				} else {
					s_log(LOG_WARNING, "Postprocessor: Error connect to SQL database $sql_access{db} ($DBI::errstr)");
				}
			} else {
				s_log(LOG_INFO, "Error renaming $file_in_process to $tmp1, skip");
				next;
			};

			do {
				my $fragment_duration, $current_type, %child, $text_alert;
				(undef, $tmp2) = tempfile("$vargus_servers{$hostid}{storage}/postprocess.$pp_host.$pp_pid.outfile.XXXXX", OPEN => 0);
				%child = ();
				
				if (my $fragment_info = shift(@file_fragments)) {
					$fragment_duration = ${$fragment_info}{end_time} - ${$fragment_info}{start_time} + $joint_compensation_time;
					$start_pos = ${$fragment_info}{start_time} - $start_time;
					$current_type = ${$fragment_info}{is_alert} ? 'alert' : 'common';
					if ($current_type eq 'alert') {
						$text_alert = ${$fragment_info}{message} or $text_alert = 'Alert';
						$text_alert =~ s/\0//;
						$text_alert =~ s/[,:;'"]/_/g;
					}
				} else {
					$fragment_duration = $duration;
					$current_type = $status == 3 ? 'alert' : 'common';
					$start_pos = 0 if $status > 1;
				}

				my $postprocess_command = $current_type eq 'common' ?
								$postprocess_template :
								$alerts_postprocess_template;

				$postprocess_command =~ s/_INFILE_/$tmp1/g;
				$postprocess_command =~ s/_OUTFILE_/$tmp2/g;
				$postprocess_command =~ s/_START_/$start_pos/g;
				$postprocess_command =~ s/_DURATION_/$fragment_duration/g;
				$postprocess_command =~ s/_TEXT_/$text_alert/g if $current_type eq 'alert';
				
				($file_extension = $postprocess_command) =~ s/.* -f (\S+) .*/$1/;

				$child{filename} = $tmp2;
				$child{start} = $start_time + $start_pos;
				$child{is_alert} = ($current_type eq 'alert');
				$child{type} = 8 + $child{is_alert};
				run_postprocess($postprocess_command);

				my $estimated_duration = $fragment_duration;
				my $result_duration = `mediainfo --Inform="General;%Duration%" $tmp2` / 1000;
				$child{end} = $start_time + $start_pos + $result_duration;

				$result_is_ok = $result_duration >= $estimated_duration - 10;
				unless ($result_is_ok) {
					if ($file_have_fragments) {
						s_log(LOG_WARNING, "Warning: Error postprocess file $file_in_process; fragment $start_pos - " . 
							($start_pos + $fragment_duration) . ", type $current_type will be saved untouched.");
						unlink $tmp2 if -e $tmp2;
						$tmp2 .= '.' . $orig_extension;
						$child{filename} = $tmp2;
						run_postprocess("avconv -i $tmp1 -ss $start_pos -t $fragment_duration -vcodec copy $tmp2");
						$result_duration = `mediainfo --Inform="General;%Duration%" $tmp2` / 1000;
						$child{end} = $start_time + $start_pos + $result_duration;
						$child{type} = 2 + $child{is_alert};
						$result_is_ok = 1;
					}

					if ( !$file_have_fragments && $fail_cnt ) {
						s_log(LOG_WARNING, "Warning: $file_in_process is probably damaged: estimated_duration: " . 
							"$estimated_duration; result_duration: $result_duration");
						$result_is_ok = $result_duration;
					}
				}

				unless ($result_is_ok) {
					s_log(LOG_WARNING, "Error postprocess file $file_in_process");
					s_log(LOG_DEBUG, "Original duration: $original_duration; estimated_duration: $estimated_duration; " . 
						"result_duration: $result_duration;");
					cleanup_postprocessor;
				}

				push(@p_childs, {%child});
			} while @file_fragments;


			$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) or 
				s_log(LOG_WARNING, "Postprocessor: Error connect to SQL database $sql_access{db} ($DBI::errstr)");

			unless ($dbh) {
				cleanup_postprocessor;
				next;
			}

			unless($result_is_ok) {
				$fail_cnt++;
				$dbh->do("update archive set fail_cnt=$fail_cnt where filename='$file_in_process'");
				$dbh->disconnect();
				next;
			}

			foreach my $fragment (@p_childs) {
				my $query = '';
				(my $fragment_out_filename = $out_filename) =~ s/\(date\)/(date_of:${$fragment}{start})/g;
				$fragment_out_filename =~ s/\(time\)/(time_of:${$fragment}{start})/g;
				$fragment_out_filename = expand_macroses($fragment_out_filename);
				$fragment_out_filename .= "." . (${$fragment}{type} < 8 ? $orig_extension : $file_extension);
				my $fragment_vitality = ${$fragment}{is_alert} ? $alerts_vitality : $vitality;

				if ($fragment_out_filename eq $file_in_process) {
					$query = "update archive set filename='$fragment_out_filename', hostid=$hostid, camera='$camera', " . 
					"start_time=FROM_UNIXTIME(" . ${$fragment}{start} . "), end_time = FROM_UNIXTIME(". ${$fragment}{end} . 
					"), duration=" . (${$fragment}{end} - ${$fragment}{start}) . ", vitality=$fragment_vitality, " . 
					"status=" . ${$fragment}{type} . " where filename='$file_in_process'";
				} else {
	                                $query = "insert into archive (filename, hostid, camera, start_time, end_time, duration, vitality, status)" .
                                        " values ('$fragment_out_filename', $hostid, '$camera', FROM_UNIXTIME(" . ${$fragment}{start} .
                                        "), FROM_UNIXTIME(". ${$fragment}{end} . "), " . (${$fragment}{end} - ${$fragment}{start}) .
                                        ", $fragment_vitality, " . ${$fragment}{type} . ");";
				}

				$dbh->do($query);
				rename ${$fragment}{filename}, $fragment_out_filename;
			}


			$dbh->do("delete from archive where filename='$file_in_process' and status < 4;");
			$dbh->do("delete from postproc where tmpname='$tmp1';");
			unlink $tmp1 or s_log(LOG_WARNING, "Postprocessor: Can't unlink used input file $tmp1");
			$dbh->disconnect();
		}
	}
}



sub disk_cleaner {
	$disk_cleaner_pid = fork();
	defined ($disk_cleaner_pid) or log_n_die("Error starting disk cleaner process ($!)");
	return if $disk_cleaner_pid;

	close_control_channel;
	$0 = $main_proc_title . " $daemon_role disk_cleaner ($main_pid)";

	s_log(LOG_DEBUG, "Disk cleaner process started ($$)");

	my $df_info, $filename;
	my @victims = ();
	local $dbh, $ok_to_die, $need_to_die = 0;

	$SIG{TERM} = $SIG{INT} = $SIG{PIPE} = sub {
		exit if $ok_to_die;
		$need_to_die = 1;
	};

	$SIG{HUP} = 'IGNORE';

	while (1) {
		$ok_to_die = 1;
		$df_info = df($video_storage);
		s_log(LOG_DEBUG, "Check for free space: $df_info->{bavail} -> $keep_free_space; still available: " . ($df_info->{bavail} - $keep_free_space) ); 
		while ($keep_free_space > $df_info->{bavail}) {

			s_log(LOG_DEBUG, "Low free space detected, will erase some files");

			$dbh or $dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) 
				or do {
					s_log(LOG_WARNING, "Disk cleaner: Error connect to SQL database $sql_access{db} ($DBI::errstr)");
					sleep(60);
					next;
				};

			unless (@victims) {
				$sth = $dbh->prepare("select filename from archive where status > 0 and filename like '$video_storage/%' 
							ORDER BY (UNIX_TIMESTAMP(now()) - UNIX_TIMESTAMP(start_time)) / vitality 
							DESC LIMIT 100;");
				$sth->execute;
				while (my @entry = $sth->fetchrow_array()) {
					push(@victims, \@entry);
				}
			
				$sth->finish; 

				unless (@victims) {
					s_log(LOG_INFO, "Free space low, but no files to erase detected");
					last;
				}
			}


			while (@victims) {
				($filename) = @{shift(@victims)};

				$ok_to_die = 0;
				s_log(LOG_DEBUG, "Free space: $df_info->{bavail} -> $keep_free_space; still available: " . ($df_info->{bavail} - $keep_free_space) ); 
				s_log(LOG_DEBUG, "Will erase file $filename");

				if ( -e $filename ) {
					unlink $filename or do {
						s_log(LOG_WARNING, "Disk cleaner: Error erase file $filename");
						next;
					};
				} else {
					s_log(LOG_INFO, "Disk cleaner: record $filename exist in SQL base, but file not found");
				}

				$dbh->do("delete from archive where filename='$filename'");

				$ok_to_die = 1;
				exit if $need_to_die;
				
				$df_info = df($video_storage);
				last if $keep_free_space < $df_info->{bavail};
			}
		}

		$dbh->disconnect() if $dbh;
		$dbh="";
		sleep(60);
	}
}



sub check_integrity {
	defined($check_integrity_pid = fork()) or log_n_die("Error run check integrity process ($!)");
	return if $check_integrity_pid; 

	close_control_channel;
	$0 = $main_proc_title . " $daemon_role check_integrity ($main_pid)";

	local $lockfile = "$video_storage/check_integrity_request.flag";
	my $dbh, $sth, $now_time;

	$SIG{TERM} = $SIG{INT} = $SIG{PIPE} = sub {
		my $sig_name = shift;
		s_log(LOG_DEBUG, "Check integrity: received SIG$sig_name signal");
		unlink $lockfile if -e $lockfile;
		exit;
	};

	sub release_postprocess_infile {
		my $dbh, $sth;

		# Сначала попытаемся подключимся к БД
		$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password});

		# Получаем общую часть файла из параметра
		my $pp_file = shift or return;

		foreach my $pp_in_file (glob("${pp_file}.infile.*")) {
			s_log(LOG_INFO, "Found input file $pp_in_file");
			unless ($dbh) {
				# Если нет подключения к БД, просто сотрём его
				s_log(LOG_INFO, "No DB connection, erase $pp_in_file");
				unlink($pp_in_file);
				next;
			}

			my $query_ok = 1;

			# Получаем данные об изначальном имени для этого временного файла.
			$sth = $dbh->prepare("select filename from postproc where tmpname='$pp_in_file'") or $query_ok = 0;

			$sth->execute or $query_ok = 0;

			unless ($query_ok) {
				# Если ошибка подключения к БД, просто сотрём его
				s_log(LOG_INFO, "Error query postprocess DB, erase $pp_in_file");
				unlink($pp_in_file);
				next;
			}

			while (my ($filename) = $sth->fetchrow_array) {	
				# у нас только один столбец в запросе, его и возвращаем
				# попытаемся удалить неправильную запись из БД
				s_log(LOG_INFO, "Temporary input file $pp_in_file corresponding with $filename, try to restore...");
				$dbh->do("delete from postproc where tmpname='$pp_in_file' and filename='$filename';") 
					or s_log(LOG_WARNING, "Error while remove record $pp_in_file from SQL DB ($dbh->errstr)"); 
				# переименовываем временное имя файла в изначальное
				rename($pp_in_file, $filename) or s_log(LOG_WARNING, "Error rename file $pp_in_file to $filename");
			}
			$sth->finish;

			# Если изначального входного файла не найдено в таблице или не удалось переименовать,
			# просто сотрём его
			if ( -e $pp_in_file ) {
				s_log(LOG_INFO, "Temporary input file $pp_in_file info not found or error rename it, will be deleted");
				unlink($pp_in_file);
			}
		}
		$dbh->disconnect;
	}

	$SIG{HUP} = $SIG{CHLD} = $SIG{ALRM} = 'IGNORE';
	get_hostid;

	while (1) {
		s_log(LOG_DEBUG, "Starting check integrity process");
		($now_time) = gettimeofday(); # засекаем текущее время

		if ( -e $lockfile ) {
			if ((stat($lockfile))[9] + $check_integrity_interval < $now_time) {
				s_log(LOG_WARNING, "Integrity check lockfile has been expiried, it will be ignored and deleted");
				unlink $lockfile;
			} else {
				s_log(LOG_INFO, "Some other integrity checker running, exit");
				next;
			}
		}


		if ( -e $tmp_db_file ) {
			s_log(LOG_INFO, "Temporary DB file detected, exit");
			next
		}


		open(LOCKFILE, ">$lockfile");	# создаём файл блокировки
		close(LOCKFILE);
		sleep(1);

		while (() = glob("$video_storage/postprocess.*")) {	# и ждём окончания работы всех постпроцессоров
			s_log(LOG_DEBUG, "Integrity check: some postprocessors still active, wait...");
			sleep(20);

			# проверяем слишком старые выходные файлы постпроцессинга - очевидно, создающие их процессы аварийно
			# завершились и они остались как блокирующий нас мусор.

			($now_time) = gettimeofday(); # засекаем текущее время
			foreach my $pp_out_file (glob("$video_storage/postprocess.*.outfile.*")) {
				# если (время модификации выходного файла + максимальное время постпроцессинга)
				# меньше, чем _сейчас_, тогда это устаревший файл. 
				if ((stat($pp_out_file))[9] + $postprocessing_maxtime < $now_time) {
					s_log(LOG_WARNING, "Detecting $pp_out_file as outdated, will be clean it");
					unlink($pp_out_file) or s_log(LOG_WARNING, "Error erase $pp_out_file");
					
					# Теперь нам нужно вернуть входному файлу его изначальное имя
					$pp_out_file =~ s/\.outfile\..*//; # оставляем общую часть имени файла
					release_postprocess_infile($pp_out_file); # и вызываем подпрограмму очистки
				}
			}

			# Теперь проверяем, не осталось ли висящих входных файлов постпроцессинга
			# без соответствующего выходного
			foreach my $pp_in_file (glob("$video_storage/postprocess.*.infile.*")) {
				$pp_in_file =~ s/\.infile\..*//; # оставляем общую часть имени файла
				() = glob("${pp_in_file}.outfile.*") # есть ли у нас соответсвующие выходные файлы?
					or release_postprocess_infile($pp_in_file); # Если нету - очищаем входные.
			}


		}

		($now_time) = gettimeofday();	# Засекаем время запуска процесса

		$dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password}) 
			or do {
				s_log(LOG_WARNING, "Integrity check: Error connect to SQL database $sql_access{db} ($DBI::errstr)");
				unlink $lockfile;
				next;
			};

		# Нулевая стадия: сейчас не должно работать ни одного процесса постпроцессинга.
		# Поэтому мы очищаем таблицу postproc
		$dbh->do("delete from postproc where tmpname like '%$video_storage/' or filename like '%$video_storage/'");

		# Первая стадия: проверка всех записей нашего сервера в БД на актуальность
		s_log(LOG_DEBUG, "Integrity check, stage 1");

		$sth = $dbh->prepare("select filename from archive where status > 0 and hostid=$db_hostid");
		$sth->execute;

		while (my ($filename) = $sth->fetchrow_array) {	# у нас только один столбец в запросе, его и возвращаем
			next if -f $filename;		# если есть файл с таким именем, работаем дальше

			s_log(LOG_WARNING, "Integrity error: no file for record $filename, clean");

			# попытаемся удалить неправильную запись из БД
			$dbh->do("delete from archive where filename='$filename';") 
				or s_log(LOG_WARNING, "Error while remove record $filename from SQL DB ($dbh->errstr)"); 
		}

		$sth->finish;


		# Вторая фаза: ищем, для всех ли файлов в хранилище есть записи в БД
		s_log(LOG_DEBUG, "Integrity check, stage 2");
		
		$sth = $dbh->prepare("select filename from archive where filename=?") 
			or do {
				s_log(LOG_WARNING, "Error prepare SQL query");
				unlink $lockfile;
				next;
			};

		finddepth( 	# Ищем всё в хранилище
			sub {
				if ( -f ) {	# если найденный элемент - файл, ищем запись о нем в БД
					return if $File::Find::name eq $lockfile;	# не удаляем свой лок-файл

					# не проверяем файлы, модифицированные после начала проверки
					if ((stat($File::Find::name))[9] - 1 > $now_time) {	
						s_log(LOG_DEBUG, "Integrity check: file $File::Find::name is too young to check it, skip");
						return;
					}
					$sth->execute($File::Find::name);
					unless ($sth->rows) { 	# Если запись не найдена
						s_log(LOG_WARNING, "Integrity check: file $File::Find::name has no record in database, will be erased");
						unlink $File::Find::name or s_log(LOG_WARNING, "Error erase file $File::Find::name");
					}

					$sth->rows > 1 and s_log(LOG_WARNING, "File $File::Find::name has more than one record (" . $sth->rows . ")"); 
				}

				rmdir if -d; 	# если найденный элемент - директория, попытаемся удалить: вдруг она уже пустая
			}, 
			$video_storage
		);

		$sth->finish;




		# Третья фаза: ищем в БД записи для файлов, у которых status == 0 (записываются VLC), 
		# но время начала записи > vlc_write_maxtime. Почему-то их status не был переведён в 1: 
		# то ли запись всё еще продолжается, что странно, то ли они записались некорректно.
		
		s_log(LOG_DEBUG, "Integrity check, stage 3");

		$sth = $dbh->prepare("select filename from archive where 
			status=0 and hostid=$db_hostid and UNIX_TIMESTAMP(now()) - UNIX_TIMESTAMP(start_time) > $vlc_write_maxtime;")
			or do {
				s_log(LOG_WARNING, "Error prepare SQL query");
				unlink $lockfile;
				next;
			};
		$sth->execute;

		while (my ($filename) = $sth->fetchrow_array) {	# у нас только один столбец в запросе, его и возвращаем
			s_log(LOG_WARNING, "Integrity error: filerecord $filename with status 0 is older than $vlc_write_maxtime seconds, clean");

			# попытаемся удалить неправильную запись из БД
			$dbh->do("delete from archive where filename='$filename';") 
				or s_log(LOG_WARNING, "Error while remove record $filename from SQL DB ($dbh->errstr)"); 

			# и стереть сам файл
			unlink $filename or s_log(LOG_WARNING, "Error erase file $filename");
		}
		$sth->finish;
		



		# Четвёртая фаза: ищем в БД записи для файлов, у которых fail_cnt >= 3 (т.е., три неудачных попытки 
		# постпроцессинга), и которые старше failed_files_holdtime 
		
		s_log(LOG_DEBUG, "Integrity check, stage 4");

		$sth = $dbh->prepare("select filename from archive where 
			fail_cnt>=3 and hostid=$db_hostid and UNIX_TIMESTAMP(now()) - UNIX_TIMESTAMP(start_time) > $failed_files_holdtime;")
			or do {
				s_log(LOG_WARNING, "Error prepare SQL query");
				unlink $lockfile;
				next;
			};
		$sth->execute;

		while (my ($filename) = $sth->fetchrow_array) {	# у нас только один столбец в запросе, его и возвращаем
			s_log(LOG_WARNING, "Integrity error: filerecord $filename with fail_cnt>=3 is older than $failed_files_holdtime seconds, clean");

			# попытаемся удалить неправильную запись из БД
			$dbh->do("delete from archive where filename='$filename';") 
				or s_log(LOG_WARNING, "Error while remove record $filename from SQL DB ($dbh->errstr)"); 

			# и стереть сам файл
			unlink $filename or s_log(LOG_WARNING, "Error erase file $filename");
		}
		$sth->finish;
		

		$dbh->disconnect;
		unlink $lockfile;
		s_log(LOG_DEBUG, "Integrity check complete");
	} continue {
		eval {
			local $SIG{ALRM} = sub { die "alarm\n" };
			alarm($check_integrity_interval);
			sleep(10) while 1;
			alarm(0);
		};
	}
}



sub get_hostid {
	my $query;

	my $dbh = DBI->connect($sql_access{dsn}, $sql_access{user}, $sql_access{password});
	unless ($dbh) {
		s_log(LOG_WARNING, "Error connect to SQL database $sql_access{db} for hostname registration ($DBI::errstr)");
		return;
	}

	my $query_ok = 1;
	$query = "select id from servers where hostname = '" . hostname .  "';";
#	s_log(LOG_DEBUG, "try to execute query $query");
	my $sth = $dbh->prepare($query) or $query_ok = 0;;
	$sth->execute or $query_ok = 0;

	if ($query_ok) {
		($db_hostid) = $sth->fetchrow_array;
		unless ($db_hostid) {
			$query = "insert into servers (hostname) values ('" . hostname . "');"; 
			s_log(LOG_DEBUG, "try to execute query $query");
			$dbh->do($query) and $db_hostid = $dbh->last_insert_id(undef, undef, 'servers', 'id');
			$dbh->do("update servers set storage='$video_storage' where id=$db_hostid");
			$query_ok = 0 unless $db_hostid;
		} else {
			$sth->finish;
			$sth = $dbh->prepare("select storage from servers where id=$db_hostid");
			$sth->execute;
			my ($my_storage) = $sth->fetchrow_array;
			if ($my_storage ne $video_storage) {
				s_log(LOG_DEBUG, "My old video_storage ($my_storage) is different from current ($video_storage), will update");
				$dbh->do("update servers set storage='$video_storage' where id=$db_hostid");
			}
		}
	}

	$sth->finish;
	$dbh->disconnect;

	s_log(LOG_WARNING, "Error get hostid from db") unless $query_ok;
#	s_log(LOG_DEBUG, "!!! my hostid = $db_hostid");
}


sub watch_parameters {
	$daemon_role = shift;
}


sub restart_object {
	my $obj_name = shift;
	return if $common_process;
	s_log(LOG_INFO, "Try to restart object $obj_name");
	my $founded_pid;

	foreach my $pid (keys %launchers_pid) {
		if ($launchers_pid{$pid} eq $obj_name) {
			$founded_pid = $pid;
			kill(15, $pid);
		}
	}

	s_log(LOG_INFO, "No launcher found for object $obj_name") unless $founded_pid;
	sleep(3);

	my $founded_obj;
	foreach my $channel (@vlm_channels) {
		if (${$channel}{obj_name} eq $obj_name) {
			$founded_obj = $channel; 
			vlm_launcher(%{$channel}); 
		}
	}

	s_log(LOG_INFO, "No VLM channel found for object $obj_name") unless $founded_obj;
}





sub start_control_channel {
	my $control_port = expand_macroses("(get_port:$daemon_role-control:tcp:9000)");

	unless($control_port) {
		s_log(LOG_WARNING, "Warning! Can't get control port, no control channel running");
		return;
	}

	$control_socket = IO::Socket::INET->new(
		LocalAddr => '0.0.0.0',
		LocalPort => $control_port,
		Listen => 5,
		Proto => 'tcp',
		ReuseAddr => 1
	) or do {
		s_log(LOG_WARNING, "Warning! Can't open control channel ($!)");
		return;
	};

	$control_select = IO::Select->new($control_socket) or do {
		s_log(LOG_WARNING, "Warning! Can't open (select) control channel ($!)");
		close ($control_socket) if $control_socket && $control_socket->opened();
		return;
	};

	s_log(LOG_INFO, "Open control channel on port $control_port");
}

sub switch_activity {
	my $obj_names = shift;
	my $active = shift;
	my @active_status = ('not actived', 'actived');

	return if $common_process;

	my $founded_obj;
	foreach my $obj_name (split(',', $obj_names)) {
		foreach my $channel (@vlm_channels) {
			if (${$channel}{obj_name} eq $obj_name) {
				${$channel}{active} = $active;
				s_log(LOG_INFO, "Set active status for object $obj_name to '" . $active_status[$active] . "'"); 
				restart_object($obj_name);
				$founded_obj = $channel;
			}
		}
	}
	s_log(LOG_INFO, "No VLM channel found for object $obj_name") unless $founded_obj;
}

sub switch_write {
	my $obj_names = shift;
	my $write_ok = shift;
	my @write_status = ('disabled', 'enabled');

	return if $common_process;
	return unless $daemon_role eq 'writer';

	my $founded_obj;
	foreach my $obj_name (split(',', $obj_names)) {
		foreach my $channel (@vlm_channels) {
			if (${$channel}{obj_name} eq $obj_name) {
				${$channel}{write_ok} = $write_ok;
				s_log(LOG_INFO, "Set write status for object $obj_name to '" . $write_status[$write_ok] . "'"); 
				restart_object($obj_name);
				$founded_obj = $channel; 
			}
		}
	}
	s_log(LOG_INFO, "No VLM channel found for object $obj_name") unless $founded_obj;
}

sub switch_group_activity {
	my $obj_name = shift;
	my $active = shift;
	my $vargus_server = 'localhost';
	my @active_status = ('not actived', 'actived');

	return if $common_process;

	my $founded_obj;
	s_log(LOG_INFO, "Try to switch activity for set $obj_name");

	my $set_info = do_remote_query($vargus_server, "query set;$obj_name;cameras");
	return unless $set_info;

	my $founded_pid = 0;
	foreach my $obj_name (split(',', $set_info)) {

		foreach my $pid (keys %launchers_pid) {
			if ($launchers_pid{$pid} eq $obj_name) {
				$founded_pid = $pid unless $founded_pid;
				kill(15, $pid);
			}
		}
	}

	unless ($founded_pid) {
		s_log(LOG_INFO, "No launched objects found for set $obj_name");
	}
	sleep(3);

	foreach my $obj_name (split(',', $set_info)) {
		my $founded_obj = 0;
		foreach my $channel (@vlm_channels) {
			if (${$channel}{obj_name} eq $obj_name) {
				$founded_obj = $channel;
				${$channel}{active} = $active;
				s_log(LOG_INFO, "Set active status for object $obj_name to '" . $active_status[$active] . "'"); 
				my $save_init_delay = ${$channel}{countdown};
				${$channel}{countdown} = 0;
				vlm_launcher(%{$channel});
				${$channel}{countdown} = $save_init_delay;
			}
		}
		s_log(LOG_INFO, "No VLM channel found for object $obj_name") unless $founded_obj;
	}
	$info{group_activity}{$obj_name} = $active;
}

sub switch_group_write {
	my $obj_name = shift;
	my $write_ok = shift;
	my $vargus_server = 'localhost';
	my @write_status = ('disabled', 'enabled');

	return if $common_process;
	return unless $daemon_role eq 'writer';

	my $founded_obj;
	s_log(LOG_INFO, "Try to start write for set $obj_name");

	my $set_info = do_remote_query($vargus_server, "query set;$obj_name;cameras");
	return unless $set_info;

	my $founded_pid = 0;
	foreach my $obj_name (split(',', $set_info)) {

		foreach my $pid (keys %launchers_pid) {
			if ($launchers_pid{$pid} eq $obj_name) {
				$founded_pid = $pid unless $founded_pid;
				kill(15, $pid);
			}
		}
	}

	unless ($founded_pid) {
		s_log(LOG_INFO, "No launched objects found for set $obj_name");
	}
	sleep(3);

	foreach my $obj_name (split(',', $set_info)) {
		my $founded_obj = 0;
		foreach my $channel (@vlm_channels) {
			if (${$channel}{obj_name} eq $obj_name) {
				$founded_obj = $channel;
				${$channel}{write_ok} = $write_ok;
				s_log(LOG_INFO, "Set write status for object $obj_name to '" . $write_status[$write_ok] . "'"); 
				my $save_init_delay = ${$channel}{countdown};
				${$channel}{countdown} = 0;
				vlm_launcher(%{$channel});
				${$channel}{countdown} = $save_init_delay;
			}
		}
		s_log(LOG_INFO, "No VLM channel found for object $obj_name") unless $founded_obj;
	}
	$info{group_write}{$obj_name} = $write_ok;
}


sub handle_control_channel {
	my $command;

	sub command_proceed {
		my $handle = shift;
		my $command = shift;
		my $args;
		
		($command, $args) = split(' ', $command, 2);

		if ($command eq 'restart_object') {
			restart_object($args);
			return;
		}

		if ($command eq 'start_object') {
			switch_activity($args, 1);
		}

		if ($command eq 'stop_object') {
			switch_activity($args, 0);
		}

		if ($command eq 'start_write') {
			switch_write($args, 1);
		}

		if ($command eq 'stop_write') {
			switch_write($args, 0);
		}

		if ($command eq 'start_group') {
			switch_group_activity($args, 1);
		}

		if ($command eq 'stop_group') {
			switch_group_activity($args, 0);
		}

		if ($command eq 'start_group_write') {
			switch_group_write($args, 1);
		}

		if ($command eq 'stop_group_write') {
			switch_group_write($args, 0);
		}

		if (grep /^$command$/, ('get_group_write', 'get_group_activity', 'get_write', 'get_activity')) {
			my $info_type;
			(undef, $info_type) = split('_', $command, 2);
			my $msg = $info{$info_type}{$args} . "\n";
			my $writed = syswrite($handle, $msg, length($msg));
			unless ($writed and $writed == length($msg)) {
				s_log(LOG_WARNING, "Unable to send data to " . $handle->peerhost);
			}
		}

	}

	while (my @r = $control_select->can_read(0.01)) {
		for my $handle (@r) {
			if ($handle eq $control_socket) {
				my $connection = $control_socket->accept();
				$control_select->add($connection);
				s_log(LOG_INFO, "Get control connection from " . $connection->peerhost);
			} else {
				$command = '';
				while(sysread $handle, my $buf, 1024) {
					$command .= $buf;
					last if $buf =~ /\n/ or length $command >= 1024;
				}

				$command  =~ s/[\x00-\x08\x0A-\x1F]//g;

				if ($command) {
					s_log(LOG_INFO, "Control: get command from " . $handle->peerhost . ": $command");
				}

				unless($command =~ /^get_/) {
					s_log(LOG_DEBUG, "Close control connection from " . $handle->peerhost);
					$control_select->remove($handle);
					close($handle);
				}

				if ($command) {
					foreach (split(/\n/, $command)) {
						s_log(LOG_DEBUG, "Control: process command $_");
						command_proceed($handle, $_);
					}
				}

				if ($handle) {
					s_log(LOG_DEBUG, "Close control connection from " . $handle->peerhost);
					$control_select->remove($handle);
					close($handle);
				}

			}
		}
	}
}


sub close_control_channel {
	return unless $control_select;
	for my $handle ($control_select->handles) {
		$control_select->remove($handle);
		s_log(LOG_DEBUG, "Close control connection from " . $handle->peerhost);
		close($handle);
	}
	close ($control_socket) if $control_socket && $control_socket->opened();
}


sub prepare_to_die {
	s_log(LOG_WARNING, "Die procedure initiated");
	my $vargus_mustdie = shift;
	$heartbeat = 0;

	if ($daemon_pid && $common_process) {
		s_log(LOG_DEBUG, "Try to kill $watchdog_pid and $daemon_pid");
		kill 15, $watchdog_pid;
		kill 15, $daemon_pid or s_log(LOG_WARNING, "VLC daemon probably alive");
		eval {
			local $SIG{ALRM} = sub { die "alarm\n" };
			alarm(3);
			waitpid($watchdog_pid, 0);
			alarm(0);
		};

		if ($@ and $@ eq "alarm\n") {
			s_log(LOG_WARNING, "VLC don't accept his die, kill with SIGKILL");
			kill 9, $daemon_pid;
		}

	}

	if (! $common_process) {
		foreach (keys %launchers_pid) {
			s_log(LOG_DEBUG, "Try to kill VLM launcher $_");
			kill(15, $_) or do {
				s_log(LOG_WARNING, "May be problems to kill VLM launcher $_");
				eval {
					local $SIG{ALRM} = sub { die "alarm\n" };
					alarm(3);
					waitpid($_, 0);
					alarm(0);
				};
			};
		}
	}
	
	$dbh->disconnect() if $dbh;
	close_control_channel;
	kill 15, @postprocessor_pids if @postprocessor_pids;
	kill 15, $disk_cleaner_pid if $disk_cleaner_pid;
	kill 15, $check_integrity_pid if $check_integrity_pid;
	kill 15, $dbus_pid if $dbus_pid;
	unlink $stat_file if -e $stat_file;
	unlink $stat_lock_file if -e $stat_lock_file;
	unlink $pid_file if -e $pid_file and $pid_file_assigned;
	unlink $tmp_daemon_cfg or s_log(LOG_WARNING, "No daemon temporary config was deleted");
	unlink $vlm_config if @vlm_channels && $vlm_config;
	die if $vargus_mustdie;
	exit
}


sub reborn {
	sleep(0.5);
	s_log(LOG_INFO, "Reborn procedure initiated");
	if ($common_process) {
		kill 15, $watchdog_pid;
		kill 15, $daemon_pid;
		waitpid($watchdog_pid, 0) if $watchdog_pid;
		unlink $vlm_config if @vlm_channels;
	} else {
		foreach (keys %launchers_pid) {
			s_log(LOG_DEBUG, "Try to kill VLM launcher $_");
			kill(15, $_) or do {
				s_log(LOG_WARNING, "May be problems to kill VLM launcher $_");
				eval {
					local $SIG{ALRM} = sub { die "alarm\n" };
					alarm(3);
					waitpid($_, 0);
					alarm(0);
				};
			};
		}
	}
	
	kill 15, @postprocessor_pids if @postprocessor_pids;
	kill 15, $disk_cleaner_pid if $disk_cleaner_pid;
	kill 15, $check_integrity_pid if $check_integrity_pid;
	init_objects;
	init_vlm_channels;
	get_hostid if $daemon_role eq 'writer' and %sql_access;
	update_DB_from_file if -e $tmp_db_file;
	check_integrity if $use_check_integrity;

	if ($use_postprocess) {
		@postprocessor_pids = ();
		push (@postprocessor_pids, start_postprocessor) for (1..$postprocess_threads);
	}

	disk_cleaner if $keep_free_space;
	start_vlc;
}


sub revive {
	$time_to_live = $revive_in;
}





### START HERE ##########################################################
#

s_log(LOG_INFO, "Starting Vargus as: " . join(' ',@ARGV));

$vargus_user = 'vargus';
($new_uid, $new_gid, @new_gids) = drop_privileges($vargus_user) or log_n_die("Could not drop privileges") if not $>;

our $daemon_name;
$daemon_mode = 1;
$time_control = 1;
$subchannel = 0;
$has_objects = 0;
$conf_dir = "/etc/vargus";
$stat_dir = "/var/cache/vargus";
our $informer_port = 9165;
our $stat_lock_file;
$tmp_db_file = $stat_dir . "/tmp_db.txt";
$video_storage = "/home/video";
@channel_variants=('A','B');
@object_capable_names=('player', 'writer', 'viewer');
$failed_files_holdtime = 3600 * 24 * 10;# 10 суток для хранения файлов со счётчиком сбоя постпроцессинга >= 3
$vlc_write_maxtime = 3600 * 3;		# Три часа - максимальное время VLC для записи файлов
$postprocessing_maxtime = 60 * 30;	# 30 минут - максимальное время на постпроцессинг одного файла
$check_integrity_interval = 3600 * 24;
$restore_db_interval = 60;
our $db_hostid = 0;
$obj_name = "";
$obj_id = "";
%v4l_bus_assigned = ();
my $process_model= '';
$common_process = 0;
our $main_proc_title;
$main_pid = 0;
%launchers_pid = ();
@daemon_cfg_body = ();
%sql_access = ();
$use_postprocess = 0;
$postprocess_threads = 0;
$use_check_integrity = 0;
@postprocessor_pids = ();
$disk_cleaner_pid = 0;
$check_integrity_pid = 0;
$keep_free_space = 0;

$control_socket = '';
$control_select = '';

our %info;

$main_proc_title = $daemon_name = $0;
$daemon_name =~ s|.*/||;
$0 = $main_proc_title . " " . join(" ", @ARGV);

GetOptions ('daemon!' => \$daemon_mode,
	    'time-control!' => \$time_control,
    	    'subchannel=i' => \$subchannel,
    	    'process-model=s' => \$process_model,
	    '<>' => \&watch_parameters);

$daemon_role or log_n_die("No VLM daemon role name given");

if (basename($daemon_role) =~ /^[0-9][0-9]-/) {
	$daemon_cfg = abs_path($daemon_role);
	-e $daemon_cfg or $daemon_cfg = $conf_dir . "/" . basename($daemon_role);
	-e $daemon_cfg or log_n_die("No vargus config found ($daemon_cfg)");
	$conf_dir = dirname($daemon_cfg);
	$daemon_role = $daemon_full_name = basename($daemon_role);
	$daemon_role =~ s/^[0-9][0-9]-//;
} else {
	($daemon_cfg) = glob($conf_dir . "/[0-9][0-9]-$daemon_role");
	$daemon_full_name = basename($daemon_cfg) if $daemon_cfg;
}

$daemon_cfg or log_n_die("No VLC daemon config found");

$pid_file = "/var/run/vargus/$daemon_role.pid";
-e $pid_file and log_n_die("PID file $pid_file already exist");

$stat_file = $stat_dir . "/$daemon_full_name.stat";
if (-e $stat_file) {
	unlink($stat_file) or s_log(LOG_WARNING, "Can't remove old stat file");
}

$stat_lock_file = $stat_dir . "/get_port.$daemon_full_name.lock";
if (-e $stat_lock_file) {
	unlink($stat_lock_file) or s_log(LOG_WARNING, "Can't remove old stat lock file $stat_lock_file");
}

init_daemon_cfg;

(my $my_group) = getgrgid($)); 
(undef,undef,undef,my $allowed_members) = getgrnam($allowed_group);
foreach (split(' ', $allowed_members)) {
	$ok_as_member = 1 if $_ eq getpwuid($>);
}

$my_group eq $allowed_group or $ok_as_member or log_n_die("Caller group '$my_group' is not allowed to run vargus");

if ($process_model) {
	if ($process_model eq 'separated') {
		$common_process = 0;
	} elsif ($process_model eq 'common') {
		$common_process = 1;
	} else {
		log_n_die("Unknown process model: $process_model");
	}
}
%sql_access = () if $common_process;


foreach (`dbus-launch --exit-with-session`) {
	chomp($_);
	($db_env, $db_val) = split("=", $_, 2);
	$ENV{$db_env} = $db_val;
	$dbus_pid = $db_val if $db_env eq "DBUS_SESSION_BUS_PID";
}

$dbus_pid or s_log(LOG_WARNING, "Warning: unknown dbus pid");

$heartbeat = 1;
$SIG{INT} = $SIG{TERM} = $SIG{PIPE} = \&prepare_to_die;
$SIG{CHLD} = 'IGNORE';
Proc::Daemon::Init if $daemon_mode;
$SIG{HUP} = \&reborn;
$SIG{USR1} = \&revive;
$SIG{USR2} = sub {
	kill SIGALRM, $check_integrity_pid if $check_integrity_pid;
};

$SIG{CHLD} = sub {
	local ($!,$?);
	my $pid = waitpid(-1, WNOHANG);
	return if $pid == -1;
	return unless defined $launchers_pid{$pid};
	delete $launchers_pid{$pid};
} unless $common_process;


# Check it twice
-e $pid_file and log_n_die("PID file $pid_file already exist");
$pid_file_assigned = open(PIDFILE, "> $pid_file") or log_n_die("Can't open PID file $pid_file");
print PIDFILE $$ or log_n_die("Can't write PID to $pid_file");
close(PIDFILE);
$main_pid = $$;

$generated_ports{telnet} or $generated_ports{telnet} = $telnet_port;
open(STATFILE, "> $stat_file") or s_log(LOG_WARNING, "Can't create stat file $stat_file");
foreach $key (keys %generated_ports) {
	print STATFILE $key . ":" . $generated_ports{$key} . "\n";
}
close(STATFILE);


$vlm_config or init_objects;
$vlm_config or init_vlm_channels;
get_hostid if $daemon_role eq 'writer' and %sql_access;
update_DB_from_file if -e $tmp_db_file;
check_integrity if $use_check_integrity;
if ($use_postprocess) {
	push (@postprocessor_pids, start_postprocessor) for (1..$postprocess_threads);
}
disk_cleaner if $keep_free_space;

start_control_channel;
start_vlc;


my $life_counter = 0;
my $current_ts = gettimeofday();

while ($heartbeat) {
	if ($common_process) {
		foreach $vlm (@vlm_channels) {
			if (${$vlm}{repeat_mode}) {
				if (not --${$vlm}{countdown}) {
					@telnet_dialog = ();
					my $chan_name = ${$vlm}{name};
					$chan_name .= "_" . $channel_variants[${$vlm}{variant}] if 
						${$vlm}{overlap};
					push(@telnet_dialog, "control $chan_name stop") if
						${$vlm}{sleep_controlled};

					if (${$vlm}{overlap}) {
						${$vlm}{variant} ^= 1;
						$chan_name = ${$vlm}{name} . 
							"_" . $channel_variants[${$vlm}{variant}];
					}

					push(@telnet_dialog, IO_telnet_dialog($chan_name, %{$vlm}));
					say_to_daemon(@telnet_dialog);
					${$vlm}{countdown} = ${$vlm}{repeat_interval};
				}
			}
		}
	}
	$time_to_live && --$time_to_live or 
		log_n_die("Die due no revive signals receive within $revive_in seconds") if
		$revive_in;

	($now_seconds) = gettimeofday();

	update_DB_from_file if -e $tmp_db_file and $use_check_integrity and
		(int($now_seconds / $restore_db_interval) * $restore_db_interval) == $now_seconds;

	my $next_ts = $current_ts + ++$life_counter;
	while (gettimeofday() <= $next_ts) {
		if ($control_socket && $control_socket->opened()) {
			handle_control_channel;
		} else {
			sleep 0.01;
		}
	}
}
