ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/bin/aemp
Revision: 1.50
Committed: Wed Feb 29 18:44:59 2012 UTC (12 years, 3 months ago) by root
Branch: MAIN
Changes since 1.49: +5 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.38 #!/opt/bin/perl
2 root 1.1
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 root 1.41 aemp cal <port> <arg...> # send message, append reply
15 root 1.19 aemp eval <node> <expr...> # evaluate expression
16 root 1.42 aemp shell [<node>] # run an interactive shell
17 root 1.37 aemp trace <node> # trace the network topology
18 root 1.8
19     # run a node
20 root 1.26 aemp run configure_args... # run a node
21 root 1.37 aemp restart <node> # restart a node if running under watchdog
22 root 1.8
23 root 1.23 # node configuration: node ID
24 root 1.19 aemp setnodeid <nodeid> # configure the real node id
25     aemp delnodeid # reset node id to default (= inherit)
26 root 1.1
27 root 1.47 # node configuration: authentication
28 root 1.19 aemp gensecret # generate a random shared secret
29     aemp setsecret <secret> # set the shared secret
30     aemp delsecret # remove the secret (= inherit)
31     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.47 # profile management
54 root 1.10 aemp profile <name> <command>... # apply command to profile only
55 root 1.26 aemp setparent <name> # specify a parent profile
56 root 1.25 aemp delparent # clear parent again
57 root 1.19 aemp delprofile <name> # eradicate the named profile
58     aemp showprofile <name> # display given profile
59 root 1.25 aemp showconfig <name> ... # display effective config
60 root 1.10
61 root 1.47 # node configuration: low-level protocol
62     aemp [set|del]monitor_timeout <seconds>
63     aemp [set|del]connect_interval <seconds>
64     aemp [set|del]framing_format [array]
65     aemp [set|del]auth_offer [array]
66     aemp [set|del]auth_accept [array]
67     aemp [set|del]autocork <boolean>
68     aemp [set|del]nodelay <boolean>
69    
70 root 1.1 =head1 DESCRIPTION
71    
72 root 1.8 With aemp you can configure various aspects of AnyEvent::MP and its
73 root 1.22 protocol, send various messages and even run a node.
74 root 1.1
75 root 1.23 The F<aemp> utility works like F<cvs>, F<svn> or other commands: the first
76     argument defines which operation (subcommand) is requested, after which
77     arguments for this operation are expected. When a subcommand does not eat
78     all remaining arguments, the remaining arguments will again be interpreted
79     as subcommand and so on.
80    
81     This means you can chain multiple commands, which is handy for profile
82     configuration, e.g.:
83    
84 root 1.27 aemp gensecret profile xyzzy binds 4040,4041 nodeid anon/
85    
86     Please note that all C<setxxx> subcommands have an alias without the
87     C<set> prefix.
88 root 1.23
89 root 1.34 All configuration data is stored in a human-readable (JSON) config file
90 root 1.46 stored in F<~/.perl-anyevent-mp> (or F<%appdata%/perl-anyevent-mp> on
91 root 1.49 loser systems, or wherever C<$ENV{PERL_ANYEVENT_MP_RC}> points to). Feel
92 root 1.46 free to look at it or edit it, the format is relatively simple.
93 root 1.34
94 root 1.35 =head2 SPECIFYING ARGUMENTS
95    
96     Arguments can be specified just as with any other shell command, with a
97     few special cases:
98    
99     If the I<first> argument starts with a literal C<[>-character, then it is
100     interpreted as a UTF-8 encoded JSON text. The resulting array replaces all
101     arguments.
102    
103     Otherwise, if I<any> argument starts with one of C<[>, C<{> or C<">, then
104     it is interpreted as UTF-8 encoded JSON text (or a single value in case of
105     C<">), and the resulting reference or scalar replaces the argument.
106    
107     This allows you, for example, to specify binds in F<aemp run> (using POSIX
108     shell syntax):
109    
110     aemp run binds '["*:4040"]'
111    
112 root 1.23 =head2 RUNNING A NODE
113    
114     This can be used to run a node - together with some services, this makes
115 elmex 1.32 it unnecessary to write any wrapper programs.
116 root 1.23
117     =over 4
118    
119 root 1.30 =item run <configure_args>...
120 root 1.23
121 root 1.26 Runs a node by calling C<AnyEvent::MP::Kernel::configure> with the given
122 root 1.23 arguments. The node runs under L<AnyEvent::Watchdog>, can be restarted
123 root 1.30 (and autorestarted, see the L<AnyEvent::Watchdog> manual). A very common
124 root 1.33 invocation is to just specify a profile using the profile name
125 root 1.30
126 root 1.33 aemp run database-backend
127 root 1.30
128     ... but you can use most arguments that C<configure> understands:
129    
130     aemp run nodeid mynode2 profile someprofile
131 root 1.23
132     Care has been taken to load (almost) no modules other than
133     L<AnyEvent::Watchdog> and the modules it loads, so everything (including
134     the L<AnyEvent::MP> modules themselves) will be freshly loaded on restart,
135     which makes upgrading everything except the perl binary easy.
136    
137 root 1.37 =item restart <node>
138    
139     Restarts the node using C<AnyEvent::Watchdog::Util::restart>. This works
140     for nodes started by C<aemp run>, but also for any other node that uses
141     L<AnyEvent::Watchdog>.
142    
143 root 1.23 =back
144    
145     =head2 PROTOCOL COMMANDS
146    
147     These commands actually communicate with other nodes. They all use a node
148 elmex 1.32 profile name of C<aemp> (specifying a default node ID of C<anon/> and a
149 root 1.25 binds list containing C<*:*> only).
150 root 1.23
151     They all use a timeout of five seconds, after which they give up.
152    
153     =over 4
154    
155     =item snd <port> <arguments...>
156    
157     Simply send a message to the given port - where you get the port ID from
158     is your problem.
159    
160     Exits after ensuring that the message has been delivered to its node.
161    
162 elmex 1.32 Most useful to take advantage of some undocumented functionality inside
163 root 1.23 nodes, such as node ports being able to call any method:
164    
165     aemp snd doomed AnyEvent::Watchdog::restart 1
166    
167 root 1.41 =item cal <port> <arg...>
168 root 1.23
169 root 1.41 Like F<aemp cal>: appends a local reply port to the message and waits for
170     a message to it.
171 root 1.23
172     Any return values will be JSON-encoded and printed separated by commas
173     (kind of like a JSON array without []-brackets).
174    
175 root 1.41 Example: ask the (undocumented) time service of a node for its current
176 root 1.23 time.
177    
178 root 1.41 aemp cal mynode time
179 root 1.23
180     =item mon <port>
181    
182     Monitors the port and exits when it's monitorign callback is called. Most
183     useful to monitor node ports.
184    
185     Example: monitor some node.
186    
187     aemp mon doomed
188    
189     =item eval <node> <expr...>
190    
191     Joins all remaining arguments into a string and evaluates it on the given
192 root 1.41 node. Return values are handled as with F<aemp cal>.
193 root 1.23
194     Example: find the unix process ID of the node called posicks.
195    
196     aemp eval posicks '$$'
197    
198     =item trace <node>
199    
200     Asks the given node for all currently connected nodes, then asks those
201     nodes for the same, thus tracing all node connections.
202    
203 root 1.31 =back
204 root 1.23
205     =head2 CONFIGURATION/NODE ID/SECRET/CERTIFICATE
206    
207     These commands deal with rather basic settings, the node ID, the shared
208     secret and the TLS certificate.
209    
210     =over 4
211    
212     =item setnodeid <nodeid>
213    
214 root 1.50 Set the node ID to the given string. If it ends with a slash (C</>), then
215     a random string is appended to make it unique.
216    
217     If no nodeid is specified in any profile, then the profile name, plus
218     appended slash, is used.
219 root 1.23
220     =item delnodeid
221    
222     Removes the node ID again, which means it is inherited again from it's
223     parent profile, or stays unset.
224    
225     =item gensecret
226    
227     Generates a random shared secret and sets it. The shared secret is used to
228     authenticate nodes to each other when TLS is not required.
229    
230     =item setsecret <secret>
231    
232     Sets the shared secret tot he given string, which can be anything.
233    
234     =item delsecret
235    
236     Removes the shared secret again, which means it is inherited again from
237     it's parent profile, or stays unset.
238    
239     =item gencert
240    
241 elmex 1.32 Generates a self-signed certificate and key, and sets it. This works
242 root 1.23 similarly to a shared secret: when all nodes have it, TLS will be used to
243     authenticate and encrypt all traffic.
244    
245     =item setcert <file>
246    
247     Set a node certificate (and optionally any CA certificates) from the given
248     file. The file must contain the key, followed by the certificate, followed
249     by any CA certificates you want to trust, all in PEM format.
250    
251     See L<AnyEvent::TLS> for some more details - this sets the C<cert> and
252     C<ca_cert> options.
253    
254     =item delcert
255    
256     Removes the certificate(s) again, which means it is inherited again from
257     it's parent profile, or stays unset.
258    
259     =back
260    
261     =head2 CONFIGURATION/SEEDS
262    
263     To discover the network you have to specify some seed addresses, which are
264     basically C<host:port> pairs where you expect some long-running nodes. It
265     does no harm to have a node as its own seed (they will eventually be
266     ignored).
267    
268 root 1.31 =over 4
269    
270 root 1.23 =item setseeds <host:port>,...
271    
272     Sets or replaces the list of seeds, which must be specified as a
273     comma-separated list of C<host:port> pairs. The C<host> can be a hostname,
274 root 1.36 an IP address, or C<*> to signify all local host addresses (which makes
275     little sense for seeds, outside some examples, but a lot of sense for
276     binds).
277 root 1.23
278     An empty list is allowed.
279    
280     Example: use C<doomed> with default port as only seednode.
281    
282     aemp setseeds doomed
283    
284     =item delseeds
285    
286     Removes the seed list again, which means it is inherited again from it's
287     parent profile, or stays unset.
288    
289     =item addseed <host:port>
290    
291     Adds a single seed address.
292    
293     =item delseed <host:port>
294    
295     Deletes the given seed address, if it exists.
296    
297     =back
298    
299     =head2 CONFIGURATION/BINDS
300    
301     To be able to be reached from other nodes, a node must I<bind> itself
302     to some listening socket(s). The list of these can either bs specified
303     manually, or AnyEvent::MP can guess them. Nodes without any binds are
304     possible to some extent.
305    
306     =over 4
307    
308     =item setbinds <host:port>,...
309    
310     Sets the list of bind addresses explicitly - see the F<aemp setseeds>
311 root 1.36 command for the exact syntax. In addition, a value of C<*> for the port,
312     or not specifying a port, means to use a dynamically-assigned port.
313 root 1.23
314 root 1.36 Note that the C<*>, C<*:*> or C<*:port> patterns are very useful here.
315 root 1.23
316 root 1.36 Example: bind on a ephemeral port on all local interfaces.
317 root 1.23
318     aemp setbinds "*"
319    
320     Example: bind on a random port on all local interfaces.
321    
322 root 1.25 aemp setbinds "*:*"
323 root 1.23
324     Example: resolve "doomed.mydomain" and try to bind on port C<4040> of all
325     IP addressess returned.
326    
327 root 1.36 aep setbinds doomed.mydomain:4040
328 root 1.23
329     =item delbinds
330    
331     Removes the bind list again, which means it is inherited again from it's
332     parent profile, or stays unset.
333    
334     =item addbind <host:port>
335    
336     Adds a single bind address.
337    
338     =item delbind <host:port>
339    
340     Deletes the given bind address, if it exists.
341    
342     =back
343    
344     =head2 CONFIGURATION/SERVICES
345    
346     Services are modules (or functions) that are automatically loaded (or
347     executed) when a node starts. They are especially useful when used in
348     conjunction with F<aemp run>, to configure which services a node should
349     run.
350    
351 root 1.47 Despite the daunting name, services really I<are> nothing more than a
352     module name or a function name with arguments. The "service" aspect comes
353     only from the behaviour of the module or function, which is supposed to
354     implement, well, some kind of service for the node, network etc.
355    
356     Instead of writing a standalone program for each different node type in
357     your network, you can simply put your code into a module, and then let the
358     configuration decide which node runs which "services". This also makes it
359     easy to combine multiple different services within the same node.
360    
361 root 1.23 =over 4
362    
363     =item setservices <initfunc>...
364    
365     Sets or replaces the list of services, which must be specified as a
366 root 1.37 comma-separated list or a JSON array.
367    
368     Each string entry in the list is interpreted as either a module name to
369     load (when it ends with C<::>) or a function to call (all other cases).
370    
371     Each entry which is an array itself (you need to use JSON format to
372     specify those) is interpreted as a function name and the arguments to
373     pass.
374 root 1.23
375 root 1.37 The algorithm to find the function is the same as used for C<<
376 root 1.23 L<AnyEvent::MP>::spawn >>.
377    
378 root 1.37 Example: run the globa service (which runs anyway, but this doesn't hurt).
379    
380     aemp setservices AnyEvent::MP::Global::
381    
382     Example: call the mymod::myfun function with arguments 1, 2 and 3.
383    
384     aemp setservices '[["mymod::myfun", 1,2,3]]'
385    
386 root 1.23 =item delservices
387    
388     Removes the service list again, which means it is inherited again from
389     it's parent profile, or stays unset.
390    
391     =item addservice <initfunc>
392    
393     Adds a single service.
394    
395     =item delservice <initfunc>
396    
397     Deletes the given service, if it exists.
398    
399     =back
400    
401     =head2 CONFIGURATION/PROFILE MANAGEMENT
402    
403     All the above configuration functions by default affect the I<global
404     default configuration>, which is basically used to augment every profile
405     and node configuration.
406    
407     =over 4
408    
409     =item profile <name> ...
410    
411     This subcommand makes the following subcommands act only on a specific
412     named profile, instead of on the global default. The profile is created if
413     necessary.
414    
415     Example: create a C<server> profile, give it a random node name, some seed
416     nodes and bind it on an unspecified port on all local interfaces. You
417     should add some services then and run the node...
418    
419 root 1.30 aemp profile server nodeid anon/ seeds doomed,10.0.0.2:5000 binds "*:*"
420 root 1.23
421     =item delprofile <name>
422    
423     Deletes the profile of the given name.
424    
425 root 1.26 =item setparent <name>
426 root 1.24
427     Sets the parent profile to use - values not specified in a profile will be
428     taken from the parent profile (even recursively, with the global default
429     config being the default parent). This is useful to configure profile
430     I<classes> and then to inherit from them for individual nodes.
431    
432     Note that you can specify circular parent chains and even a parent for the
433     global configuration. Neither will do you any good, however.
434    
435     Example: inherit all values not specified in the C<doomed> profile from
436     the C<server> profile.
437    
438 root 1.26 aemp profile doomed setparent server
439 root 1.24
440     =item delparent
441    
442     Removes the parent again from the profile, if any was set, so the profile
443     inherits directly from the global default config again.
444    
445 root 1.23 =item showprofile <name>
446    
447     Shows the values of the given profile, and only those, no inherited
448     values.
449    
450 root 1.25 =item showconfig <name> <key value...>
451 root 1.23
452 root 1.24 Shows the I<effective> config, i.e. the values as used by a node started
453 root 1.25 with the given profile name. Any additional key-value pairs specified
454 root 1.26 augment the configuration, just as with C<configure>.
455 root 1.24
456 root 1.25 If all arguments are omitted, show the global default config.
457 root 1.23
458     =back
459    
460 root 1.47 =head2 LOW-LEVEL TRANSPORT PROTOCOL
461    
462     The low-level transport protocol betwene two nodes also has a number of
463     configurable options, most of which should not be touched unless you know
464     what you are doing.
465    
466     =over 4
467    
468     =item [set|del]monitor_timeout <seconds>
469    
470     Sets the default monitor timeout, that is, when a connection to a node
471     cannot be established within this many seconds, the node is declared
472     unreachable and all monitors will fire.
473    
474     C<30> seconds are usually a good time span for this.
475    
476     =item [set|del]connect_interval <seconds>
477    
478     When a connection cannot be established successfully within this many
479     seconds, try the next transport address (e.g. the next IP address). If
480     your nodes have a lot of transports, you might have to set this to a low
481     value so that they will actually all be tried within the monitor timeout
482     interval.
483    
484     C<2> is usually a good value, unless you live in new zealand.
485    
486     =item [set|del]framing_format [array]
487    
488     Configures the list of framing formats offered to the other side. This is
489     simply a list of formatted read/write types used with L<AnyEvent::Handle>,
490     in order of decreasing preference.
491    
492     Nodes support both C<json> and C<storable> framing formats for data
493     packets out of the box, and usually choose C<json> because it is first in
494     the list.
495    
496     Example: prefer the C<My::Personal::Format> framing format over JSON over
497     Storable.
498    
499     aemp setframing_format '["My::Personal::Format", "json", "storable"]'
500    
501     =item [set|del]auth_offer [array]
502    
503     Configures the list of authentication types that the node offers to the
504     other side as acceptable, in order of decreasing preference. Only auth
505     methods that the node can actually support will be offered.
506    
507     The default is '["tls_md6_64_256", "hmac_md6_64_256"]' and is usually good
508     enough.
509    
510     =item [set|del]auth_accept [array]
511    
512     Configures the list of authentication types that remote nodes can use to
513     authenticate, in order of decreasing preference.
514    
515     The default is '["tls_md6_64_256", "hmac_md6_64_256", "tls_anon",
516     "cleartext"]' and is usually good enough.
517    
518     =item [set|del]autocork <boolean>
519    
520     Sets the default C<autocork> option value for the L<AnyEvent::Handle>
521     object used by transports. By default, autocorking is off.
522    
523     =item [set|del]nodelay <boolean>
524    
525     Sets the default C<nodelay> option value for the L<AnyEvent::Handle>
526     object used by transports. By default, nodelay is on.
527    
528     =back
529    
530 root 1.1 =cut
531    
532     use common::sense;
533    
534 root 1.19 # should come before anything else, so all modules
535     # will be loaded on each restart
536 root 1.22 BEGIN {
537 root 1.35 if (@ARGV == 1 && $ARGV[0] =~ /^\[/) {
538     require JSON::XS;
539     @ARGV = @{ JSON::XS->new->utf8->decode (shift) };
540     } else {
541     for (@ARGV) {
542     if (/^[\[\{\"]/) {
543     require JSON::XS;
544     $_ = JSON::XS->new->utf8->allow_nonref->decode ($_);
545     }
546     }
547     }
548    
549 root 1.8 if ($ARGV[0] eq "run") {
550     shift;
551    
552 root 1.13 # d'oh
553 root 1.22 require AnyEvent::Watchdog;
554 root 1.48 # only now can we load additional modules
555    
556     require AnyEvent;
557 root 1.19
558 root 1.29 require AnyEvent::Watchdog::Util;
559     AnyEvent::Watchdog::Util::autorestart (1);
560     AnyEvent::Watchdog::Util::heartbeat (300);
561 root 1.13
562 root 1.25 require AnyEvent::MP::Kernel;
563 root 1.26 AnyEvent::MP::Kernel::configure (@ARGV);
564 root 1.8
565 root 1.16 AnyEvent::detect () eq "AnyEvent::Impl::EV"
566 root 1.8 ? EV::loop ()
567     : AE::cv ()->recv;
568     }
569 root 1.22 }
570 root 1.8
571 root 1.1 use Carp ();
572    
573 root 1.17 use JSON::XS;
574    
575 root 1.1 use AnyEvent;
576 root 1.4 use AnyEvent::Util;
577    
578 root 1.8 use AnyEvent::MP;
579 root 1.1 use AnyEvent::MP::Config;
580    
581     sub my_run_cmd {
582     my ($cmd) = @_;
583    
584     my $cv = &run_cmd;
585     my $status = $cv->recv;
586    
587     $status
588     and die "@$cmd: command failed with exit status $status.";
589     }
590    
591     sub gen_cert {
592 root 1.2 my_run_cmd [qw(openssl req
593     -new -nodes -x509 -days 3650
594     -newkey rsa:2048 -keyout /dev/fd/3
595     -batch -subj /CN=AnyEvent::MP
596     )],
597 root 1.5 "<", "/dev/null",
598 root 1.1 ">" , \my $cert,
599     "3>", \my $key,
600 root 1.4 "2>", "/dev/null";
601 root 1.1
602     "$cert$key"
603     }
604    
605 root 1.25 sub init {
606 root 1.26 configure profile => "aemp", nodeid => "anon/";
607 root 1.25 }
608    
609 root 1.10 our $cfg = AnyEvent::MP::Config::config;
610 root 1.8 our $profile = $cfg;
611 root 1.1
612 root 1.11 sub trace {
613     my ($node) = @_;
614     my $cv = AE::cv;
615     my %seen;
616    
617 root 1.28 my $to = AE::timer 15, 0, sub { exit 1 };
618 root 1.11
619 root 1.25 init;
620 root 1.11
621     my $reply = port {
622 root 1.12 my ($node, @neigh) = @_;
623 root 1.11
624 root 1.12 @neigh = grep $_ ne $NODE, @neigh;
625    
626     print +(join " ", $node, @neigh), "\n";
627    
628     for (@neigh) {
629 root 1.11 unless ($seen{$_}++) {
630     $cv->begin;
631     snd $_, up_nodes => $SELF => $_;
632     }
633     }
634    
635     $cv->end;
636     };
637    
638     $cv->begin;
639     snd $reply, seed => $node;
640    
641     $cv->recv;
642     }
643    
644 root 1.42 sub shell {
645     init;
646    
647     my $node = shift @ARGV || $NODE;
648     $| = 1;
649    
650     print <<EOF;
651     Entering interactive shell - no commandline editing of course (use rlfe etc.).
652    
653 root 1.43 \= display a list of nodes
654     \=name switch to another node
655 root 1.42
656     EOF
657     print "$node> ";
658     my $cv = AE::cv;
659     my $t = AE::io *STDIN, 0, sub {
660     chomp (my $line = <STDIN>);
661    
662     if ($line =~ s/^=//) {
663     if (length $line) {
664     $node = $line;
665     } else {
666     print +(join " ", AnyEvent::MP::Kernel::up_nodes), "\n";
667     }
668     } else {
669     my $time = AE::time;
670     AnyEvent::MP::Kernel::eval_on $node, $line, port {
671     my ($err, @res) = @_;
672    
673     $time = AE::time - $time;
674    
675     print "\n $node: $line\n";
676     if (length $err) {
677     print " $err @res";
678     } else {
679     print " ", JSON::XS::encode_json \@_;
680     }
681     printf "\n %0.3fs\n", $time;
682     print "$node> ";
683     };
684     }
685    
686     print "$node> ";
687     };
688     $cv->recv;
689     }
690    
691 root 1.37 sub node_eval {
692     my ($node, $expr) = @_;
693    
694     init;
695    
696     my $cv = AE::cv;
697     my $to = AE::timer 5, 0, sub { exit 1 };
698     AnyEvent::MP::Kernel::eval_on $node, $expr, port { &$cv };
699     mon $node, $cv;
700    
701     my ($err, @res) = $cv->recv;
702    
703 root 1.39 die "$err @res" if length $err;
704 root 1.37
705     print +(substr JSON::XS->new->encode (\@res), 1, -1), "\n";
706     }
707    
708 root 1.10 sub docmd;
709    
710 root 1.1 our %CMD = (
711     snd => sub {
712 root 1.17 my $port = shift @ARGV;
713 root 1.25 init;
714 root 1.1
715 root 1.7 snd $port, @ARGV; @ARGV = ();
716 root 1.1
717     my $cv = AE::cv;
718 root 1.28 my $to = AE::timer 5, 0, sub { exit 1 };
719 root 1.1 mon $port, $cv;
720 root 1.19 my $reply = port sub { &$cv };
721     snd node_of $port, snd => $reply, "message sent successfully";
722 root 1.1
723     print join " ", $cv->recv, "\n";
724     },
725    
726 root 1.41 cal => sub {
727 root 1.17 my $port = shift @ARGV;
728 root 1.25 init;
729 root 1.7
730     my $cv = AE::cv;
731 root 1.41 cal $port, @ARGV, sub { &$cv }; @ARGV = ();
732 root 1.7
733 root 1.23 print +(substr JSON::XS->new->encode ([$cv->recv]), 1, -1), "\n";
734 root 1.7 },
735    
736 root 1.1 mon => sub {
737 root 1.17 my $port = shift @ARGV;
738 root 1.25 init;
739 root 1.1
740     mon $port, my $cv = AE::cv;
741     print join " ", $cv->recv, "\n";
742     },
743    
744 root 1.19 eval => sub {
745     my $node = node_of shift @ARGV;
746     my $expr = join " ", @ARGV; @ARGV = ();
747 root 1.37 node_eval $node, $expr;
748 root 1.19 },
749    
750 root 1.42 shell => \&shell,
751    
752 root 1.11 trace => sub {
753     @ARGV >= 1
754 root 1.17 or die "node id missing\n";
755 root 1.11
756 root 1.17 trace shift @ARGV;
757 root 1.11 },
758 root 1.37 restart => sub {
759     my $node = node_of shift @ARGV;
760 root 1.44 node_eval $node, 'my $w; $w = AE::idle sub { '
761     . 'undef $w; '
762     . 'use AnyEvent::Watchdog::Util ();'
763     . 'AnyEvent::Watchdog::Util::restart'
764     . '}; ()';
765 root 1.37 },
766 root 1.11
767 root 1.17 setnodeid => sub {
768 root 1.8 @ARGV >= 1
769     or die "shared secret missing\n";
770    
771 root 1.17 $profile->{nodeid} = shift @ARGV;
772 root 1.8 ++$cfg->{dirty};
773     },
774 root 1.17 delnodeid => sub {
775     delete $profile->{nodeid};
776 root 1.8 ++$cfg->{dirty};
777     },
778    
779 root 1.1 setsecret => sub {
780 root 1.8 @ARGV >= 1
781 root 1.1 or die "shared secret missing\n";
782    
783 root 1.8 $profile->{secret} = shift @ARGV;
784 root 1.1 ++$cfg->{dirty};
785     },
786     gensecret => sub {
787 root 1.18 $profile->{secret} = AnyEvent::MP::Kernel::alnumbits AnyEvent::MP::Kernel::nonce 64;
788 root 1.1 ++$cfg->{dirty};
789     },
790 root 1.17 delsecret => sub {
791 root 1.8 delete $profile->{secret};
792 root 1.1 ++$cfg->{dirty};
793     },
794    
795     setcert => sub {
796 root 1.8 @ARGV >= 1
797 root 1.1 or die "key+certificate pem filename missing\n";
798    
799 elmex 1.45 my $certfile = shift @ARGV;
800    
801     open my $fh, "<", $certfile
802     or die "$certfile: $!";
803 root 1.1
804     local $/;
805 root 1.8 $profile->{cert} = <$fh>;
806 root 1.1 ++$cfg->{dirty};
807     },
808     gencert => sub {
809 root 1.8 $profile->{cert} = gen_cert;
810 root 1.1 ++$cfg->{dirty};
811     },
812 root 1.17 delcert => sub {
813 root 1.8 delete $profile->{cert};
814 root 1.1 ++$cfg->{dirty};
815     },
816 root 1.6
817 root 1.17 setbinds => sub {
818 root 1.19 @ARGV >= 1
819     or die "bind addresses missing\n";
820 root 1.38 my $list = shift @ARGV;
821     $profile->{binds} = ref $list ? $list : [split /,/, $list];
822 root 1.17 ++$cfg->{dirty};
823     },
824     delbinds => sub {
825     delete $profile->{binds};
826     ++$cfg->{dirty};
827     },
828     addbind => sub {
829     @ARGV >= 1
830     or die "bind address missing\n";
831     my $bind = shift @ARGV;
832    
833     @{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
834     push @{ $profile->{binds} }, $bind;
835     ++$cfg->{dirty};
836     },
837     delbind => sub {
838     @ARGV >= 1
839     or die "bind address missing\n";
840     my $bind = shift @ARGV;
841    
842     @{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
843     ++$cfg->{dirty};
844     },
845    
846 root 1.6 setseeds => sub {
847 root 1.19 @ARGV >= 1
848     or die "seed addresses missing\n";
849 root 1.38 my $list = shift @ARGV;
850     $profile->{seeds} = ref $list ? $list : [split /,/, $list];
851 root 1.6 ++$cfg->{dirty};
852     },
853 root 1.17 delseeds => sub {
854     delete $profile->{seeds};
855     ++$cfg->{dirty};
856     },
857 root 1.6 addseed => sub {
858 root 1.10 @ARGV >= 1
859 root 1.17 or die "seed address missing\n";
860 root 1.6 my $seed = shift @ARGV;
861 root 1.10
862 root 1.8 @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
863     push @{ $profile->{seeds} }, $seed;
864     ++$cfg->{dirty};
865     },
866     delseed => sub {
867 root 1.10 @ARGV >= 1
868 root 1.17 or die "seed address missing\n";
869 root 1.8 my $seed = shift @ARGV;
870 root 1.10
871 root 1.8 @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
872     ++$cfg->{dirty};
873     },
874    
875     setservices => sub {
876 root 1.19 @ARGV >= 1
877     or die "service specifications missing\n";
878 root 1.38 my $list = shift @ARGV;
879     $profile->{services} = ref $list ? $list : [split /,/, $list];
880 root 1.6 ++$cfg->{dirty};
881     },
882 root 1.17 delservices => sub {
883     delete $profile->{services};
884     ++$cfg->{dirty};
885     },
886 root 1.9 addservice => sub {
887 root 1.10 @ARGV >= 1
888     or die "service specification missing\n";
889 root 1.8 my $service = shift @ARGV;
890     push @{ $profile->{services} }, $service;
891     ++$cfg->{dirty};
892     },
893 root 1.9 delservice => sub {
894 root 1.10 @ARGV >= 1
895     or die "service specification missing\n";
896 root 1.8 my $service = shift @ARGV;
897     for (0 .. $#{ $profile->{services} }) {
898     next unless $profile->{services}[$_] eq $service;
899     splice @{ $profile->{services} }, $_, 1;
900     last;
901     }
902 root 1.6 ++$cfg->{dirty};
903     },
904 root 1.10
905     profile => sub {
906 root 1.19 @ARGV >= 1
907     or die "profile name is missing\n";
908 root 1.10 my $name = shift @ARGV;
909    
910     $profile = $cfg->{profile}{$name} ||= {};
911 root 1.14 ++$cfg->{dirty};
912 root 1.10 },
913     delprofile => sub {
914     @ARGV >= 1
915     or die "profile name is missing\n";
916     my $name = shift @ARGV;
917    
918     delete $cfg->{profile}{$name};
919 root 1.14 ++$cfg->{dirty};
920 root 1.10 },
921 root 1.26 setparent => sub {
922 root 1.24 @ARGV >= 1
923     or die "profile name is missing\n";
924    
925     $profile->{parent} = shift @ARGV;
926     ++$cfg->{dirty};
927     },
928     delparent => sub {
929     delete $profile->{parent};
930     ++$cfg->{dirty};
931     },
932 root 1.17 showprofile => sub {
933     @ARGV >= 1
934     or die "profile name is missing\n";
935     my $name = shift @ARGV;
936    
937     print JSON::XS->new->pretty->encode ($cfg->{profile}{$name} || {});
938     },
939     showconfig => sub {
940     my $name = @ARGV ? shift @ARGV : AnyEvent::MP::Kernel::_nodename;
941    
942 root 1.25 my $profile = AnyEvent::MP::Config::find_profile $name, @ARGV;
943     @ARGV = ();
944 root 1.24
945     # make it look nicer:
946     delete $profile->{profile};
947     delete $profile->{parent};
948    
949     print JSON::XS->new->pretty->encode ($profile);
950 root 1.17 },
951 root 1.25
952     # undocumented
953     _resolve => sub {
954     print +(join ",", (AnyEvent::MP::Kernel::_resolve shift @ARGV)->recv), "\n";
955     },
956 root 1.1 );
957    
958 root 1.47 for my $attr (qw(
959     monitor_timeout connect_interval framing_format auth_offer
960     auth_accept autocork nodelay
961     )) {
962     $CMD{"set$attr"} = sub {
963     @ARGV >= 1
964     or die "$attr value is missing\n";
965    
966     $profile->{$attr} = shift @ARGV;
967     ++$cfg->{dirty};
968     };
969     $CMD{"del$attr"} = sub {
970     delete $profile->{$attr};
971     ++$cfg->{dirty};
972     };
973     }
974    
975 root 1.27 for (keys %CMD) {
976     $CMD{$1} = $CMD{$_} if /^set(.*)$/;
977     }
978    
979 root 1.1 sub docmd {
980     my $cmd = shift @ARGV;
981    
982     $CMD{$cmd}
983 root 1.23 or die "$cmd: no such aemp command (try perldoc aemp, or man aemp)";
984 root 1.1
985     $CMD{$cmd}();
986     }
987    
988     @ARGV
989 root 1.23 or die "Usage: aemp subcommand ... (try perldoc aemp, or man aemp)\n";
990 root 1.1
991 root 1.19 docmd while @ARGV;
992 root 1.1
993