path: root/server/scireserver.pl

#!/usr/bin/perl

# $Id$

use strict;
use warnings;
use DBI;
use Data::Dumper;
use Digest::MD5 qw(md5 md5_hex );
use File::Path;
use XML::Dumper;

$| = 1;

my $ETC_DIR = "/etc/scire";
my $SCIRE_CONFIG_FILE = "${ETC_DIR}/scireserver.conf";
my %conf;
my $LOGFILE;
	
my $conf_file = (defined($conf{config})) ? $conf{config} : $SCIRE_CONFIG_FILE;
read_config_file($conf_file);
Dumper(\%conf);

my $identified = 0;  #Global variable to determine if already identified or not.
my $client_id = 0;  #Clobal variable for the client id.
#  Somehow this feels insecure.

sub logger {
	my $line = shift;
	if(!defined $LOGFILE) {
		open(*LOGFILE, ">>$conf{logfile}") or die "Cannot open logfile $conf{logfile}";
	}
	print LOGFILE localtime() . " " . $line . "\n";
}

sub debug {
	my $line = shift;
	if ($conf{debug}) {
		if (defined($conf{logfile})) {
			logger("DEBUG: ${line}");
		} else {
			print STDERR "DEBUG: ${line}\n";
		}
	}
}

#Connect to the Database.
my $connect_string = "DBI:$conf{db_type}:$conf{db_name};host=$conf{db_host}";
debug("Connecting to $connect_string");
my $dbh = DBI->connect($connect_string, $conf{db_user}, $conf{db_passwd},  { RaiseError => 1 }  )
	or die "Could not connect to database: $DBI::errstr";

while(<>) {
	my ($command, @args) = parse_command($_);
#	chomp( my $line = $_);
#	debug("DEBUG: line is: $line");

	if($command eq "QUIT") {
		print "OK\n";
		exit;
	}
		
	if($command eq "REGISTER") {
		my ($mac,$ip,$hostname) = @args;
		register_client($mac, $ip, $hostname);
		next; #End switch here.  You can go no further.
	}

	if($command eq "IDENTIFY") {
		my $fingerprint = $args[0];
		identify_client($fingerprint);
		next; #End switch here.  You can go no further.
	}
	unless($identified == 1) {
		print "ERROR This client has not yet been authorized.  Please identify!\n";
		next;
	}

	if ($command eq "GET_JOBS") {
		my @jobs = get_jobs();
		print "OK " . join(",", @jobs) . "\n";
	} elsif ($command eq "GET_JOB") {
		my $job = $args[0];
		my $jobfile = get_job($job);
		print "OK ${jobfile}\n";
	} elsif ($command eq "JOB_FETCHED") {
		my $job = $args[0];
		job_fetched($job) and print "OK\n";
	} elsif ($command eq "SET_JOB_STATUS") {
		my ($jobid,$status) = @args;
		set_job_status($jobid,$status) and print "OK\n";
	
	} else {
		print "ERROR The command $command is unknown.  Please try again.\n";
	}
}



sub read_config_file {
	my $conf_file = shift;
	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}: $!");
	debug("Conf file $conf_file read.");
}

#New clients must be registered so they can be given a key to use (perhaps for job file transfers?) for authentication.  This must be allowed before identifying.
sub register_client {
	my ($mac,$ip, $hostname) = @_;
	#Validate your inputs!
	$mac =~ /^[a-zA-Z0-9\:]+$/ or print "ERROR invalid mac $mac!\n";
	$ip =~ /^[a-zA-Z0-9\.\:]+$/ or print "ERROR invalid ip $ip!\n";

	my ($query, $status_id, $id, $sth);

	#Generate the digest
	my $digest = md5_hex(time()."${mac}${ip}${hostname}");
	
	eval {
		$query = 'SELECT statusid FROM client_status WHERE statusname = "Pending"';
		debug("Query is $query");
#        $status_id = "4"; #db.conn.GetRow($query)
		$sth = $dbh->prepare($query);
		$sth->execute();
		$status_id = $sth->fetchrow_hashref->{'statusid'};
    };
	($@) and print "ERROR Could not get status id: $DBI::errstr\n";

	eval {
		$query = 'LOCK TABLES `gacl_axo_seq` WRITE';
		debug("Query is $query");
		#execute it
		$dbh->do($query);
		$query = 'SELECT id FROM `gacl_axo_seq`';
		debug("Query is $query");
		#$id = "56"; #execute $query
		$sth = $dbh->prepare($query);
		$sth->execute();
		$id = $sth->fetchrow_hashref->{'id'};
		$id += 1;
		$query = 'UPDATE `gacl_axo_seq` SET id=?';
		debug("Query is $query");
		#execute with $id
		$sth = $dbh->prepare($query);
		$sth->execute($id);
		$query = 'UNLOCK TABLES';
		debug("Query is $query");
		$dbh->do($query);
	};
	($@) and print "ERROR during fetching of id sequence: $DBI::errstr\n";

	eval {
		$query = 'INSERT INTO `gacl_axo` (id,section_value,value,order_value,name,hidden) VALUES (?,"clients",?,"1",?,"0")'; 
		debug("Query is $query");
		$sth = $dbh->prepare($query);
		$sth->execute($id, $hostname, $hostname);
		#execute with $id, $hostname, $hostname
		#NOTE: not sure if this query is still valid.  may be using id instead of hostname for one of those two now.
		
		$query = 'INSERT INTO clients (clientid,digest,hostname,mac,ip,status) VALUES (?,?,?,?,?,?)';
		debug("Query is $query");
		#execute with $id, client_cert.digest("sha1"),crypto.dump_certificate(crypto.FILETYPE_PEM,client_cert),$hostname,$mac,$ip,$status_id))
		$sth = $dbh->prepare($query);
		$sth->execute($id,$digest,$hostname,$mac,$ip,$status_id);
    };
	($@) and print "ERROR Could not insert client with $query: $DBI::errstr\n";
	#FIXME look for "duplicate key" and if found fail and notify admin.

	print "OK $digest\n";
}

#Identify the client by looking up the fingerprint in the database, and matching it up.
sub identify_client {
	my $digest = shift;
	#Validate your inputs!
	$digest =~ s/"//g;  #Clear the quotes.
	$digest =~ /^[A-Za-z0-9]+$/ or print "ERROR invalid digest!\n";

	my $query = 'SELECT client_status.statusname, clients.clientid FROM clients JOIN client_status on (clients.status = client_status.statusid) WHERE clients.digest=?';
	debug("Query is $query");
	my $sth = $dbh->prepare($query);
	$sth->execute($digest);
	my $hashref = $sth->fetchrow_hashref();
	debug(Dumper($hashref));
	my $status_name = $hashref->{'statusname'};
	$client_id = $hashref->{'clientid'};
	if ($client_id > 0) {  #and ($status_name eq 'Active') {
		$identified = 1;
		print "OK\n";
	} else {
		print "ERROR Client could not be identified.  Status was $status_name\n";
	}

}

sub get_jobs {

	#FIXME expand jobs for $client_id

	my $query = <<'EndOfQuery';
	SELECT jobs.jobid
	FROM jobs NATURAL JOIN jobs_clients NATURAL JOIN job_conditions
	WHERE jobs_clients.clientid = ? 
	AND jobs.jobid = jobs_clients.jobid 
	AND (job_conditions.deploy_time < now())
	AND ((job_conditions.expiration_time > now()) OR (job_conditions.expiration_time IS NULL))
	ORDER BY jobs.priority,jobs.created
EndOfQuery

	#FIXME ADD JOB DEPENDENCIES TO THIS QUERY.
	debug("Query is $query");
	my $sth = $dbh->prepare($query);
	$sth->execute($client_id);
	my $jobs_ref = $sth->fetchall_arrayref();
	# Don't ask me...ask the guys in #perl :P
	my @jobs = map { @$_ } @$jobs_ref;
	return @jobs;
}

sub get_job {
	my $jobid = shift;
	#Validate your inputs!
	my $query = 'SELECT * FROM jobs LEFT JOIN job_conditions on (jobs.jobid) WHERE jobs.jobid = ?';
	debug("Query is $query");
	my $sth = $dbh->prepare($query);
	$sth->execute($jobid);
	my $job = $sth->fetchrow_hashref();
	my $scriptid = $job->{'script'};

	$query = 'SELECT * FROM scripts WHERE scriptid=?';
	debug("Query is $query");
	$sth = $dbh->prepare($query);
	$sth->execute($scriptid);
	$job->{'script'} = $sth->fetchrow_hashref();
	
	debug(Dumper($job));
	#Write the job w/ all data to a jobfile with the following path /JOBDIR/CLIENT_ID/queue/JOBID.job
	my $path = "$conf{job_dir}/$client_id/queue";
	my $filename = "$path/$jobid.job";
	unless (-d $path) {
		print "WARNING! $path does not exist...creating\n";
		mkpath( $path, {verbose => 1, mode => 0660})
			or die("Couldn't make $path w/ perms 0660: $!");
	}
	open(FH, ">$filename") or die("Couldn't open $filename: $!");
	my $xml = pl2xml( $job );
	print FH $xml."\n";
	close(FH) or die("Couldn't close $filename : $!");
	debug("OK $filename");
	return $filename;
}

sub job_fetched {
	my $jobid = shift;
	set_job_status($jobid,'Downloaded') or print "ERROR could not set job status to downloaded.\n";

	eval {
		my $query = 'DELETE FROM jobs_clients WHERE jobid=? AND clientid=?';
		debug("Query is $query");
		my $sth = $dbh->prepare($query);
		$sth->execute($jobid,$client_id);
	};
	($@) and print "ERROR Could not get status id: $DBI::errstr\n";

	my $filename = "$conf{job_dir}/$client_id/queue/$jobid.job";
	unlink ($filename) or die("ERROR Could not unlink the jobfile from the queue. filename: $filename : $!");
	return 1;
}

sub set_job_status {
	my ($jobid,$status) = @_;
	#Validate your inputs!
	$jobid =~ /^\d+$/ or die("Invalid jobid $jobid");
	#fixme validate status
	my $status_id;
	eval {
		my $query = 'SELECT statusid FROM jobs_status WHERE statusname = ?';
		debug("Query is $query");
#        $status_id = "4"; #db.conn.GetRow($query)
		my $sth = $dbh->prepare($query);
		$sth->execute($status);
		$status_id = $sth->fetchrow_hashref->{'statusid'};
    };
	($@) and print "ERROR Could not get status id: $DBI::errstr\n";
	$status_id or print "ERROR Invalid status id $status_id\n";
	
	eval {
		my $query = 'INSERT INTO job_history (jobid,clientid,statusid) VALUES (?,?,?)';
		debug("Query is $query");
		my $sth = $dbh->prepare($query);
		$sth->execute($jobid,$client_id,$status_id);
	};
	($@) and print "ERROR Could not insert into job_history: $DBI::errstr\n";
	return 1;
}

sub parse_command {
	my $line = shift;
	chomp $line;
	my @parts = split / (?!(?:[^" ]|[^"] [^"])+")/, $line;
	for(0..$#parts) {
		$parts[$_] =~ s/(^"|"$)//g;
		$parts[$_] =~ s/\\"/"/g;
	}
	return @parts;
}