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

Properties

Name Value
svn:executable *
svn:keywords Id

  ViewVC Help
Powered by ViewVC 1.1.20