diff options
author | 2008-01-05 04:31:34 +0000 | |
---|---|---|
committer | 2008-01-05 04:31:34 +0000 | |
commit | 6fd559d2fb4ed1db2a3adb65b1fbd4ff7ddbad5a (patch) | |
tree | 7f3596d5194481f64bcad834e73fc9364c09e67d | |
parent | set Data::Dumper::Purity to 1 for nested data (diff) | |
download | scire-6fd559d2fb4ed1db2a3adb65b1fbd4ff7ddbad5a.tar.gz scire-6fd559d2fb4ed1db2a3adb65b1fbd4ff7ddbad5a.tar.bz2 scire-6fd559d2fb4ed1db2a3adb65b1fbd4ff7ddbad5a.zip |
move bits of the server communication into Scire.pm
svn path=/branches/new-fu/; revision=324
-rw-r--r-- | client/Scire.pm | 86 | ||||
-rwxr-xr-x | client/scireclient.pl | 82 |
2 files changed, 97 insertions, 71 deletions
diff --git a/client/Scire.pm b/client/Scire.pm index 8ae5973..5530ff3 100644 --- a/client/Scire.pm +++ b/client/Scire.pm @@ -33,5 +33,91 @@ sub set_filename { } } +package Scire::Communicator; + +use IPC::Open2; + +my ($SERVER_STDIN, $SERVER_STDOUT); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = { + port => 22, + user => scire, + server_script => "/usr/bin/scireserver.pl", +# SERVER_STDOUT => undef, +# SERVER_STDIN => undef, + @_ + }; + bless ($self, $class); + $self->build_connection_command(); + return $self; +} + +sub send_command { + my $self = shift; + my $cmd = shift; + my @args = @_; + my $tosend = "${cmd}"; + + for my $arg (@args) { + if($arg =~ /^[0-9]+$/) { + $tosend .= " ${arg}"; + } else { + $arg =~ s/"/\\"/g; + $tosend .= " \"${arg}\""; + } + } +# debug("Sending: ${tosend}"); + print SERVER_STDIN "${tosend}\n"; + #FIXME WE NEED A TIMEOUT HERE OF SOME SORT!! + #if the server doesn't give you a newline this just hangs! + my $response = <SERVER_STDOUT>; +# debug("Got response: ${response}"); + return $self->parse_response($response); +} + +sub parse_response { + my $self = shift; + my $response = shift; + $response =~ /^(OK|ERROR)(?: (.+?))?\s*$/; + my ($status, $message) = ($1, $2); + return ($status, $message); +} + +sub create_connection { + my $self = shift; + # XXX: How do we capture this error? $pid has a valid value even if the + # process fails to run, since it just returns the PID of the forked perl + # process. I tried adding 'or die' after it, but it didn't help since it + # doesn't fail in the main process. When it fails, it outputs an error + # to STDERR: + # open2: exec of ../server/scireserver.pl failed at ./scireclient.pl line 116 + $self->{connection_pid} = open2(*SERVER_STDOUT, *SERVER_STDIN, $self->{connection_command}); +} + +sub build_connection_command { + my $self = shift; + # This will eventually be something like "ssh scire@${scireserver} /usr/bin/scireserver.pl" + my $connection_command = "ssh "; + $connection_command .= "-o BatchMode yes "; + $connection_command .= "-o SendEnv 'SCIRE_*' "; + $connection_command .= "-o ServerAliveInterval 15 -o ServerAliveCountMax 4 "; + if(defined($self->{port})) { + $connection_command .= "-o Port=$conf{port} "; + } + $connection_command .= "$self->{user}\@$self->{host} $self->{server_script}"; + + if (-d ".svn") { + # Overwrite $connection_command in the case of a dev environment for now + $connection_command = "../server/scireserver.pl"; + } + +# return $connection_command; + $self->{connection_command} = $connection_command; +} + + 1; diff --git a/client/scireclient.pl b/client/scireclient.pl index 25e6c9b..0925f07 100755 --- a/client/scireclient.pl +++ b/client/scireclient.pl @@ -5,7 +5,7 @@ use strict; use warnings; -use IPC::Open2; +use Scire; use Getopt::Long; use Data::Dumper; use File::Path; @@ -15,7 +15,7 @@ my $ETC_DIR = "/etc/scire"; my $SCIRE_CONFIG_FILE = "${ETC_DIR}/scire.conf"; my %conf; my ($SERVER_STDOUT, $SERVER_STDIN); -my $connection_pid; +my $comm; run_main(); @@ -26,11 +26,10 @@ sub run_main { check_job_dir(); - my $connection_command = build_connection_command(); - #ok folks so here's how this thang goes down. #1. Connect. - create_connection($connection_command); + $comm = Scire::Communicator->new( host => $conf{host}, user => $conf{user}, port => $conf{port} ); + $comm->create_connection(); #2. Register with the DB. (only it knows if you're allowed to be active) # If we do not have a defined key file, we assume this is the first run of this client @@ -77,65 +76,6 @@ sub parse_command_line { } -sub send_command { - my $cmd = shift; - my @args = @_; - my $tosend = "${cmd}"; - - for my $arg (@args) { - if($arg =~ /^[0-9]+$/) { - $tosend .= " ${arg}"; - } else { - $arg =~ s/"/\\"/g; - $tosend .= " \"${arg}\""; - } - } - debug("Sending: ${tosend}"); - print SERVER_STDIN "${tosend}\n"; - #FIXME WE NEED A TIMEOUT HERE OF SOME SORT!! - #if the server doesn't give you a newline this just hangs! - my $response = <SERVER_STDOUT>; - debug("Got response: ${response}"); - return $response; -} - -sub parse_response { - my $response = shift; - $response =~ /^(OK|ERROR)(?: (.+?))?\s*$/; - my ($status, $message) = ($1, $2); - return ($status, $message); -} - -sub create_connection { - # XXX: How do we capture this error? $pid has a valid value even if the - # process fails to run, since it just returns the PID of the forked perl - # process. I tried adding 'or die' after it, but it didn't help since it - # doesn't fail in the main process. When it fails, it outputs an error - # to STDERR: - # open2: exec of ../server/scireserver.pl failed at ./scireclient.pl line 116 - my $connection_command = shift; - $connection_pid = open2(*SERVER_STDOUT, *SERVER_STDIN, $connection_command); -} - -sub build_connection_command { - # This will eventually be something like "ssh scire@${scireserver} /usr/bin/scireserver.pl" - my $connection_command = "ssh "; - $connection_command .= "-o BatchMode yes "; - $connection_command .= "-o SendEnv 'SCIRE_*' "; - $connection_command .= "-o ServerAliveInterval 15 -o ServerAliveCountMax 4 "; - if(defined($conf{port})) { - $connection_command .= "-o Port=$conf{port} "; - } - $connection_command .= "$conf{user}\@$conf{host} $conf{server_script}"; - - if (-d ".svn") { - # Overwrite $connection_command in the case of a dev environment for now - $connection_command = "../server/scireserver.pl"; - } - - return $connection_command; -} - sub check_job_dir { if (! -d $conf{job_dir}) { print "WARNING! $conf{job_dir} does not exist...creating\n"; @@ -188,7 +128,7 @@ sub register_client { # my $ip = "192.168.2.3"; my ($mac, $ip) = get_interface_info(defined $conf{interface} && $conf{interface} ? $conf{interface} : "eth0"); my $hostname = hostname(); - my ($status, $message) = parse_response(send_command("REGISTER", $mac, $ip, $hostname)); + my ($status, $message) = $comm->send_command("REGISTER", $mac, $ip, $hostname); die "Could not register client $mac w/ ip $ip and hostname $hostname. Got: $message" if (! defined $status or $status ne "OK"); debug("Client registered. Status is pending. digest is $message"); open(FILE, ">$conf{key_file}") or die("Couldn't open key file $conf{key_file} for writing: $!"); @@ -201,7 +141,7 @@ sub identify_client { my $digest = <FILE>; chomp $digest; close(FILE); - my ($status, $message) = parse_response(send_command("IDENTIFY", $digest)); + my ($status, $message) = $comm->send_command("IDENTIFY", $digest); unless (defined $status && $status eq "OK") { print "ERROR Could not identify to server: $message\n"; return 0; @@ -211,7 +151,7 @@ sub identify_client { } sub get_jobs { - my ($status, $jobs) = parse_response(send_command("GET_JOBS")); + my ($status, $jobs) = $comm->send_command("GET_JOBS"); unless (defined $status && $status eq "OK") { print "Could not get jobs list from server: $status\n"; return 0; @@ -220,13 +160,13 @@ sub get_jobs { $jobs =~ s/\s//g; #Remove all whitespace my @jobs_list = split(/,/, $jobs); foreach my $job (@jobs_list) { - my ($status, $filename) = parse_response(send_command("GET_JOB", $job)); + my ($status, $filename) = $comm->send_command("GET_JOB", $job); #SCP the file to $conf{job_dir}/queue/ system("cp $filename $conf{job_dir}/queue/") and die("Can't copy file: $!"); #Temporary hack. only works locally. # XXX: Modify this to fetch a file instead debug("Fetched job $job "); - my ($status2,$message) = parse_response(send_command("JOB_FETCHED", $job)); + my ($status2,$message) = $comm->send_command("JOB_FETCHED", $job); unless (defined $status2 && $status2 eq "OK") { die("ERROR Could not signal job was fetched: $message\n"); } @@ -246,7 +186,7 @@ sub scan_jobs_dir { foreach my $job_file (@failed_jobs) { $job_file =~ /(\d+)\.job/; my $jobid = $1; - my ($status, $message) = parse_response(send_command("SET_JOB_STATUS $jobid 'Failed'")); + my ($status, $message) = $comm->send_command("SET_JOB_STATUS $jobid 'Failed'"); open(FILE, $job_file) or die "Couldn't open job file $job_file: $!"; my $job_data = join("", <FILE>); close(FILE); @@ -256,7 +196,7 @@ sub scan_jobs_dir { foreach my $job_file (@done_jobs) { $job_file =~ /(\d+)\.job/; my $jobid = $1; - my ($status, $message) = parse_response(send_command("SET_JOB_STATUS $jobid 'Done'")); + my ($status, $message) = $comm->send_command("SET_JOB_STATUS $jobid 'Done'"); } return @existing_jobs; |