path: root/client/scireclient.pl

#!/usr/bin/perl

# $Id$

use strict;
use warnings;

use IPC::Open2;
use Getopt::Long;
use Data::Dumper;
use File::Path;
use Sys::Hostname;

my $ETC_DIR = "/etc/scire";
my $SCIRE_CONFIG_FILE = "${ETC_DIR}/scire.conf";
my %conf;
my ($SERVER_STDOUT, $SERVER_STDIN);
my $connection_pid;

run_main();

sub run_main {
	parse_command_line();
	my $conf_file = (defined($conf{config})) ? $conf{config} : $SCIRE_CONFIG_FILE;
	read_config_file($conf_file);

	check_job_dir();

	my $connection_command = build_connection_command();

	#ok folks so here's how this thang goes down.
	#1. Connect.
	create_connection($connection_command);

	#2. Register with the DB. (only it knows if you're allowed to be active)
	#   If we do not have a defined key file, we assume this is the first run of this client
	#   so we register them instead of trying to identify.
	if(defined($conf{key_file}) and (-f $conf{key_file})) {
		if(!identify_client()) {
			exit(1);
		}
	} else {
		register_client();
		exit(0);
	}

	#3. Scan the jobs directory.  If there are done/failed jobs, report them.  Note jobs in running or queue.
	my @existing_jobs = scan_jobs_dir();
	#4. Fetch the jobs list
	get_jobs();
	#5. ???
	#6. Profit!
}

sub parse_command_line {
	GetOptions(
		'debug|d' => \$conf{debug},
		'dry-run' => \$conf{dry_run},
		'help|h' => \$conf{help},
		'config|c=s' => \$conf{config},
		'threads|t=i' => \$conf{max_threads},
		
		#config overrides.
		'host=s' => \$conf{host},
		'port=i' => \$conf{port},
		'user|u=s' => \$conf{user},
		'server_script=s' => \$conf{server_script},
		'job_dir' => \$conf{job_dir},
	);
	if ($conf{help}) {
		print "\nusage: scireclient.pl [--debug or -d]\n\t [--dry-run]"
			."\t [--config=CONF or -c] \n\t [--threads=# or -t] \t [--help or -h] \n"
			."\t [[--host=HOST] \t [--port=PORT] \t [--user=USER or -u] \n\t"
			." [--server_script=foo.pl] \t [--job_dir=/tmp/jobs] \n";
		exit 0;
	}

}

sub send_command {
	my $cmd = shift;
	my @args = @_;
	my $tosend = "${cmd}";

	for my $arg (@args) {
		if($arg =~ /^[0-9]+$/) {
			$tosend .= " ${arg}";
		} else {
			$arg =~ s/"/\\"/g;
			$tosend .= " \"${arg}\"";
		}
	}
	debug("Sending: ${tosend}");
	print SERVER_STDIN "${tosend}\n";
	#FIXME WE NEED A TIMEOUT HERE OF SOME SORT!!
	#if the server doesn't give you a newline this just hangs!
	my $response = <SERVER_STDOUT>;
	debug("Got response: ${response}");
	return $response;
}

sub parse_response {
	my $response = shift;
	$response =~ /^(OK|ERROR)(?: (.+))?$/;
	my ($status, $message) = ($1, $2);
	return ($status, $message);
}

sub create_connection {
	# XXX: How do we capture this error? $pid has a valid value even if the
	# process fails to run, since it just returns the PID of the forked perl
	# process. I tried adding 'or die' after it, but it didn't help since it
	# doesn't fail in the main process. When it fails, it outputs an error
	# to STDERR:
	# open2: exec of ../server/scireserver.pl failed at ./scireclient.pl line 116
	my $connection_command = shift;
	$connection_pid = open2(*SERVER_STDOUT, *SERVER_STDIN, $connection_command);
}

sub build_connection_command {
	# This will eventually be something like "ssh scire@${scireserver} /usr/bin/scireserver.pl"
	my $connection_command = "ssh ";
	$connection_command .= "-o BatchMode yes ";
	$connection_command .= "-o SendEnv 'SCIRE_*' ";
	$connection_command .= "-o ServerAliveInterval 15 -o ServerAliveCountMax 4 ";
	if(defined($conf{port})) {
		$connection_command .= "-o Port=$conf{port} ";
	}
	$connection_command .= "$conf{user}\@$conf{host} $conf{server_script}";

	if (-d ".svn") {
		# Overwrite $connection_command in the case of a dev environment for now
		$connection_command = "../server/scireserver.pl";
	}

	return $connection_command;
}

sub check_job_dir {
	if (! -d $conf{job_dir}) {
		print "WARNING! $conf{job_dir} does not exist...creating\n";
		mkpath( $conf{job_dir}, {verbose => 1, mode => 0660})
			or die("Couldn't make $conf{job_dir} w/ perms 0660: $!");
	}
	if (! -d "$conf{job_dir}/queue") {
		print "WARNING! $conf{job_dir}/queue does not exist...creating\n";
		mkpath( "$conf{job_dir}/queue", {verbose => 1, mode => 0660})
			or die("Couldn't make $conf{job_dir}/queue w/ perms 0660: $!");
	}
	if (! -d "$conf{job_dir}/done") {
		print "WARNING! $conf{job_dir}/done does not exist...creating\n";
		mkpath( "$conf{job_dir}/done", {verbose => 1, mode => 0660})
			or die("Couldn't make $conf{job_dir}/done w/ perms 0660: $!");
	}
	if (! -d "$conf{job_dir}/failed") {
		print "WARNING! $conf{job_dir}/failed does not exist...creating\n";
		mkpath( "$conf{job_dir}/failed", {verbose => 1, mode => 0660})
			or die("Couldn't make $conf{job_dir}/failed w/ perms 0660: $!");
	}
}

sub read_config_file {
	my $conf_file = shift;
	my %config_defaults = (
		"key_file" => "${ETC_DIR}/client_key",
		"debug" => 0,
	);
	open(FH, "< ${conf_file}") or die("Couldn't open the config file ${conf_file}: $!");
	while (<FH>) {
		chomp;
		next if /^\s*(?:#|$)/;
		if(/^\s*(.+?)\s*=\s*(.+?)\s*(?:#.*)?$/) {
			unless(defined($conf{lc($1)})) {  #Don't overwrite anything specified in cmdline
				$conf{lc($1)} = $2;
			}
		}
	}
	close(FH) or die("Couldn't close the config file ${conf_file}: $!");
	for(keys %config_defaults) {
		if(!defined $conf{$_}) {
			$conf{$_} = $config_defaults{$_};
		}
	}
}

sub register_client {
#	my $mac = "00:11:22:33:44:55";
#	my $ip = "192.168.2.3";
	my ($mac, $ip) = get_interface_info(defined $conf{interface} && $conf{interface} ? $conf{interface} : "eth0");
	my $hostname = hostname();
	my ($status, $message) = parse_response(send_command("REGISTER", $mac, $ip, $hostname));
	die "Could not register client $mac w/ ip $ip and hostname $hostname. Got: $message" if (! defined $status or $status ne "OK");
	debug("Client registered. Status is pending. digest is $message");
	open(FILE, ">$conf{key_file}") or die("Couldn't open key file $conf{key_file} for writing: $!");
	print FILE "$message\n";
	close(FILE);
}

sub identify_client {
	open(FILE, $conf{key_file}) or die("Couldn't open client_key $conf{key_file}: $!");
	my $digest = <FILE>;
	chomp $digest;
	close(FILE);
	my ($status, $message) = parse_response(send_command("IDENTIFY", $digest));
	unless (defined $status && $status eq "OK") {
		print "ERROR Could not identify to server: $message\n";
		return 0;
	}
	debug("Client identified");
	return 1;
}

sub get_jobs {
	my ($status, $jobs) = parse_response(send_command("GET_JOBS"));
	unless (defined $status && $status eq "OK") {
		print "Could not get jobs list from server: $status\n";
		return 0;
	}
	if (defined($jobs) && $jobs) {
		$jobs =~ s/\s//g;  #Remove all whitespace
		my @jobs_list = split(/,/, $jobs);
		foreach my $job (@jobs_list) {
			my ($status, $filename) = parse_response(send_command("GET_JOB", $job));
			#SCP the file to $conf{job_dir}/queue/

			system("cp $filename $conf{job_dir}/queue/") and die("Can't copy file: $!");  #Temporary hack.  only works locally.
			# XXX: Modify this to fetch a file instead
			debug("Fetched job $job ");
			my ($status2,$message) = parse_response(send_command("JOB_FETCHED", $job));
			unless (defined $status2 && $status2 eq "OK") {
				die("ERROR Could not signal job was fetched: $message\n");
			}

		}
		#This function doesn't actually need to do anything with the list of jobs, the executor handles that part.	
	}
}

sub scan_jobs_dir {
	#Scan the dirs for job files.
	my @existing_jobs = glob("$conf{job_dir}/queue/*");
	my @failed_jobs = glob("$conf{job_dir}/failed/*");
	my @done_jobs = glob("$conf{job_dir}/done/*");
	
	#Report on those jobs needing reporting.
	foreach my $job_file (@failed_jobs) {
		$job_file =~ /(\d+)\.job/;
		my $jobid = $1;
		my ($status, $message) = parse_response(send_command("SET_JOB_STATUS $jobid 'Failed'"));
		open(FILE, $job_file) or die "Couldn't open job file $job_file: $!";
		my $job_data = join("", <FILE>);
		close(FILE);
		
	}
	#may be able to use same code as above.
	foreach my $job_file (@done_jobs) {
		$job_file =~ /(\d+)\.job/;
		my $jobid = $1;
		my ($status, $message) = parse_response(send_command("SET_JOB_STATUS $jobid 'Done'"));
	}
	
	return @existing_jobs;
}

sub debug {
	my $msg = shift;
	if($conf{debug}) {
		print STDERR $msg."\n";
	}
}

sub get_interface_info {
	my $interface = shift;

	my $info = `/sbin/ifconfig ${interface}`;
	$info =~ /^.+HWaddr ([a-zA-Z0-9:]+).+inet addr:([0-9.]+).+$/s;
	my ($mac, $ip) = ($1, $2);
	return ($mac, $ip);
}