new-fu/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];
                get_job($job);
        
        } elsif ($command eq "SET_JOB_STATUS") {
                my ($jobid,$status) = @args;
                set_job_status($jobid,$status);
        
        } 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\n");
        return "OK $filename\n";
}

sub set_job_status {
        my ($jobid,$status) = @_;
        #Validate your inputs!
}

sub parse_command {
        my $line = shift;
        chomp $line;
        my @parts = split / (?!(?:[^" ]|[^"] [^"])+")/, $line;
        for(0..$#parts) {
                $parts[$_] =~ s/(^"|"$)//g;
                $parts[$_] =~ s/\\"/"/g;
        }
        return @parts;
}
1	#!/usr/bin/perl
2
3	# $Id$
4
5	use strict;
6	use warnings;
7	use DBI;
8	use Data::Dumper;
9	use Digest::MD5 qw(md5 md5_hex );
10	use File::Path;
11	use XML::Dumper;
12
13	$\| = 1;
14
15	my $ETC_DIR = "/etc/scire";
16	my $SCIRE_CONFIG_FILE = "${ETC_DIR}/scireserver.conf";
17	my %conf;
18	my $LOGFILE;
19
20	my $conf_file = (defined($conf{config})) ? $conf{config} : $SCIRE_CONFIG_FILE;
21	read_config_file($conf_file);
22	Dumper(\%conf);
23
24	my $identified = 0; #Global variable to determine if already identified or not.
25	my $client_id = 0; #Clobal variable for the client id.
26	# Somehow this feels insecure.
27
28	sub logger {
29	my $line = shift;
30	if(!defined $LOGFILE) {
31	open(*LOGFILE, ">>$conf{logfile}") or die "Cannot open logfile $conf{logfile}";
32	}
33	print LOGFILE localtime() . " " . $line . "\n";
34	}
35
36	sub debug {
37	my $line = shift;
38	if ($conf{debug}) {
39	if (defined($conf{logfile})) {
40	logger("DEBUG: ${line}");
41	} else {
42	print STDERR "DEBUG: ${line}\n";
43	}
44	}
45	}
46
47	#Connect to the Database.
48	my $connect_string = "DBI:$conf{db_type}:$conf{db_name};host=$conf{db_host}";
49	debug("Connecting to $connect_string");
50	my $dbh = DBI->connect($connect_string, $conf{db_user}, $conf{db_passwd}, { RaiseError => 1 } )
51	or die "Could not connect to database: $DBI::errstr";
52
53	while(<>) {
54	my ($command, @args) = parse_command($_);
55	# chomp( my $line = $_);
56	# debug("DEBUG: line is: $line");
57
58	if($command eq "QUIT") {
59	print "OK\n";
60	exit;
61	}
62
63	if($command eq "REGISTER") {
64	my ($mac,$ip,$hostname) = @args;
65	register_client($mac, $ip, $hostname);
66	next; #End switch here. You can go no further.
67	}
68
69	if($command eq "IDENTIFY") {
70	my $fingerprint = $args[0];
71	identify_client($fingerprint);
72	next; #End switch here. You can go no further.
73	}
74	unless($identified == 1) {
75	print "ERROR This client has not yet been authorized. Please identify!\n";
76	next;
77	}
78
79	if ($command eq "GET_JOBS") {
80	my @jobs = get_jobs();
81	print "OK " . join(",", @jobs) . "\n";
82	} elsif ($command eq "GET_JOB") {
83	my $job = $args[0];
84	get_job($job);
85
86	} elsif ($command eq "SET_JOB_STATUS") {
87	my ($jobid,$status) = @args;
88	set_job_status($jobid,$status);
89
90	} else {
91	print "ERROR The command $command is unknown. Please try again.\n";
92	}
93	}
94
95
96
97	sub read_config_file {
98	my $conf_file = shift;
99	open(FH, "< ${conf_file}") or die("Couldn't open the config file ${conf_file}: $!");
100	while (<FH>) {
101	chomp;
102	next if /^\s*(?:#\|$)/;
103	if(/^\s(.+?)\s=\s(.+?)\s(?:#.*)?$/) {
104	unless(defined($conf{lc($1)})) { #Don't overwrite anything specified in cmdline
105	$conf{lc($1)} = $2;
106	}
107	}
108	}
109	close(FH) or die("Couldn't close the config file ${conf_file}: $!");
110	debug("Conf file $conf_file read.");
111	}
112
113	#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.
114	sub register_client {
115	my ($mac,$ip, $hostname) = @_;
116	#Validate your inputs!
117	$mac =~ /^[a-zA-Z0-9\:]+$/ or print "ERROR invalid mac $mac!\n";
118	$ip =~ /^[a-zA-Z0-9\.\:]+$/ or print "ERROR invalid ip $ip!\n";
119
120	my ($query, $status_id, $id, $sth);
121
122	#Generate the digest
123	my $digest = md5_hex(time()."${mac}${ip}${hostname}");
124
125	eval {
126	$query = 'SELECT statusid FROM client_status WHERE statusname = "Pending"';
127	debug("Query is $query");
128	# $status_id = "4"; #db.conn.GetRow($query)
129	$sth = $dbh->prepare($query);
130	$sth->execute();
131	$status_id = $sth->fetchrow_hashref->{'statusid'};
132	};
133	($@) and print "ERROR Could not get status id: $DBI::errstr\n";
134
135	eval {
136	$query = 'LOCK TABLES `gacl_axo_seq` WRITE';
137	debug("Query is $query");
138	#execute it
139	$dbh->do($query);
140	$query = 'SELECT id FROM `gacl_axo_seq`';
141	debug("Query is $query");
142	#$id = "56"; #execute $query
143	$sth = $dbh->prepare($query);
144	$sth->execute();
145	$id = $sth->fetchrow_hashref->{'id'};
146	$id += 1;
147	$query = 'UPDATE `gacl_axo_seq` SET id=?';
148	debug("Query is $query");
149	#execute with $id
150	$sth = $dbh->prepare($query);
151	$sth->execute($id);
152	$query = 'UNLOCK TABLES';
153	debug("Query is $query");
154	$dbh->do($query);
155	};
156	($@) and print "ERROR during fetching of id sequence: $DBI::errstr\n";
157
158	eval {
159	$query = 'INSERT INTO `gacl_axo` (id,section_value,value,order_value,name,hidden) VALUES (?,"clients",?,"1",?,"0")';
160	debug("Query is $query");
161	$sth = $dbh->prepare($query);
162	$sth->execute($id, $hostname, $hostname);
163	#execute with $id, $hostname, $hostname
164	#NOTE: not sure if this query is still valid. may be using id instead of hostname for one of those two now.
165
166	$query = 'INSERT INTO clients (clientid,digest,hostname,mac,ip,status) VALUES (?,?,?,?,?,?)';
167	debug("Query is $query");
168	#execute with $id, client_cert.digest("sha1"),crypto.dump_certificate(crypto.FILETYPE_PEM,client_cert),$hostname,$mac,$ip,$status_id))
169	$sth = $dbh->prepare($query);
170	$sth->execute($id,$digest,$hostname,$mac,$ip,$status_id);
171	};
172	($@) and print "ERROR Could not insert client with $query: $DBI::errstr\n";
173	#FIXME look for "duplicate key" and if found fail and notify admin.
174
175	print "OK $digest\n";
176	}
177
178	#Identify the client by looking up the fingerprint in the database, and matching it up.
179	sub identify_client {
180	my $digest = shift;
181	#Validate your inputs!
182	$digest =~ s/"//g; #Clear the quotes.
183	$digest =~ /^[A-Za-z0-9]+$/ or print "ERROR invalid digest!\n";
184
185	my $query = 'SELECT client_status.statusname, clients.clientid FROM clients JOIN client_status on (clients.status = client_status.statusid) WHERE clients.digest=?';
186	debug("Query is $query");
187	my $sth = $dbh->prepare($query);
188	$sth->execute($digest);
189	my $hashref = $sth->fetchrow_hashref();
190	debug(Dumper($hashref));
191	my $status_name = $hashref->{'statusname'};
192	$client_id = $hashref->{'clientid'};
193	if ($client_id > 0) { #and ($status_name eq 'Active') {
194	$identified = 1;
195	print "OK\n";
196	} else {
197	print "ERROR Client could not be identified. Status was $status_name\n";
198	}
199
200	}
201
202	sub get_jobs {
203
204	#FIXME expand jobs for $client_id
205
206	my $query = <<'EndOfQuery';
207	SELECT jobs.jobid
208	FROM jobs NATURAL JOIN jobs_clients NATURAL JOIN job_conditions
209	WHERE jobs_clients.clientid = ?
210	AND jobs.jobid = jobs_clients.jobid
211	AND (job_conditions.deploy_time < now())
212	AND ((job_conditions.expiration_time > now()) OR (job_conditions.expiration_time IS NULL))
213	ORDER BY jobs.priority,jobs.created
214	EndOfQuery
215
216	#FIXME ADD JOB DEPENDENCIES TO THIS QUERY.
217	debug("Query is $query");
218	my $sth = $dbh->prepare($query);
219	$sth->execute($client_id);
220	my $jobs_ref = $sth->fetchall_arrayref();
221	# Don't ask me...ask the guys in #perl :P
222	my @jobs = map { @$_ } @$jobs_ref;
223	return @jobs;
224	}
225
226	sub get_job {
227	my $jobid = shift;
228	#Validate your inputs!
229	my $query = 'SELECT * FROM jobs LEFT JOIN job_conditions on (jobs.jobid) WHERE jobs.jobid = ?';
230	debug("Query is $query");
231	# my $sth = $dbh->prepare($query);
232	# $sth->execute($jobid);
233	# my $job = $sth->fetchrow_hashref();
234	# my $scriptid = $job->{'script'};
235
236	$query = 'SELECT * FROM scripts WHERE scriptid=?';
237	debug("Query is $query");
238	# $sth = $dbh->prepare($query);
239	# $sth->execute($scriptid);
240	# $job->{'script'} = $sth->fetchrow_hashref();
241
242	# debug(Dumper($job));
243	#Write the job w/ all data to a jobfile with the following path /JOBDIR/CLIENT_ID/queue/JOBID.job
244	my $path = "$conf{job_dir}/$client_id/queue";
245	my $filename = "$path/$jobid.job";
246	# unless (-d $path) {
247	# print "WARNING! $path does not exist...creating\n";
248	# mkpath( $path, {verbose => 1, mode => 0660})
249	# or die("Couldn't make $path w/ perms 0660: $!");
250	# }
251	# open(FH, ">$filename") or die("Couldn't open $filename: $!");
252	# my $xml = pl2xml( $job );
253	# print FH $xml."\n";
254	# close(FH) or die("Couldn't close $filename : $!");
255	debug("OK $filename\n");
256	return "OK $filename\n";
257	}
258
259	sub set_job_status {
260	my ($jobid,$status) = @_;
261	#Validate your inputs!
262	}
263
264	sub parse_command {
265	my $line = shift;
266	chomp $line;
267	my @parts = split / (?!(?:[^" ]\|[^"] [^"])+")/, $line;
268	for(0..$#parts) {
269	$parts[$_] =~ s/(^"\|"$)//g;
270	$parts[$_] =~ s/\\"/"/g;
271	}
272	return @parts;
273	}