/[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 292 - (show annotations) (download) (as text)
Mon Dec 31 17:58:41 2007 UTC (6 years, 6 months ago) by codeman
File MIME type: text/x-perl
File size: 7187 byte(s)
cleaned up the debugging.  took out existing jobs lines.

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

Properties

Name Value
svn:executable *
svn:keywords Id

  ViewVC Help
Powered by ViewVC 1.1.20