/[scire]/branches/new-fu/server/scireserver.pl
Gentoo

Contents of /branches/new-fu/server/scireserver.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 311 - (show annotations) (download) (as text)
Wed Jan 2 02:03:43 2008 UTC (6 years, 6 months ago) by codeman
File MIME type: text/x-perl
File size: 7958 byte(s)
fixed get_jobs.
coded get_job. but there seems to be a problem with it.
commented out most of it for now, still doesn't work.

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 }

Properties

Name Value
svn:executable *
svn:keywords Id

  ViewVC Help
Powered by ViewVC 1.1.20