#!/usr/bin/perl

# Author: tomekk                                                                                                                                                                          
# e-mail:  tomekk/@/tomekk/./org                                                                                                                                                   
# home page: http://tomekk.org/                                                                                                                                               
#                                                                                                                                                                                         
# Version 0.2
#                                                                                                                                                                             
# This file is Copyrighted under the GNU Public License.                                                                                                                                  
# http://www.gnu.org/copyleft/gpl.html                                                                                                                                                    
##########################################################

# added: _ char to the regexp with cmd name
# fixed: log handling, simple 2>&1 instead of open()

# some uses
use utf8;
use strict;
use warnings;
use YAML::Tiny;
use Proc::Daemon;
use MIME::Base64;
use Proc::Killfam;
use Authen::Simple;
use HTTP::Daemon::SSL;
use Fcntl qw( :flock );
use Parallel::ForkManager;
use Authen::Simple::Passwd;
use Sys::Syslog qw( :DEFAULT setlogsock);

# config path
my $config_file = "/etc/brad/agent_config.yml";

##########################################################
# spawn demon!
Proc::Daemon::Init;

# output buffering mode
# flush immediately
$| = 1;

# farm of vars
my ($httpsrv, $client, $pm, $response);
my ($config, %vars_vals, $continue, $authen);
my ($c_request, $c_host, $c_content);
my (@scripts, $script_mode, $the_script, $script_pid);
my ($xml, $runtime, $err, $the_log, $exit_code, $cpid);
my (@file_jobs, $file_job, $jpid, $jscript, $jtimestamp, $jhost, $jlog);

# read config
$config = YAML::Tiny->new;
$config = YAML::Tiny->read($config_file) or logndie("cannot open config file: $!");

# simple, additional config test
if (!-d $config->[0]->{scripts}->{dir}) 
{
	# error about problem with reading the scripts will be in execution ... (it should be ... ;))
	# here - check only directory
	logndie("directory with scripts does not exists: $config->[0]->{scripts}->{dir}");
}

if (!-d $config->[0]->{scripts}->{logs})
{
        # error about problem with reading the scripts will be in execution ... (it should be ... ;))
        # here - check only directory
        logndie("directory with logs does not exists: $config->[0]->{scripts}->{logs}");
}

if (trim($config->[0]->{agent}->{cmds}) eq "")
{
	# no commands listed?
	logndie("no commands listed? so, nothing to do, check 'cmds' in config file");
}

if (!-f $config->[0]->{agent}->{htpasswd_file})
{
	# some problem with pass file
	logndie("some problem with htpasswd file (maybe not found?): $config->[0]->{agent}->{htpasswd_file}");
}

# wipe the 'jobs file'
# to the file, script will be writing curr. running jobs
open(JOBS, ">", $config->[0]->{agent}->{jobs_file}) or logndie("cannot wipe jobs file: $config->[0]->{agent}->{jobs_file}");
flock(JOBS, LOCK_EX | LOCK_NB);
close(JOBS);

# auth module
# based on htpasswd
$authen = new Authen::Simple(Authen::Simple::Passwd->new(path => $config->[0]->{agent}->{htpasswd_file}));

# start socket daemon
$httpsrv = new HTTP::Daemon::SSL(SSL_cert_file => $config->[0]->{agent}->{ssl_cert_file}, SSL_key_file  => $config->[0]->{agent}->{ssl_key_file}, LocalPort => $config->[0]->{agent}->{port}, LocalAddr => $config->[0]->{agent}->{host}, Listen => 64, ReuseAddr => 1) or logndie("socket listening error: $!");

# start msg
logit("starting bladerunner agent, agent host: $config->[0]->{agent}->{host}, agent port: $config->[0]->{agent}->{port}, max clients: $config->[0]->{agent}->{max_clients}, htpasswd path: $config->[0]->{agent}->{htpasswd_file}, scripts directory: $config->[0]->{scripts}->{dir}, logs directory: $config->[0]->{scripts}->{logs}, available commands: $config->[0]->{agent}->{cmds}");

# parallel fork manager, process limit
$pm = Parallel::ForkManager->new($config->[0]->{agent}->{max_clients});

# signals...
# regular kill
$continue = 1;
$SIG{TERM} = sub {
        logit("caught SIGTERM: exiting gracefully");
        $continue = 0;
};

# main loop
while ($continue)
{
	# each client..
	$client = $httpsrv->accept;

	# do the fork
	$pm->start and next;

	# and do the client work
	client_jobs($client, $authen);

	# after that....
	$pm->finish;
}

# let kids come back home
$pm->wait_all_children;

##########################################################
# client jobs, one-client-by-one
sub client_jobs
{
	my ($client, $authen) = @_;

	# req / client IP a.k.a. host
	$c_request = $client->get_request;
	$c_host = $client->peerhost;

	# start connection info
	logit("connection started, client host: $c_host");

	# only for authorized users
	if (!doauth($c_request, $authen))
	{
		logit("authorization request, client host: $c_host");
		$response = new HTTP::Response(401, "Authorization Required");
	     	$response->header('WWW-Authenticate' => 'Basic realm="authorization required"');
		$client->send_response($response);

		# end connection info (unauthorized)
		logit("connection ended, client host: $c_host");


                return;
	}

	# want only POSTs
	if ($c_request->method ne 'POST')
	{
		logit("wrong request method, client host: $c_host");
		$client->send_error(403);
		
		# end connection info (invalid method)
	        logit("connection ended, client host: $c_host");

		return;
	}

	$c_content = $c_request->content;

	# don't waste my time for empty POSTs
	if (trim($c_content) eq "")
	{
		logit("bad or empty request, client host: $c_host");
                $client->send_error(400);

                # end connection info (bad request)
                logit("connection ended, client host: $c_host");

                return;
	}
	
	# if we're here, should be OK... (login OK)
	logit("authorization successful, client host: $c_host");

	# parse query data, make array with vars / vals 
	%vars_vals = parse_query($c_request->content);

	# no cmd var in POST
	# or val is empty
	# or command not found ;o)
	if (!$vars_vals{"cmd"} || $vars_vals{"cmd"} eq "" || !check_cmd($config->[0]->{agent}->{cmds}, $vars_vals{"cmd"}))
	{
		logit("bad POST command, client host: $c_host");
		$client->send_error(400);

		# end connection info (bad command)
                logit("connection ended, client host: $c_host");

		return;
	}
	
	# process commands
	# and prepare XML output
	# leave modules, just make a proper string
	$xml = "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
	$xml .= "<brad>";
	$xml .= "<command>";
	$xml .= "<timestamp>" . time . "</timestamp>";
	$xml .= "</command>";
	$xml .= "<response>";

	# some ifs, looks better for me than elsifs ;o)
	# c: ping
	if ($vars_vals{"cmd"} eq "ping")
	{
		$xml .= "<data>ok</data>";
	}

	# c: clist - list available commands
	if ($vars_vals{"cmd"} eq "clist")
	{
		foreach (split(',', $config->[0]->{agent}->{cmds}))
		{
			$xml .= "<data>" . trim($_) . "</data>";
		}
	}


	# c: slist - list all of scripts in directory
	if ($vars_vals{"cmd"} eq "slist")
	{
		opendir(SCRIPTS_DIR, $config->[0]->{scripts}->{dir});
		@scripts = readdir(SCRIPTS_DIR); 

		if (scalar(@scripts) - 2 > 0)
		{
			foreach (@scripts)
			{
				if ($_ ne '.' && $_ ne '..')
				{
					$script_mode = sprintf '%04o', (stat($config->[0]->{scripts}->{dir} . "/" . $_))[2] & 07777;

					$xml .= "<script>";
					$xml .= "<name>" . trim($_) . "</name>";
					$xml .= "<mode>" . $script_mode . "</mode>";
					$xml .= "</script>";
				}
			}
		}

		closedir(SCRIPTS_DIR);
	}

	# c: run - run the script
	# two arguments - command and script name
	if ($vars_vals{"cmd"} eq "run" && $vars_vals{"arg1"} ne "")
	{
		$the_script = $config->[0]->{scripts}->{dir} . "/" . $vars_vals{"arg1"};

		if (-e $the_script)
		{
			if (-x $the_script)
			{
				$script_pid = fork();

				if($script_pid < 0)
				{
					logit("failed to fork process: " . $vars_vals{"arg1"} . ", client host: $c_host");
    				} elsif ($script_pid == 0) {
					# timestamp
					$runtime = time;

					logit("job started, script: $the_script, pid: $$, client host: $c_host");

					# log path
					$the_log = $config->[0]->{scripts}->{logs} . "/" . $runtime . "." . $$ . ".log";

					# child_pid;script_name;timestamp;host_ip;log_file
					add_job("$$;" . $vars_vals{"arg1"} . ";$runtime;$c_host;$runtime" . "." . $$ . ".log");
					
					# run run....
					$exit_code = system("$the_script >> " . $the_log . " 2>&1") >> 8;

					# remove job from list
					delete_job($$);

					logit("job ended, script: $the_script, pid: $$, exit code: $exit_code, client host: $c_host");

					# child, please...	
					exit(0);
				}
				$xml .= "<data>" . $script_pid . "</data>";
			} else {
				$xml .= "<data>notx</data>";
			}
		} else {
			$xml .= "<data>note</data>";
		}
	}

	# c: kill - kill the running job
        if ($vars_vals{"cmd"} eq "kill" && $vars_vals{"arg1"} ne "")
	{
		if ($vars_vals{"arg1"} =~ /^[0-9]+$/)
		{
			# kill only 'our' jobs
			if (check_job($vars_vals{"arg1"}))
			{
				# recursively searches the process table for children and kills them as well
				killfam 'KILL', $vars_vals{"arg1"};
	
				# remove job from list
				delete_job($vars_vals{"arg1"});
	
				logit("job killed, child-pid: " .  $vars_vals{"arg1"} . ", client host: $c_host");
	
				$xml .= "<data>ok</data>";
			} else {
				$xml .= "<data>wpid</data>";
			}
		} else {
			$xml .= "<data>wpid</data>";
		}
	}

	# c: jlist - list currently running jobs/scripts/commands whatever...
        if ($vars_vals{"cmd"} eq "jlist")
        {
		open(JOBS_IN, $config->[0]->{agent}->{jobs_file}) or logit("cannot read jobs from the jobs file: $config->[0]->{agent}->{jobs_file}");
	        flock(JOBS_IN, LOCK_SH | LOCK_NB);
        	@file_jobs = <JOBS_IN>;
	        close(JOBS_IN);

		if (scalar(@file_jobs) > 0)
		{
			foreach $file_job (@file_jobs)
			{
				chomp($file_job);
				($jpid, $jscript, $jtimestamp, $jhost, $jlog) = split(/;/, $file_job); 
				$xml .= "<job><pid>" .  $jpid . "</pid><script>" . $jscript . "</script><timestamp>" . $jtimestamp . "</timestamp><host>" . $jhost . "</host><log>" . $jlog . "</log></job>";
	        	}
		} else {
			$xml .= "<data>notr</data>";
		}
	}

	# end XML
	$xml .= "</response>";
	$xml .= "</brad>\n";

	# prepare and send response
       	# close connection at the end
	$response = HTTP::Response->new(200);
	$response->header('Content-Type' => 'text/xml');
	$response->content($xml);
	$client->send_response($response);
	$client->close;

	# end connection info (all were OK)
        logit("connection ended, client host: " . $c_host);
}

# parse query string
# allow only letters, numbers in vars and extra . and _ in vals
# make array
sub parse_query
{
	my ($query) = @_;

	my %vars_vals_array;
	my @var_list = split(/\&/, $query);

	foreach (@var_list) 
	{
		my ($var, $val) = split(/=/);

		$var = lc($var);
		$val = lc($val);

		# url encoded
		$val =~ s/%([0-9a-f]{2})/sprintf("%c", hex($1))/ge;
		
		if ($var =~ /^[a-z0-9]+$/)
		{
			if ($val =~ /^[a-z0-9\._]+$/)
			{
				$vars_vals_array{$var} = $val;
			}
		}
	}

	return %vars_vals_array;
}

# syslog log function
# daemon facility, info level
sub logit
{
        my $msg = shift;

        my $pid = $$;

        setlogsock('unix');
        openlog("brad[$pid]", '', 'daemon');
        syslog('info', $msg);
        closelog;
}

# log and die ;-)
sub logndie
{
	my $msg = shift;

	logit($msg);
	die "\n";
}

# get auth data from header
# check user / pass
sub doauth 
{
	my ($c_request, $authen) = @_; 

	my $auth_header = $c_request->header('Authorization');

	if (not defined $auth_header) 
	{
		return undef;
	}

	# we need just second part of the string
	if ($auth_header !~ s/^basic (\S+).*/$1/i)
	{
		return undef;
	}

	my ($user, $pass) = split(/:/, decode_base64($auth_header), 2);

	if ($authen->authenticate($user, $pass)) 
	{
		return $user;
	}

	return undef;
}

# check if command 'exists'
sub check_cmd
{
	my ($cmd_string, $input_cmd) = @_;

	my @cmds = split(/,/, $cmd_string);

	my $not_found = "yes";

	my $cmd;

	foreach (@cmds) 
	{
		$cmd = trim($_);

		if ($cmd eq $input_cmd)
		{	
			# do not load trash data from cmds
			# only letters / numbers like for the rest of commands, in other places
			if ($cmd =~ /^[a-z0-9]+$/)
			{
				$not_found = "no";
				last;
			}
		}
	}

	if ($not_found eq "no")
	{
		return $input_cmd;
	}

	return undef;
}

# there is a possibility to make those subs better ;o)
# add job to the running job list file
sub add_job
{
	my $job_data = shift;

	open(JOBD, ">>", $config->[0]->{agent}->{jobs_file}) or logit("cannot add job to the jobs file: $config->[0]->{agent}->{jobs_file}");
	flock(JOBD, LOCK_EX | LOCK_NB);
	print JOBD $job_data . "\n";
	close(JOBD);
}

sub delete_job
{
	my $pid = shift;
	my $job;

	open(JOBS_IN, $config->[0]->{agent}->{jobs_file}) or logit("cannot read jobs from the jobs file: $config->[0]->{agent}->{jobs_file}");
	flock(JOBS_IN, LOCK_SH | LOCK_NB);
	my @jobs = <JOBS_IN>; 
	close(JOBS_IN); 

	open(JOBS_OUT, ">", $config->[0]->{agent}->{jobs_file}) or logit("cannot update jobs list in the jobs file: $config->[0]->{agent}->{jobs_file}");
	flock(JOBS_OUT, LOCK_EX | LOCK_NB);
	foreach $job (@jobs) 
	{ 
		chomp($job);
        	print JOBS_OUT $job . "\n" unless($job =~ m/^\b$pid\b/); 
    	} 
    	close(JOBS_OUT); 
}

# check job if exists on the list
sub check_job
{
	my $pid = shift;
	my (@jobs, $job);

	open(JOBS, $config->[0]->{agent}->{jobs_file}) or logit("cannot check the job in the jobs file: $config->[0]->{agent}->{jobs_file}");
	flock(JOBS, LOCK_SH | LOCK_NB);
	@jobs = <JOBS>;
	close(JOBS);

	if (grep m/\b^$pid\b/, @jobs)
	{
		return $pid;
	}

	return undef;
}

# c'mon PERL, trim!
sub trim
{
        my $trim = shift;

        $trim =~ s/^\s+//;
        $trim =~ s/\s+$//;

        return $trim;
}
