ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-MP/bin/aemp
Revision: 1.49
Committed: Thu Apr 8 01:51:58 2010 UTC (14 years, 2 months ago) by root
Branch: MAIN
CVS Tags: rel-1_29, rel-1_30
Changes since 1.48: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

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