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

Properties

Name Value
svn:executable *
svn:keywords Id

  ViewVC Help
Powered by ViewVC 1.1.20