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

# 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. 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
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 Generates a self-signed certificate and key, and sets it. This works
242 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 =over 4
269
270 =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 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
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 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
314 Note that the C<*>, C<*:*> or C<*:port> patterns are very useful here.
315
316 Example: bind on a ephemeral port on all local interfaces.
317
318 aemp setbinds "*"
319
320 Example: bind on a random port on all local interfaces.
321
322 aemp setbinds "*:*"
323
324 Example: resolve "doomed.mydomain" and try to bind on port C<4040> of all
325 IP addressess returned.
326
327 aep setbinds doomed.mydomain:4040
328
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 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 =over 4
362
363 =item setservices <initfunc>...
364
365 Sets or replaces the list of services, which must be specified as a
366 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
375 The algorithm to find the function is the same as used for C<<
376 L<AnyEvent::MP>::spawn >>.
377
378 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 =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 aemp profile server nodeid anon/ seeds doomed,10.0.0.2:5000 binds "*:*"
420
421 =item delprofile <name>
422
423 Deletes the profile of the given name.
424
425 =item setparent <name>
426
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 aemp profile doomed setparent server
439
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 =item showprofile <name>
446
447 Shows the values of the given profile, and only those, no inherited
448 values.
449
450 =item showconfig <name> <key value...>
451
452 Shows the I<effective> config, i.e. the values as used by a node started
453 with the given profile name. Any additional key-value pairs specified
454 augment the configuration, just as with C<configure>.
455
456 If all arguments are omitted, show the global default config.
457
458 =back
459
460 =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 =cut
531
532 use common::sense;
533
534 # should come before anything else, so all modules
535 # will be loaded on each restart
536 BEGIN {
537 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 if ($ARGV[0] eq "run") {
550 shift;
551
552 # d'oh
553 require AnyEvent::Watchdog;
554 # only now can we load additional modules
555
556 require AnyEvent;
557
558 require AnyEvent::Watchdog::Util;
559 AnyEvent::Watchdog::Util::autorestart (1);
560 AnyEvent::Watchdog::Util::heartbeat (300);
561
562 require AnyEvent::MP::Kernel;
563 AnyEvent::MP::Kernel::configure (@ARGV);
564
565 AnyEvent::detect () eq "AnyEvent::Impl::EV"
566 ? EV::loop ()
567 : AE::cv ()->recv;
568 }
569 }
570
571 use Carp ();
572
573 use JSON::XS;
574
575 use AnyEvent;
576 use AnyEvent::Util;
577
578 use AnyEvent::MP;
579 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 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 "<", "/dev/null",
598 ">" , \my $cert,
599 "3>", \my $key,
600 "2>", "/dev/null";
601
602 "$cert$key"
603 }
604
605 sub init {
606 configure profile => "aemp", nodeid => "anon/";
607 }
608
609 our $cfg = AnyEvent::MP::Config::config;
610 our $profile = $cfg;
611
612 sub trace {
613 my ($node) = @_;
614 my $cv = AE::cv;
615 my %seen;
616
617 my $to = AE::timer 15, 0, sub { exit 1 };
618
619 init;
620
621 my $reply = port {
622 my ($node, @neigh) = @_;
623
624 @neigh = grep $_ ne $NODE, @neigh;
625
626 print +(join " ", $node, @neigh), "\n";
627
628 for (@neigh) {
629 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 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 \= display a list of nodes
654 \=name switch to another node
655
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 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 die "$err @res" if length $err;
704
705 print +(substr JSON::XS->new->encode (\@res), 1, -1), "\n";
706 }
707
708 sub docmd;
709
710 our %CMD = (
711 snd => sub {
712 my $port = shift @ARGV;
713 init;
714
715 snd $port, @ARGV; @ARGV = ();
716
717 my $cv = AE::cv;
718 my $to = AE::timer 5, 0, sub { exit 1 };
719 mon $port, $cv;
720 my $reply = port sub { &$cv };
721 snd node_of $port, snd => $reply, "message sent successfully";
722
723 print join " ", $cv->recv, "\n";
724 },
725
726 cal => sub {
727 my $port = shift @ARGV;
728 init;
729
730 my $cv = AE::cv;
731 cal $port, @ARGV, sub { &$cv }; @ARGV = ();
732
733 print +(substr JSON::XS->new->encode ([$cv->recv]), 1, -1), "\n";
734 },
735
736 mon => sub {
737 my $port = shift @ARGV;
738 init;
739
740 mon $port, my $cv = AE::cv;
741 print join " ", $cv->recv, "\n";
742 },
743
744 eval => sub {
745 my $node = node_of shift @ARGV;
746 my $expr = join " ", @ARGV; @ARGV = ();
747 node_eval $node, $expr;
748 },
749
750 shell => \&shell,
751
752 trace => sub {
753 @ARGV >= 1
754 or die "node id missing\n";
755
756 trace shift @ARGV;
757 },
758 restart => sub {
759 my $node = node_of shift @ARGV;
760 node_eval $node, 'my $w; $w = AE::idle sub { '
761 . 'undef $w; '
762 . 'use AnyEvent::Watchdog::Util ();'
763 . 'AnyEvent::Watchdog::Util::restart'
764 . '}; ()';
765 },
766
767 setnodeid => sub {
768 @ARGV >= 1
769 or die "shared secret missing\n";
770
771 $profile->{nodeid} = shift @ARGV;
772 ++$cfg->{dirty};
773 },
774 delnodeid => sub {
775 delete $profile->{nodeid};
776 ++$cfg->{dirty};
777 },
778
779 setsecret => sub {
780 @ARGV >= 1
781 or die "shared secret missing\n";
782
783 $profile->{secret} = shift @ARGV;
784 ++$cfg->{dirty};
785 },
786 gensecret => sub {
787 $profile->{secret} = AnyEvent::MP::Kernel::alnumbits AnyEvent::MP::Kernel::nonce 64;
788 ++$cfg->{dirty};
789 },
790 delsecret => sub {
791 delete $profile->{secret};
792 ++$cfg->{dirty};
793 },
794
795 setcert => sub {
796 @ARGV >= 1
797 or die "key+certificate pem filename missing\n";
798
799 my $certfile = shift @ARGV;
800
801 open my $fh, "<", $certfile
802 or die "$certfile: $!";
803
804 local $/;
805 $profile->{cert} = <$fh>;
806 ++$cfg->{dirty};
807 },
808 gencert => sub {
809 $profile->{cert} = gen_cert;
810 ++$cfg->{dirty};
811 },
812 delcert => sub {
813 delete $profile->{cert};
814 ++$cfg->{dirty};
815 },
816
817 setbinds => sub {
818 @ARGV >= 1
819 or die "bind addresses missing\n";
820 my $list = shift @ARGV;
821 $profile->{binds} = ref $list ? $list : [split /,/, $list];
822 ++$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 setseeds => sub {
847 @ARGV >= 1
848 or die "seed addresses missing\n";
849 my $list = shift @ARGV;
850 $profile->{seeds} = ref $list ? $list : [split /,/, $list];
851 ++$cfg->{dirty};
852 },
853 delseeds => sub {
854 delete $profile->{seeds};
855 ++$cfg->{dirty};
856 },
857 addseed => sub {
858 @ARGV >= 1
859 or die "seed address missing\n";
860 my $seed = shift @ARGV;
861
862 @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
863 push @{ $profile->{seeds} }, $seed;
864 ++$cfg->{dirty};
865 },
866 delseed => sub {
867 @ARGV >= 1
868 or die "seed address missing\n";
869 my $seed = shift @ARGV;
870
871 @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
872 ++$cfg->{dirty};
873 },
874
875 setservices => sub {
876 @ARGV >= 1
877 or die "service specifications missing\n";
878 my $list = shift @ARGV;
879 $profile->{services} = ref $list ? $list : [split /,/, $list];
880 ++$cfg->{dirty};
881 },
882 delservices => sub {
883 delete $profile->{services};
884 ++$cfg->{dirty};
885 },
886 addservice => sub {
887 @ARGV >= 1
888 or die "service specification missing\n";
889 my $service = shift @ARGV;
890 push @{ $profile->{services} }, $service;
891 ++$cfg->{dirty};
892 },
893 delservice => sub {
894 @ARGV >= 1
895 or die "service specification missing\n";
896 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 ++$cfg->{dirty};
903 },
904
905 profile => sub {
906 @ARGV >= 1
907 or die "profile name is missing\n";
908 my $name = shift @ARGV;
909
910 $profile = $cfg->{profile}{$name} ||= {};
911 ++$cfg->{dirty};
912 },
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 ++$cfg->{dirty};
920 },
921 setparent => sub {
922 @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 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 my $profile = AnyEvent::MP::Config::find_profile $name, @ARGV;
943 @ARGV = ();
944
945 # make it look nicer:
946 delete $profile->{profile};
947 delete $profile->{parent};
948
949 print JSON::XS->new->pretty->encode ($profile);
950 },
951
952 # undocumented
953 _resolve => sub {
954 print +(join ",", (AnyEvent::MP::Kernel::_resolve shift @ARGV)->recv), "\n";
955 },
956 );
957
958 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 for (keys %CMD) {
976 $CMD{$1} = $CMD{$_} if /^set(.*)$/;
977 }
978
979 sub docmd {
980 my $cmd = shift @ARGV;
981
982 $CMD{$cmd}
983 or die "$cmd: no such aemp command (try perldoc aemp, or man aemp)";
984
985 $CMD{$cmd}();
986 }
987
988 @ARGV
989 or die "Usage: aemp subcommand ... (try perldoc aemp, or man aemp)\n";
990
991 docmd while @ARGV;
992
993