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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
#!/usr/bin/perl
# $Id$
use strict;
use warnings;
use IPC::Open2;
use Getopt::Long;
use Data::Dumper;
use File::Path;
my $SCIRE_CONFIG_FILE = '../etc/scire.conf'; #will be /etc/scire.conf when released.
my %conf;
my ($SERVER_STDOUT, $SERVER_STDIN);
parse_command_line();
my $conf_file = (defined($conf{config})) ? $conf{config} : $SCIRE_CONFIG_FILE;
read_config($conf_file);
# Build the connection command.
# This will eventually be something like "ssh scire@${scireserver} /usr/bin/scireserver.pl"
my $connection_command = "ssh ";
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";
}
if (! -d $conf{job_dir}) {
print "WARNING! $conf{job_dir} does not exist...creating\n";
mkpath( $conf{job_dir}, {verbose => 1, mode => 0660})
or die("Couldn't make $conf{job_dir} w/ perms 0660: $!");
}
run_main();
sub run_main {
#ok folks so here's how this thang goes down.
#1. Connect.
create_connection();
#2. Register with the DB. (only it knows if you're allowed to be active)
if(-f "../etc/client_key") {
identify_client();
} else {
# register_client();
}
#3. Scan the jobs directory. If there are done/failed jobs, report them. Note jobs in running or queue.
#4. Fetch the jobs list
#5. ?
run_test();
}
sub run_test {
for(('PING', 'FOO', 'QUIT')) {
send_command($_);
my $response = get_response();
print "Got: ${response}";
}
}
sub parse_command_line {
GetOptions(
'debug|D' => \$conf{debug},
'dry-run' => \$conf{dry_run},
'help|h' => \$conf{help},
'config|c=s' => \$conf{config},
'threads|t=i' => \$conf{max_threads},
#config overrides.
'host=s' => \$conf{host},
'port=i' => \$conf{port},
'user|u=s' => \$conf{user},
'server_script=s' => \$conf{server_script},
'job_dir' => \$conf{job_dir},
);
if ($conf{help}) {
print "\nusage: scireclient.pl [--debug or -D]\n\t [--dry-run]"
."\t [--config=CONF or -c] \n\t [--threads=# or -t] \t [--help or -h] \n"
."\t [[--host=HOST] \t [--port=PORT] \t [--user=USER or -u] \n\t"
." [--server_script=foo.pl] \t [--job_dir=/tmp/jobs] \n";
exit 0;
}
}
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}\"";
}
}
print "Sending: ${tosend}\n" if $conf{debug};
print SERVER_STDIN "${tosend}\n";
}
sub get_response {
# XXX: Add some logic for multi-line responses here
my $response = <SERVER_STDOUT>;
return $response;
}
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 $pid = open2(*SERVER_STDOUT, *SERVER_STDIN, $connection_command);
}
sub read_config {
my $conf_file = shift;
open(FH, "< ${conf_file}") or die("Couldn't open the config file ${conf_file}: $!");
while (<FH>) {
chomp;
next if /^\s*(?:#|$)/;
if(/^\s*(.+?)\s*=\s*(.+?)\s*(?:#.*)?$/) {
unless(defined($conf{lc($1)})) { #Don't overwrite anything specified in cmdline
$conf{lc($1)} = $2;
}
}
}
close(FH) or die("Couldn't close the config file ${conf_file}: $!");
}
sub register_client {
send_command("REGISTER 00:11:22:33:44:55 192.168.2.3 myhostname");
}
sub identify_client {
open FILE, "< ../etc/client_key" or die "Couldn't open client_key: $!";
my $client_key = join("", <FILE>);
close FILE;
my $cmd = "IDENTIFY ${client_key}";
send_command($cmd);
my $response = get_response();
$response =~ /^(OK|ERROR (.+))$/;
if($1 eq "ERROR") {
print "Could not identify to server: $2\n";
}
print "Registered client $conf{client_id}\n" if $conf{debug};
}
|
GitWeb