summaryrefslogtreecommitdiff
blob: 5530ff32f7c31e73ec69075a05db533c1b304ac4 (plain)
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
121
122
123
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->set_filename($filename);
	}
	return $self;
}

sub set_filename {
	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;

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;