1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
package Scire::Job;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $filename = shift;
my $self = {};
bless ($self, $class);
if(defined $filename) {
$self->load_jobfile($filename);
}
return $self;
}
sub load_jobfile {
my $self = shift;
my $filename = shift;
$self->{filename} = $filename;
my $jobcontents;
my $jobdata;
open JOB, "< ${filename}" or die "Can't open file ${filename}";
$jobcontents = join("", <JOB>);
close JOB;
$jobdata = eval($jobcontents);
($@) and print "ERROR: Could not parse job file ${filename}!\n";
if(defined $jobdata->{script}) {
for(keys %{$jobdata->{script}}) {
$self->{$_} = $jobdata->{script}->{$_};
}
}
for(keys %{$jobdata}) {
$self->{$_} = $jobdata->{$_} unless($_ eq "script");
}
}
package Scire::Communicator;
use IPC::Open2 (open2);
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}\"";
}
}
$tosend .= "\n";
my ($tmpin, $tmpout) = ($self->{SERVER_STDIN}, $self->{SERVER_STDOUT});
print $tmpin $tosend;
#FIXME WE NEED A TIMEOUT HERE OF SOME SORT!!
#if the server doesn't give you a newline this just hangs!
my $response = <$tmpout>;
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($self->{SERVER_STDOUT}, $self->{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";
}
$self->{connection_command} = $connection_command;
}
1;
|
GitWeb