/[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 265 - (show annotations) (download) (as text)
Wed Dec 26 05:18:56 2007 UTC (6 years, 6 months ago) by codeman
File MIME type: text/x-perl
File size: 4445 byte(s)
if to unless b/c of possible undef.

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
13 my $SCIRE_CONFIG_FILE = '../etc/scire.conf'; #will be /etc/scire.conf when released.
14 my %conf;
15 my ($SERVER_STDOUT, $SERVER_STDIN);
16
17 run_main();
18
19 sub run_main {
20 parse_command_line();
21 my $conf_file = (defined($conf{config})) ? $conf{config} : $SCIRE_CONFIG_FILE;
22 read_config_file($conf_file);
23
24 check_job_dir();
25
26 my $connection_command = build_connection_command();
27
28 #ok folks so here's how this thang goes down.
29 #1. Connect.
30 create_connection($connection_command);
31
32 #2. Register with the DB. (only it knows if you're allowed to be active)
33 # if(-f "../etc/client_key") {
34 if(!identify_client()) {
35 exit(1);
36 }
37 # } else {
38 # register_client();
39 # }
40
41 #3. Scan the jobs directory. If there are done/failed jobs, report them. Note jobs in running or queue.
42 #4. Fetch the jobs list
43 #5. ?
44 run_test();
45 }
46
47 sub run_test {
48 for(('PING', 'FOO', 'QUIT')) {
49 send_command($_);
50 my $response = get_response();
51 }
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 print "Sending: ${tosend}\n" if $conf{debug};
93 print SERVER_STDIN "${tosend}\n";
94 }
95
96 sub get_response {
97 # XXX: Add some logic for multi-line responses here
98 my $response = <SERVER_STDOUT>;
99 print "Got: ${response}" if($conf{debug});
100 return $response;
101 }
102
103 sub create_connection {
104 # XXX: How do we capture this error? $pid has a valid value even if the
105 # process fails to run, since it just returns the PID of the forked perl
106 # process. I tried adding 'or die' after it, but it didn't help since it
107 # doesn't fail in the main process. When it fails, it outputs an error
108 # to STDERR:
109 # open2: exec of ../server/scireserver.pl failed at ./scireclient.pl line 116
110 my $connection_command = shift;
111 my $pid = open2(*SERVER_STDOUT, *SERVER_STDIN, $connection_command);
112 }
113
114 sub build_connection_command {
115 # This will eventually be something like "ssh scire@${scireserver} /usr/bin/scireserver.pl"
116 my $connection_command = "ssh ";
117 if(defined($conf{port})) {
118 $connection_command .= "-o Port=$conf{port} ";
119 }
120 $connection_command .= "$conf{user}\@$conf{host} $conf{server_script}";
121
122 if (-d ".svn") {
123 # Overwrite $connection_command in the case of a dev environment for now
124 $connection_command = "../server/scireserver.pl";
125 }
126
127 return $connection_command;
128 }
129
130 sub check_job_dir {
131 if (! -d $conf{job_dir}) {
132 print "WARNING! $conf{job_dir} does not exist...creating\n";
133 mkpath( $conf{job_dir}, {verbose => 1, mode => 0660})
134 or die("Couldn't make $conf{job_dir} w/ perms 0660: $!");
135 }
136 }
137
138 sub read_config_file {
139 my $conf_file = shift;
140 open(FH, "< ${conf_file}") or die("Couldn't open the config file ${conf_file}: $!");
141 while (<FH>) {
142 chomp;
143 next if /^\s*(?:#|$)/;
144 if(/^\s*(.+?)\s*=\s*(.+?)\s*(?:#.*)?$/) {
145 unless(defined($conf{lc($1)})) { #Don't overwrite anything specified in cmdline
146 $conf{lc($1)} = $2;
147 }
148 }
149 }
150 close(FH) or die("Couldn't close the config file ${conf_file}: $!");
151 }
152
153 sub register_client {
154 send_command("REGISTER 00:11:22:33:44:55 192.168.2.3 myhostname");
155 }
156
157 sub identify_client {
158 # open FILE, "< ../etc/client_key" or die "Couldn't open client_key: $!";
159 # my $client_key = join("", <FILE>);
160 # close FILE;
161 my $client_key = "124567890";
162 send_command("IDENTIFY", $client_key);
163 my $response = get_response();
164 $response =~ /^(OK|ERROR)(?: (.+))?$/;
165 unless ($1 and ($1 eq "OK")) {
166 print "Could not identify to server: $response\n";
167 return 0;
168 }
169 # print "Registered client $conf{client_id}\n" if $conf{debug};
170 return 1;
171 }

Properties

Name Value
svn:executable *
svn:keywords Id

  ViewVC Help
Powered by ViewVC 1.1.20