/[scire]/branches/new-fu/client/scireclient.pl
Gentoo

Contents of /branches/new-fu/client/scireclient.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 313 - (show annotations) (download) (as text)
Wed Jan 2 04:16:33 2008 UTC (6 years, 8 months ago) by codeman
File MIME type: text/x-perl
File size: 8403 byte(s)
fixin up get_jobs a bit.

1 #!/usr/bin/perl
2
3 # $Id$
4
5 use strict;
6 use warnings;
7
8 use IPC::Open2;
9 use Getopt::Long;
10 use Data::Dumper;
11 use File::Path;
12 use Sys::Hostname;
13
14 my $ETC_DIR = "/etc/scire";
15 my $SCIRE_CONFIG_FILE = "${ETC_DIR}/scire.conf";
16 my %conf;
17 my ($SERVER_STDOUT, $SERVER_STDIN);
18 my $connection_pid;
19
20 run_main();
21
22 sub run_main {
23 parse_command_line();
24 my $conf_file = (defined($conf{config})) ? $conf{config} : $SCIRE_CONFIG_FILE;
25 read_config_file($conf_file);
26
27 check_job_dir();
28
29 my $connection_command = build_connection_command();
30
31 #ok folks so here's how this thang goes down.
32 #1. Connect.
33 create_connection($connection_command);
34
35 #2. Register with the DB. (only it knows if you're allowed to be active)
36 # If we do not have a defined key file, we assume this is the first run of this client
37 # so we register them instead of trying to identify.
38 if(defined($conf{key_file}) and (-f $conf{key_file})) {
39 if(!identify_client()) {
40 exit(1);
41 }
42 } else {
43 register_client();
44 exit(0);
45 }
46
47 #3. Scan the jobs directory. If there are done/failed jobs, report them. Note jobs in running or queue.
48 my @existing_jobs = scan_jobs_dir();
49 #4. Fetch the jobs list
50 get_jobs();
51 #5. ???
52 #6. Profit!
53 }
54
55 sub parse_command_line {
56 GetOptions(
57 'debug|d' => \$conf{debug},
58 'dry-run' => \$conf{dry_run},
59 'help|h' => \$conf{help},
60 'config|c=s' => \$conf{config},
61 'threads|t=i' => \$conf{max_threads},
62
63 #config overrides.
64 'host=s' => \$conf{host},
65 'port=i' => \$conf{port},
66 'user|u=s' => \$conf{user},
67 'server_script=s' => \$conf{server_script},
68 'job_dir' => \$conf{job_dir},
69 );
70 if ($conf{help}) {
71 print "\nusage: scireclient.pl [--debug or -d]\n\t [--dry-run]"
72 ."\t [--config=CONF or -c] \n\t [--threads=# or -t] \t [--help or -h] \n"
73 ."\t [[--host=HOST] \t [--port=PORT] \t [--user=USER or -u] \n\t"
74 ." [--server_script=foo.pl] \t [--job_dir=/tmp/jobs] \n";
75 exit 0;
76 }
77
78 }
79
80 sub send_command {
81 my $cmd = shift;
82 my @args = @_;
83 my $tosend = "${cmd}";
84
85 for my $arg (@args) {
86 if($arg =~ /^[0-9]+$/) {
87 $tosend .= " ${arg}";
88 } else {
89 $arg =~ s/"/\\"/g;
90 $tosend .= " \"${arg}\"";
91 }
92 }
93 debug("Sending: ${tosend}");
94 print SERVER_STDIN "${tosend}\n";
95 #FIXME WE NEED A TIMEOUT HERE OF SOME SORT!!
96 #if the server doesn't give you a newline this just hangs!
97 my $response = <SERVER_STDOUT>;
98 debug("Got response: ${response}");
99 return $response;
100 }
101
102 sub parse_response {
103 my $response = shift;
104 $response =~ /^(OK|ERROR)(?: (.+))?$/;
105 my ($status, $message) = ($1, $2);
106 return ($status, $message);
107 }
108
109 sub create_connection {
110 # XXX: How do we capture this error? $pid has a valid value even if the
111 # process fails to run, since it just returns the PID of the forked perl
112 # process. I tried adding 'or die' after it, but it didn't help since it
113 # doesn't fail in the main process. When it fails, it outputs an error
114 # to STDERR:
115 # open2: exec of ../server/scireserver.pl failed at ./scireclient.pl line 116
116 my $connection_command = shift;
117 $connection_pid = open2(*SERVER_STDOUT, *SERVER_STDIN, $connection_command);
118 }
119
120 sub build_connection_command {
121 # This will eventually be something like "ssh scire@${scireserver} /usr/bin/scireserver.pl"
122 my $connection_command = "ssh ";
123 $connection_command .= "-o BatchMode yes ";
124 $connection_command .= "-o SendEnv 'SCIRE_*' ";
125 $connection_command .= "-o ServerAliveInterval 15 -o ServerAliveCountMax 4 ";
126 if(defined($conf{port})) {
127 $connection_command .= "-o Port=$conf{port} ";
128 }
129 $connection_command .= "$conf{user}\@$conf{host} $conf{server_script}";
130
131 if (-d ".svn") {
132 # Overwrite $connection_command in the case of a dev environment for now
133 $connection_command = "../server/scireserver.pl";
134 }
135
136 return $connection_command;
137 }
138
139 sub check_job_dir {
140 if (! -d $conf{job_dir}) {
141 print "WARNING! $conf{job_dir} does not exist...creating\n";
142 mkpath( $conf{job_dir}, {verbose => 1, mode => 0660})
143 or die("Couldn't make $conf{job_dir} w/ perms 0660: $!");
144 }
145 if (! -d "$conf{job_dir}/queue") {
146 print "WARNING! $conf{job_dir}/queue does not exist...creating\n";
147 mkpath( "$conf{job_dir}/queue", {verbose => 1, mode => 0660})
148 or die("Couldn't make $conf{job_dir}/queue w/ perms 0660: $!");
149 }
150 if (! -d "$conf{job_dir}/done") {
151 print "WARNING! $conf{job_dir}/done does not exist...creating\n";
152 mkpath( "$conf{job_dir}/done", {verbose => 1, mode => 0660})
153 or die("Couldn't make $conf{job_dir}/done w/ perms 0660: $!");
154 }
155 if (! -d "$conf{job_dir}/failed") {
156 print "WARNING! $conf{job_dir}/failed does not exist...creating\n";
157 mkpath( "$conf{job_dir}/failed", {verbose => 1, mode => 0660})
158 or die("Couldn't make $conf{job_dir}/failed w/ perms 0660: $!");
159 }
160 }
161
162 sub read_config_file {
163 my $conf_file = shift;
164 my %config_defaults = (
165 "key_file" => "${ETC_DIR}/client_key",
166 "debug" => 0,
167 );
168 open(FH, "< ${conf_file}") or die("Couldn't open the config file ${conf_file}: $!");
169 while (<FH>) {
170 chomp;
171 next if /^\s*(?:#|$)/;
172 if(/^\s*(.+?)\s*=\s*(.+?)\s*(?:#.*)?$/) {
173 unless(defined($conf{lc($1)})) { #Don't overwrite anything specified in cmdline
174 $conf{lc($1)} = $2;
175 }
176 }
177 }
178 close(FH) or die("Couldn't close the config file ${conf_file}: $!");
179 for(keys %config_defaults) {
180 if(!defined $conf{$_}) {
181 $conf{$_} = $config_defaults{$_};
182 }
183 }
184 }
185
186 sub register_client {
187 # my $mac = "00:11:22:33:44:55";
188 # my $ip = "192.168.2.3";
189 my ($mac, $ip) = get_interface_info(defined $conf{interface} && $conf{interface} ? $conf{interface} : "eth0");
190 my $hostname = hostname();
191 my ($status, $message) = parse_response(send_command("REGISTER", $mac, $ip, $hostname));
192 die "Could not register client $mac w/ ip $ip and hostname $hostname. Got: $message" if (! defined $status or $status ne "OK");
193 debug("Client registered. Status is pending. digest is $message");
194 open(FILE, ">$conf{key_file}") or die("Couldn't open key file $conf{key_file} for writing: $!");
195 print FILE "$message\n";
196 close(FILE);
197 }
198
199 sub identify_client {
200 open(FILE, $conf{key_file}) or die("Couldn't open client_key $conf{key_file}: $!");
201 my $digest = <FILE>;
202 chomp $digest;
203 close(FILE);
204 my ($status, $message) = parse_response(send_command("IDENTIFY", $digest));
205 unless (defined $status && $status eq "OK") {
206 print "ERROR Could not identify to server: $message\n";
207 return 0;
208 }
209 debug("Client identified");
210 return 1;
211 }
212
213 sub get_jobs {
214 my ($status, $jobs) = parse_response(send_command("GET_JOBS"));
215 unless (defined $status && $status eq "OK") {
216 print "Could not get jobs list from server: $status\n";
217 return 0;
218 }
219 if (defined($jobs) && $jobs) {
220 $jobs =~ s/\s//g; #Remove all whitespace
221 my @jobs_list = split(/,/, $jobs);
222 foreach my $job (@jobs_list) {
223 my ($status, $filename) = parse_response(send_command("GET_JOB", $job));
224 #SCP the file to $conf{job_dir}/queue/
225
226 system("cp $filename $conf{job_dir}/queue/") and die("Can't copy file: $!"); #Temporary hack. only works locally.
227 # XXX: Modify this to fetch a file instead
228 debug("Fetched job $job ");
229 my ($status2,$message) = parse_response(send_command("JOB_FETCHED", $job));
230 unless (defined $status2 && $status2 eq "OK") {
231 die("ERROR Could not signal job was fetched: $message\n");
232 }
233
234 }
235 #This function doesn't actually need to do anything with the list of jobs, the executor handles that part.
236 }
237 }
238
239 sub scan_jobs_dir {
240 #Scan the dirs for job files.
241 my @existing_jobs = glob("$conf{job_dir}/queue/*");
242 my @failed_jobs = glob("$conf{job_dir}/failed/*");
243 my @done_jobs = glob("$conf{job_dir}/done/*");
244
245 #Report on those jobs needing reporting.
246 foreach my $job_file (@failed_jobs) {
247 $job_file =~ /(\d+)\.job/;
248 my $jobid = $1;
249 my ($status, $message) = parse_response(send_command("SET_JOB_STATUS $jobid 'Failed'"));
250 open(FILE, $job_file) or die "Couldn't open job file $job_file: $!";
251 my $job_data = join("", <FILE>);
252 close(FILE);
253
254 }
255 #may be able to use same code as above.
256 foreach my $job_file (@done_jobs) {
257 $job_file =~ /(\d+)\.job/;
258 my $jobid = $1;
259 my ($status, $message) = parse_response(send_command("SET_JOB_STATUS $jobid 'Done'"));
260 }
261
262 return @existing_jobs;
263 }
264
265 sub debug {
266 my $msg = shift;
267 if($conf{debug}) {
268 print STDERR $msg."\n";
269 }
270 }
271
272 sub get_interface_info {
273 my $interface = shift;
274
275 my $info = `/sbin/ifconfig ${interface}`;
276 $info =~ /^.+HWaddr ([a-zA-Z0-9:]+).+inet addr:([0-9.]+).+$/s;
277 my ($mac, $ip) = ($1, $2);
278 return ($mac, $ip);
279 }

Properties

Name Value
svn:executable *
svn:keywords Id

  ViewVC Help
Powered by ViewVC 1.1.20