ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/bin/aemp
Revision: 1.22
Committed: Sun Aug 30 17:08:16 2009 UTC (14 years, 9 months ago) by root
Branch: MAIN
Changes since 1.21: +7 -12 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3     =head1 NAME
4    
5     aemp - AnyEvent:MP utility
6    
7     =head1 SYNOPSIS
8    
9     aemp command args...
10    
11     # protocol commands
12 root 1.19 aemp snd <port> <arg...> # send a message
13     aemp mon <port> # wait till port is killed
14     aemp rpc <port> <arg...> # send message, append reply
15     aemp eval <node> <expr...> # evaluate expression
16 root 1.22 aemp trace <nodeid> # trace the network topology
17 root 1.8
18     # run a node
19 root 1.19 aemp run initialise_args... # run a node
20 root 1.8
21     # node configuration: protocol endpoints
22 root 1.19 aemp setnodeid <nodeid> # configure the real node id
23     aemp delnodeid # reset node id to default (= inherit)
24 root 1.1
25     # node configuration: secret
26 root 1.19 aemp gensecret # generate a random shared secret
27     aemp setsecret <secret> # set the shared secret
28     aemp delsecret # remove the secret (= inherit)
29 root 1.1
30     # node configuration: TLS
31 root 1.19 aemp gencert # generate a random certificate
32     aemp setcert <file> # set a certificate (key.pem + certificate.pem)
33     aemp delcert # remove certificate (= inherit)
34 root 1.8
35 root 1.17 # node configuration: seed addresses for bootstrapping
36 root 1.19 aemp setseeds <host:port>,... # set seeds
37     aemp delseeds # clear all seeds (= inherit)
38     aemp addseed <host:port> # add a seed
39     aemp delseed <host:port> # remove seed
40 root 1.17
41     # node configuration: bind addresses
42 root 1.19 aemp setbinds <host:port>,... # set binds
43     aemp delbinds # clear all binds (= inherit)
44     aemp addbind <host:port> # add a bind address
45     aemp delbind <host:port> # remove a bind address
46 root 1.8
47     # node configuration: services
48 root 1.19 aemp setservices initfunc,... # set service functions
49     aemp delservices # clear all services (= inherit)
50     aemp addservice <initfunc> # add an instance of a service
51     aemp delservice <initfunc> # delete one instance of a service
52 root 1.6
53 root 1.10 # profile-specific configuration
54     aemp profile <name> <command>... # apply command to profile only
55 root 1.19 aemp delprofile <name> # eradicate the named profile
56     aemp showprofile <name> # display given profile
57     aemp showconfig <name> # display effective config
58 root 1.10
59 root 1.1 =head1 DESCRIPTION
60    
61 root 1.8 With aemp you can configure various aspects of AnyEvent::MP and its
62 root 1.22 protocol, send various messages and even run a node.
63 root 1.1
64     =cut
65    
66     use common::sense;
67    
68 root 1.19 # should come before anything else, so all modules
69     # will be loaded on each restart
70 root 1.22 BEGIN {
71 root 1.8 if ($ARGV[0] eq "run") {
72     shift;
73    
74 root 1.13 # d'oh
75 root 1.22 require AnyEvent::Watchdog;
76 root 1.19 # now we can load extra modules
77    
78 root 1.22 AnyEvent::Watchdog::autorestart (1);
79     AnyEvent::Watchdog::heartbeat (300);
80 root 1.13
81 root 1.8 require AnyEvent;
82     require AnyEvent::MP;
83     AnyEvent::MP::initialise_node (@ARGV);
84    
85 root 1.16 AnyEvent::detect () eq "AnyEvent::Impl::EV"
86 root 1.8 ? EV::loop ()
87     : AE::cv ()->recv;
88     }
89 root 1.22 }
90 root 1.8
91 root 1.1 use Carp ();
92    
93 root 1.17 use JSON::XS;
94    
95 root 1.1 use AnyEvent;
96 root 1.4 use AnyEvent::Util;
97    
98 root 1.8 use AnyEvent::MP;
99 root 1.1 use AnyEvent::MP::Config;
100    
101     sub my_run_cmd {
102     my ($cmd) = @_;
103    
104     my $cv = &run_cmd;
105     my $status = $cv->recv;
106    
107     $status
108     and die "@$cmd: command failed with exit status $status.";
109     }
110    
111     sub gen_cert {
112 root 1.2 my_run_cmd [qw(openssl req
113     -new -nodes -x509 -days 3650
114     -newkey rsa:2048 -keyout /dev/fd/3
115     -batch -subj /CN=AnyEvent::MP
116     )],
117 root 1.5 "<", "/dev/null",
118 root 1.1 ">" , \my $cert,
119     "3>", \my $key,
120 root 1.4 "2>", "/dev/null";
121 root 1.1
122     "$cert$key"
123     }
124    
125 root 1.10 our $cfg = AnyEvent::MP::Config::config;
126 root 1.8 our $profile = $cfg;
127 root 1.1
128 root 1.11 sub trace {
129     my ($node) = @_;
130     my $cv = AE::cv;
131     my %seen;
132    
133     my $to = AE::timer 15, 0, sub {
134     warn "timeout\n";
135     $cv->();
136     };
137    
138 root 1.19 initialise_node "anon/";
139 root 1.11
140     my $reply = port {
141 root 1.12 my ($node, @neigh) = @_;
142 root 1.11
143 root 1.12 @neigh = grep $_ ne $NODE, @neigh;
144    
145     print +(join " ", $node, @neigh), "\n";
146    
147     for (@neigh) {
148 root 1.11 unless ($seen{$_}++) {
149     $cv->begin;
150     snd $_, up_nodes => $SELF => $_;
151     }
152     }
153    
154     $cv->end;
155     };
156    
157     $cv->begin;
158     snd $reply, seed => $node;
159    
160     $cv->recv;
161     }
162    
163 root 1.10 sub docmd;
164    
165 root 1.1 our %CMD = (
166     snd => sub {
167 root 1.17 my $port = shift @ARGV;
168 root 1.19 initialise_node "anon/";
169 root 1.1
170 root 1.7 snd $port, @ARGV; @ARGV = ();
171 root 1.1
172     my $cv = AE::cv;
173 root 1.7 my $to = AE::timer 5, 0, sub { $cv->("timeout") };
174 root 1.1 mon $port, $cv;
175 root 1.19 my $reply = port sub { &$cv };
176     snd node_of $port, snd => $reply, "message sent successfully";
177 root 1.1
178     print join " ", $cv->recv, "\n";
179     },
180    
181 root 1.7 rpc => sub {
182 root 1.17 my $port = shift @ARGV;
183 root 1.19 initialise_node "anon/";
184 root 1.7
185     my $cv = AE::cv;
186     my $to = AE::timer 5, 0, sub { $cv->("timeout") };
187 root 1.19 snd $port, @ARGV, port { &$cv }; @ARGV = ();
188 root 1.7 mon $port, $cv;
189    
190     print join " ", $cv->recv, "\n";
191     },
192    
193 root 1.1 mon => sub {
194 root 1.17 my $port = shift @ARGV;
195 root 1.19 initialise_node "anon/";
196 root 1.1
197     mon $port, my $cv = AE::cv;
198     print join " ", $cv->recv, "\n";
199     },
200    
201 root 1.19 eval => sub {
202     my $node = node_of shift @ARGV;
203     my $expr = join " ", @ARGV; @ARGV = ();
204     initialise_node "anon/";
205    
206     my $cv = AE::cv;
207     my $to = AE::timer 5, 0, sub { $cv->("timeout") };
208     AnyEvent::MP::Kernel::eval_on $node, $expr, port { &$cv };
209     mon $node, $cv;
210    
211     my ($err, @res) = $cv->recv;
212    
213     die $err if length $err;
214    
215     print +(substr JSON::XS->new->encode (\@res), 1, -1), "\n";
216     },
217    
218 root 1.11 trace => sub {
219     @ARGV >= 1
220 root 1.17 or die "node id missing\n";
221 root 1.11
222 root 1.17 trace shift @ARGV;
223 root 1.11 },
224    
225 root 1.17 setnodeid => sub {
226 root 1.8 @ARGV >= 1
227     or die "shared secret missing\n";
228    
229 root 1.17 $profile->{nodeid} = shift @ARGV;
230 root 1.8 ++$cfg->{dirty};
231     },
232 root 1.17 delnodeid => sub {
233     delete $profile->{nodeid};
234 root 1.8 ++$cfg->{dirty};
235     },
236    
237 root 1.1 setsecret => sub {
238 root 1.8 @ARGV >= 1
239 root 1.1 or die "shared secret missing\n";
240    
241 root 1.8 $profile->{secret} = shift @ARGV;
242 root 1.1 ++$cfg->{dirty};
243     },
244     gensecret => sub {
245 root 1.18 $profile->{secret} = AnyEvent::MP::Kernel::alnumbits AnyEvent::MP::Kernel::nonce 64;
246 root 1.1 ++$cfg->{dirty};
247     },
248 root 1.17 delsecret => sub {
249 root 1.8 delete $profile->{secret};
250 root 1.1 ++$cfg->{dirty};
251     },
252    
253     setcert => sub {
254 root 1.8 @ARGV >= 1
255 root 1.1 or die "key+certificate pem filename missing\n";
256    
257     open my $fh, "<", $ARGV[0]
258     or die "$ARGV[0]: $!";
259    
260     local $/;
261 root 1.8 $profile->{cert} = <$fh>;
262 root 1.1 ++$cfg->{dirty};
263     },
264     gencert => sub {
265 root 1.8 $profile->{cert} = gen_cert;
266 root 1.1 ++$cfg->{dirty};
267     },
268 root 1.17 delcert => sub {
269 root 1.8 delete $profile->{cert};
270 root 1.1 ++$cfg->{dirty};
271     },
272 root 1.6
273 root 1.17 setbinds => sub {
274 root 1.19 @ARGV >= 1
275     or die "bind addresses missing\n";
276     $profile->{binds} = [split /,/, shift @ARGV];
277 root 1.17 ++$cfg->{dirty};
278     },
279     delbinds => sub {
280     delete $profile->{binds};
281     ++$cfg->{dirty};
282     },
283     addbind => sub {
284     @ARGV >= 1
285     or die "bind address missing\n";
286     my $bind = shift @ARGV;
287    
288     @{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
289     push @{ $profile->{binds} }, $bind;
290     ++$cfg->{dirty};
291     },
292     delbind => sub {
293     @ARGV >= 1
294     or die "bind address missing\n";
295     my $bind = shift @ARGV;
296    
297     @{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
298     ++$cfg->{dirty};
299     },
300    
301 root 1.6 setseeds => sub {
302 root 1.19 @ARGV >= 1
303     or die "seed addresses missing\n";
304     $profile->{seeds} = [split /,/, shift @ARGV];
305 root 1.6 ++$cfg->{dirty};
306     },
307 root 1.17 delseeds => sub {
308     delete $profile->{seeds};
309     ++$cfg->{dirty};
310     },
311 root 1.6 addseed => sub {
312 root 1.10 @ARGV >= 1
313 root 1.17 or die "seed address missing\n";
314 root 1.6 my $seed = shift @ARGV;
315 root 1.10
316 root 1.8 @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
317     push @{ $profile->{seeds} }, $seed;
318     ++$cfg->{dirty};
319     },
320     delseed => sub {
321 root 1.10 @ARGV >= 1
322 root 1.17 or die "seed address missing\n";
323 root 1.8 my $seed = shift @ARGV;
324 root 1.10
325 root 1.8 @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
326     ++$cfg->{dirty};
327     },
328    
329     setservices => sub {
330 root 1.19 @ARGV >= 1
331     or die "service specifications missing\n";
332     $profile->{services} = [split /,/, shift @ARGV];
333 root 1.8 @ARGV = ();
334 root 1.6 ++$cfg->{dirty};
335     },
336 root 1.17 delservices => sub {
337     delete $profile->{services};
338     ++$cfg->{dirty};
339     },
340 root 1.9 addservice => sub {
341 root 1.10 @ARGV >= 1
342     or die "service specification missing\n";
343 root 1.8 my $service = shift @ARGV;
344     push @{ $profile->{services} }, $service;
345     ++$cfg->{dirty};
346     },
347 root 1.9 delservice => sub {
348 root 1.10 @ARGV >= 1
349     or die "service specification missing\n";
350 root 1.8 my $service = shift @ARGV;
351     for (0 .. $#{ $profile->{services} }) {
352     next unless $profile->{services}[$_] eq $service;
353     splice @{ $profile->{services} }, $_, 1;
354     last;
355     }
356 root 1.6 ++$cfg->{dirty};
357     },
358 root 1.10
359     profile => sub {
360 root 1.19 @ARGV >= 1
361     or die "profile name is missing\n";
362 root 1.10 my $name = shift @ARGV;
363    
364     $profile = $cfg->{profile}{$name} ||= {};
365 root 1.14 ++$cfg->{dirty};
366 root 1.10 },
367     delprofile => sub {
368     @ARGV >= 1
369     or die "profile name is missing\n";
370     my $name = shift @ARGV;
371    
372     delete $cfg->{profile}{$name};
373 root 1.14 ++$cfg->{dirty};
374 root 1.10 },
375 root 1.17 showprofile => sub {
376     @ARGV >= 1
377     or die "profile name is missing\n";
378     my $name = shift @ARGV;
379    
380     print JSON::XS->new->pretty->encode ($cfg->{profile}{$name} || {});
381     },
382     showconfig => sub {
383     my $name = @ARGV ? shift @ARGV : AnyEvent::MP::Kernel::_nodename;
384    
385     print JSON::XS->new->pretty->encode (AnyEvent::MP::Config::find_profile $name);
386     },
387 root 1.1 );
388    
389     sub docmd {
390     my $cmd = shift @ARGV;
391    
392     $CMD{$cmd}
393     or die "$cmd: no such aemp command (try man aemp)";
394    
395     $CMD{$cmd}();
396     }
397    
398     @ARGV
399     or die "Usage: aemp subcommand ... (try man aemp)\n";
400    
401 root 1.19 docmd while @ARGV;
402 root 1.1
403