[ViewVC] Contents of: cvs/AnyEvent-MP/bin/aemp

#!/opt/bin/perl

=head1 NAME

   aemp - AnyEvent:MP utility

=head1 SYNOPSIS

   aemp command args...

   # protocol commands
   aemp snd <port> <arg...>      # send a message
   aemp mon <port>               # wait till port is killed
   aemp rpc <port> <arg...>      # send message, append reply
   aemp eval <node> <expr...>    # evaluate expression
   aemp trace <nodeid>           # trace the network topology

   # run a node
   aemp run initialise_args...   # run a node

   # node configuration: node ID
   aemp setnodeid <nodeid>       # configure the real node id
   aemp delnodeid                # reset node id to default (= inherit)

   # node configuration: secret
   aemp gensecret                # generate a random shared secret
   aemp setsecret <secret>       # set the shared secret
   aemp delsecret                # remove the secret (= inherit)

   # node configuration: TLS
   aemp gencert                  # generate a random certificate
   aemp setcert <file>           # set a certificate (key.pem + certificate.pem)
   aemp delcert                  # remove certificate (= inherit)

   # node configuration: seed addresses for bootstrapping
   aemp setseeds <host:port>,... # set seeds
   aemp delseeds                 # clear all seeds (= inherit)
   aemp addseed <host:port>      # add a seed
   aemp delseed <host:port>      # remove seed

   # node configuration: bind addresses
   aemp setbinds <host:port>,... # set binds
   aemp delbinds                 # clear all binds (= inherit)
   aemp addbind <host:port>      # add a bind address
   aemp delbind <host:port>      # remove a bind address

   # node configuration: services
   aemp setservices initfunc,... # set service functions
   aemp delservices              # clear all services (= inherit)
   aemp addservice <initfunc>    # add an instance of a service
   aemp delservice <initfunc>    # delete one instance of a service

   # profile-specific configuration
   aemp profile <name> <command>... # apply command to profile only
   aemp delprofile <name>        # eradicate the named profile
   aemp showprofile <name>       # display given profile
   aemp showconfig <name>        # display effective config

=head1 DESCRIPTION

With aemp you can configure various aspects of AnyEvent::MP and its
protocol, send various messages and even run a node.

The F<aemp> utility works like F<cvs>, F<svn> or other commands: the first
argument defines which operation (subcommand) is requested, after which
arguments for this operation are expected. When a subcommand does not eat
all remaining arguments, the remaining arguments will again be interpreted
as subcommand and so on.

This means you can chain multiple commands, which is handy for profile
configuration, e.g.:

   aemp gensecret profile xyzzy setbinds 4040,4041 setnodeid anon/

=head2 RUNNING A NODE

This can be used to run a node - together with some services, this makes
it unnecesary to write any wrapper programs.

=over 4

=item run <profile> <...>

Runs a node by calling C<AnyEvent::MP::initialise_node> with the given
arguments. The node runs under L<AnyEvent::Watchdog>, can be restarted
(and autorestarted, see the L<AnyEvent::Watchdog> manual).

Care has been taken to load (almost) no modules other than
L<AnyEvent::Watchdog> and the modules it loads, so everything (including
the L<AnyEvent::MP> modules themselves) will be freshly loaded on restart,
which makes upgrading everything except the perl binary easy.

=back

=head2 PROTOCOL COMMANDS

These commands actually communicate with other nodes. They all use a node
profile name of L<anon/> currently.

They all use a timeout of five seconds, after which they give up.

=over 4

=item snd <port> <arguments...>

Simply send a message to the given port - where you get the port ID from
is your problem.

Exits after ensuring that the message has been delivered to its node.

Most useful to take avdantage of some undocumented functionality inside
nodes, such as node ports being able to call any method:

   aemp snd doomed AnyEvent::Watchdog::restart 1

=item rpc <port> <arg...>

Like F<aemp snd>, but appends a local reply port to the message and waits
for a message to it.

Any return values will be JSON-encoded and printed separated by commas
(kind of like a JSON array without []-brackets).

Example: ask the (undocumented) time service of a node for it'S current
time.

   aemp rpc mynode time

=item mon <port>

Monitors the port and exits when it's monitorign callback is called. Most
useful to monitor node ports.

Example: monitor some node.

   aemp mon doomed

=item eval <node> <expr...>

Joins all remaining arguments into a string and evaluates it on the given
node. Return values are handled as with F<aemp rpc>.

Example: find the unix process ID of the node called posicks.

   aemp eval posicks '$$'

=item trace <node>

Asks the given node for all currently connected nodes, then asks those
nodes for the same, thus tracing all node connections.

=cut

=head2 CONFIGURATION/NODE ID/SECRET/CERTIFICATE

These commands deal with rather basic settings, the node ID, the shared
secret and the TLS certificate.

=over 4

=item setnodeid <nodeid>

Set the node ID to the given string.

=item delnodeid

Removes the node ID again, which means it is inherited again from it's
parent profile, or stays unset.

=item gensecret

Generates a random shared secret and sets it. The shared secret is used to
authenticate nodes to each other when TLS is not required.

=item setsecret <secret>

Sets the shared secret tot he given string, which can be anything.

=item delsecret

Removes the shared secret again, which means it is inherited again from
it's parent profile, or stays unset.

=item gencert

Generates a self-signed certficate and key, and sets it. This works
similarly to a shared secret: when all nodes have it, TLS will be used to
authenticate and encrypt all traffic.

=item setcert <file>

Set a node certificate (and optionally any CA certificates) from the given
file. The file must contain the key, followed by the certificate, followed
by any CA certificates you want to trust, all in PEM format.

See L<AnyEvent::TLS> for some more details - this sets the C<cert> and
C<ca_cert> options.

=item delcert

Removes the certificate(s) again, which means it is inherited again from
it's parent profile, or stays unset.

=back

=head2 CONFIGURATION/SEEDS

To discover the network you have to specify some seed addresses, which are
basically C<host:port> pairs where you expect some long-running nodes. It
does no harm to have a node as its own seed (they will eventually be
ignored).

=item setseeds <host:port>,...

Sets or replaces the list of seeds, which must be specified as a
comma-separated list of C<host:port> pairs. The C<host> can be a hostname,
an IP address, or C<*> to signify all local host addresses. If the
C<:port> is omitted, then the default port of C<4040> is assumed.

An empty list is allowed.

Example: use C<doomed> with default port as only seednode.

   aemp setseeds doomed

=item delseeds

Removes the seed list again, which means it is inherited again from it's
parent profile, or stays unset.

=item addseed <host:port>

Adds a single seed address.

=item delseed <host:port>

Deletes the given seed address, if it exists.

=back

=head2 CONFIGURATION/BINDS

To be able to be reached from other nodes, a node must I<bind> itself
to some listening socket(s). The list of these can either bs specified
manually, or AnyEvent::MP can guess them. Nodes without any binds are
possible to some extent.

=over 4

=item setbinds <host:port>,...

Sets the list of bind addresses explicitly - see the F<aemp setseeds>
command for the exact syntax. In addition, a value of C<0> for the port
means to use a dynamically-assigned port.

Note that the C<*>, C<*:0> or C<*:port> values are very useful here.

Example: bind on the default port (4040) on all local interfaces.

   aemp setbinds "*"

Example: bind on a random port on all local interfaces.

   aemp setbinds "*:0"

Example: resolve "doomed.mydomain" and try to bind on port C<4040> of all
IP addressess returned.

   aep setbinds doomed.mydomain

=item delbinds

Removes the bind list again, which means it is inherited again from it's
parent profile, or stays unset.

=item addbind <host:port>

Adds a single bind address.

=item delbind <host:port>

Deletes the given bind address, if it exists.

=back

=head2 CONFIGURATION/SERVICES

Services are modules (or functions) that are automatically loaded (or
executed) when a node starts. They are especially useful when used in
conjunction with F<aemp run>, to configure which services a node should
run.

=over 4

=item setservices <initfunc>...

Sets or replaces the list of services, which must be specified as a
comma-separated list.

Each entry in the list is interpreted as either a module name to
load (when it ends with C<::>) or a function to call (all other
cases). The algorithm to find the function is the same as used for C<<
L<AnyEvent::MP>::spawn >>.

=item delservices

Removes the service list again, which means it is inherited again from
it's parent profile, or stays unset.

=item addservice <initfunc>

Adds a single service.

=item delservice <initfunc>

Deletes the given service, if it exists.

=back

=head2 CONFIGURATION/PROFILE MANAGEMENT

All the above configuration functions by default affect the I<global
default configuration>, which is basically used to augment every profile
and node configuration.

=over 4

=item profile <name> ...

This subcommand makes the following subcommands act only on a specific
named profile, instead of on the global default. The profile is created if
necessary.

Example: create a C<server> profile, give it a random node name, some seed
nodes and bind it on an unspecified port on all local interfaces. You
should add some services then and run the node...

   aemp server setnodeid anon/ setseeds doomed,10.0.0.2:5000 setbinds "*:0"

=item delprofile <name>

Deletes the profile of the given name.

=item showprofile <name>

Shows the values of the given profile, and only those, no inherited
values.

=item showconfig <name>

Shows the I<effective> config, i.e. the values as used by a node started with the given profile name.

=back

=cut

use common::sense;

# should come before anything else, so all modules
# will be loaded on each restart
BEGIN {
   if ($ARGV[0] eq "run") {
      shift;

      # d'oh
      require AnyEvent::Watchdog;
      # now we can load extra modules

      AnyEvent::Watchdog::autorestart (1);
      AnyEvent::Watchdog::heartbeat (300);

      require AnyEvent;
      require AnyEvent::MP;
      AnyEvent::MP::initialise_node (@ARGV);

      AnyEvent::detect () eq "AnyEvent::Impl::EV"
         ? EV::loop ()
         : AE::cv ()->recv;
   }
}

use Carp ();

use JSON::XS;

use AnyEvent;
use AnyEvent::Util;

use AnyEvent::MP;
use AnyEvent::MP::Config;

sub my_run_cmd {
   my ($cmd) = @_;

   my $cv = &run_cmd;
   my $status = $cv->recv;

   $status
      and die "@$cmd: command failed with exit status $status.";
}

sub gen_cert {
   my_run_cmd [qw(openssl req 
                     -new -nodes -x509 -days 3650
                     -newkey rsa:2048 -keyout /dev/fd/3
                     -batch -subj /CN=AnyEvent::MP
              )],
      "<", "/dev/null",
      ">" , \my $cert,
      "3>", \my $key,
      "2>", "/dev/null";

   "$cert$key"
}

our $cfg     = AnyEvent::MP::Config::config;
our $profile = $cfg;

sub trace {
   my ($node) = @_;
   my $cv = AE::cv;
   my %seen;

   my $to = AE::timer 15, 0, sub {
      warn "timeout\n";
      $cv->();
   };

   initialise_node "anon/";

   my $reply = port {
      my ($node, @neigh) = @_;

      @neigh = grep $_ ne $NODE, @neigh;

      print +(join " ", $node, @neigh), "\n";

      for (@neigh) {
         unless ($seen{$_}++) {
            $cv->begin;
            snd $_, up_nodes => $SELF => $_;
         }
      }

      $cv->end;
   };

   $cv->begin;
   snd $reply, seed => $node;

   $cv->recv;
}

sub docmd;

our %CMD = (
   snd => sub {
      my $port = shift @ARGV;
      initialise_node "anon/";

      snd $port, @ARGV; @ARGV = ();

      my $cv = AE::cv;
      my $to = AE::timer 5, 0, sub { $cv->("timeout") };
      mon $port, $cv;
      my $reply = port sub { &$cv };
      snd node_of $port, snd => $reply, "message sent successfully";

      print join " ", $cv->recv, "\n";
   },

   rpc => sub {
      my $port = shift @ARGV;
      initialise_node "anon/";

      my $cv = AE::cv;
      my $to = AE::timer 5, 0, sub { $cv->("timeout") };
      snd $port, @ARGV, port { &$cv }; @ARGV = ();
      mon $port, $cv;

      print +(substr JSON::XS->new->encode ([$cv->recv]), 1, -1), "\n";
   },

   mon => sub {
      my $port = shift @ARGV;
      initialise_node "anon/";

      mon $port, my $cv = AE::cv;
      print join " ", $cv->recv, "\n";
   },

   eval => sub {
      my $node = node_of shift @ARGV;
      my $expr = join " ", @ARGV; @ARGV = ();
      initialise_node "anon/";

      my $cv = AE::cv;
      my $to = AE::timer 5, 0, sub { $cv->("timeout") };
      AnyEvent::MP::Kernel::eval_on $node, $expr, port { &$cv };
      mon $node, $cv;

      my ($err, @res) = $cv->recv;

      die $err if length $err;

      print +(substr JSON::XS->new->encode (\@res), 1, -1), "\n";
   },

   trace => sub {
      @ARGV >= 1
         or die "node id missing\n";

      trace shift @ARGV;
   },

   setnodeid => sub {
      @ARGV >= 1
         or die "shared secret missing\n";

      $profile->{nodeid} = shift @ARGV;
      ++$cfg->{dirty};
   },
   delnodeid => sub {
      delete $profile->{nodeid};
      ++$cfg->{dirty};
   },

   setsecret => sub {
      @ARGV >= 1
         or die "shared secret missing\n";

      $profile->{secret} = shift @ARGV;
      ++$cfg->{dirty};
   },
   gensecret => sub {
      $profile->{secret} = AnyEvent::MP::Kernel::alnumbits AnyEvent::MP::Kernel::nonce 64;
      ++$cfg->{dirty};
   },
   delsecret => sub {
      delete $profile->{secret};
      ++$cfg->{dirty};
   },

   setcert => sub {
      @ARGV >= 1
         or die "key+certificate pem filename missing\n";

      open my $fh, "<", $ARGV[0]
         or die "$ARGV[0]: $!";

      local $/;
      $profile->{cert} = <$fh>;
      ++$cfg->{dirty};
   },
   gencert => sub {
      $profile->{cert} = gen_cert;
      ++$cfg->{dirty};
   },
   delcert => sub {
      delete $profile->{cert};
      ++$cfg->{dirty};
   },

   setbinds => sub {
      @ARGV >= 1
         or die "bind addresses missing\n";
      $profile->{binds} = [split /,/, shift @ARGV];
      ++$cfg->{dirty};
   },
   delbinds => sub {
      delete $profile->{binds};
      ++$cfg->{dirty};
   },
   addbind => sub {
      @ARGV >= 1
         or die "bind address missing\n";
      my $bind = shift @ARGV;

      @{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
      push @{ $profile->{binds} }, $bind;
      ++$cfg->{dirty};
   },
   delbind => sub {
      @ARGV >= 1
         or die "bind address missing\n";
      my $bind = shift @ARGV;

      @{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
      ++$cfg->{dirty};
   },

   setseeds => sub {
      @ARGV >= 1
         or die "seed addresses missing\n";
      $profile->{seeds} = [split /,/, shift @ARGV];
      ++$cfg->{dirty};
   },
   delseeds => sub {
      delete $profile->{seeds};
      ++$cfg->{dirty};
   },
   addseed => sub {
      @ARGV >= 1
         or die "seed address missing\n";
      my $seed = shift @ARGV;

      @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
      push @{ $profile->{seeds} }, $seed;
      ++$cfg->{dirty};
   },
   delseed => sub {
      @ARGV >= 1
         or die "seed address missing\n";
      my $seed = shift @ARGV;

      @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
      ++$cfg->{dirty};
   },

   setservices => sub {
      @ARGV >= 1
         or die "service specifications missing\n";
      $profile->{services} = [split /,/, shift @ARGV];
      @ARGV = ();
      ++$cfg->{dirty};
   },
   delservices => sub {
      delete $profile->{services};
      ++$cfg->{dirty};
   },
   addservice => sub {
      @ARGV >= 1
         or die "service specification missing\n";
      my $service = shift @ARGV;
      push @{ $profile->{services} }, $service;
      ++$cfg->{dirty};
   },
   delservice => sub {
      @ARGV >= 1
         or die "service specification missing\n";
      my $service = shift @ARGV;
      for (0 .. $#{ $profile->{services} }) {
         next unless $profile->{services}[$_] eq $service;
         splice @{ $profile->{services} }, $_, 1;
         last;
      }
      ++$cfg->{dirty};
   },

   profile => sub {
      @ARGV >= 1
         or die "profile name is missing\n";
      my $name = shift @ARGV;

      $profile = $cfg->{profile}{$name} ||= {};
      ++$cfg->{dirty};
   },
   delprofile => sub {
      @ARGV >= 1
         or die "profile name is missing\n";
      my $name = shift @ARGV;

      delete $cfg->{profile}{$name};
      ++$cfg->{dirty};
   },
   showprofile => sub {
      @ARGV >= 1
         or die "profile name is missing\n";
      my $name = shift @ARGV;

      print JSON::XS->new->pretty->encode ($cfg->{profile}{$name} || {});
   },
   showconfig => sub {
      my $name = @ARGV ? shift @ARGV : AnyEvent::MP::Kernel::_nodename;

      print JSON::XS->new->pretty->encode (AnyEvent::MP::Config::find_profile $name);
   },
);

sub docmd {
   my $cmd = shift @ARGV;

   $CMD{$cmd}
      or die "$cmd: no such aemp command (try perldoc aemp, or man aemp)";

   $CMD{$cmd}();
}

@ARGV
   or die "Usage: aemp subcommand ... (try perldoc aemp, or man aemp)\n";

docmd while @ARGV;


Revision:	1.23
Committed:	Sun Aug 30 18:15:49 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.22:	+295 -4 lines
Log Message:	* empty log message *
#	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 rpc <port> <arg...> # send message, append reply
15	aemp eval <node> <expr...> # evaluate expression
16	aemp trace <nodeid> # trace the network topology
17
18	# run a node
19	aemp run initialise_args... # run a node
20
21	# node configuration: node ID
22	aemp setnodeid <nodeid> # configure the real node id
23	aemp delnodeid # reset node id to default (= inherit)
24
25	# node configuration: secret
26	aemp gensecret # generate a random shared secret
27	aemp setsecret <secret> # set the shared secret
28	aemp delsecret # remove the secret (= inherit)
29
30	# node configuration: TLS
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-specific configuration
54	aemp profile <name> <command>... # apply command to profile only
55	aemp delprofile <name> # eradicate the named profile
56	aemp showprofile <name> # display given profile
57	aemp showconfig <name> # display effective config
58
59	=head1 DESCRIPTION
60
61	With aemp you can configure various aspects of AnyEvent::MP and its
62	protocol, send various messages and even run a node.
63
64	The F<aemp> utility works like F<cvs>, F<svn> or other commands: the first
65	argument defines which operation (subcommand) is requested, after which
66	arguments for this operation are expected. When a subcommand does not eat
67	all remaining arguments, the remaining arguments will again be interpreted
68	as subcommand and so on.
69
70	This means you can chain multiple commands, which is handy for profile
71	configuration, e.g.:
72
73	aemp gensecret profile xyzzy setbinds 4040,4041 setnodeid anon/
74
75	=head2 RUNNING A NODE
76
77	This can be used to run a node - together with some services, this makes
78	it unnecesary to write any wrapper programs.
79
80	=over 4
81
82	=item run <profile> <...>
83
84	Runs a node by calling C<AnyEvent::MP::initialise_node> with the given
85	arguments. The node runs under L<AnyEvent::Watchdog>, can be restarted
86	(and autorestarted, see the L<AnyEvent::Watchdog> manual).
87
88	Care has been taken to load (almost) no modules other than
89	L<AnyEvent::Watchdog> and the modules it loads, so everything (including
90	the L<AnyEvent::MP> modules themselves) will be freshly loaded on restart,
91	which makes upgrading everything except the perl binary easy.
92
93	=back
94
95	=head2 PROTOCOL COMMANDS
96
97	These commands actually communicate with other nodes. They all use a node
98	profile name of L<anon/> currently.
99
100	They all use a timeout of five seconds, after which they give up.
101
102	=over 4
103
104	=item snd <port> <arguments...>
105
106	Simply send a message to the given port - where you get the port ID from
107	is your problem.
108
109	Exits after ensuring that the message has been delivered to its node.
110
111	Most useful to take avdantage of some undocumented functionality inside
112	nodes, such as node ports being able to call any method:
113
114	aemp snd doomed AnyEvent::Watchdog::restart 1
115
116	=item rpc <port> <arg...>
117
118	Like F<aemp snd>, but appends a local reply port to the message and waits
119	for a message to it.
120
121	Any return values will be JSON-encoded and printed separated by commas
122	(kind of like a JSON array without []-brackets).
123
124	Example: ask the (undocumented) time service of a node for it'S current
125	time.
126
127	aemp rpc mynode time
128
129	=item mon <port>
130
131	Monitors the port and exits when it's monitorign callback is called. Most
132	useful to monitor node ports.
133
134	Example: monitor some node.
135
136	aemp mon doomed
137
138	=item eval <node> <expr...>
139
140	Joins all remaining arguments into a string and evaluates it on the given
141	node. Return values are handled as with F<aemp rpc>.
142
143	Example: find the unix process ID of the node called posicks.
144
145	aemp eval posicks '$$'
146
147	=item trace <node>
148
149	Asks the given node for all currently connected nodes, then asks those
150	nodes for the same, thus tracing all node connections.
151
152	=cut
153
154	=head2 CONFIGURATION/NODE ID/SECRET/CERTIFICATE
155
156	These commands deal with rather basic settings, the node ID, the shared
157	secret and the TLS certificate.
158
159	=over 4
160
161	=item setnodeid <nodeid>
162
163	Set the node ID to the given string.
164
165	=item delnodeid
166
167	Removes the node ID again, which means it is inherited again from it's
168	parent profile, or stays unset.
169
170	=item gensecret
171
172	Generates a random shared secret and sets it. The shared secret is used to
173	authenticate nodes to each other when TLS is not required.
174
175	=item setsecret <secret>
176
177	Sets the shared secret tot he given string, which can be anything.
178
179	=item delsecret
180
181	Removes the shared secret again, which means it is inherited again from
182	it's parent profile, or stays unset.
183
184	=item gencert
185
186	Generates a self-signed certficate and key, and sets it. This works
187	similarly to a shared secret: when all nodes have it, TLS will be used to
188	authenticate and encrypt all traffic.
189
190	=item setcert <file>
191
192	Set a node certificate (and optionally any CA certificates) from the given
193	file. The file must contain the key, followed by the certificate, followed
194	by any CA certificates you want to trust, all in PEM format.
195
196	See L<AnyEvent::TLS> for some more details - this sets the C<cert> and
197	C<ca_cert> options.
198
199	=item delcert
200
201	Removes the certificate(s) again, which means it is inherited again from
202	it's parent profile, or stays unset.
203
204	=back
205
206	=head2 CONFIGURATION/SEEDS
207
208	To discover the network you have to specify some seed addresses, which are
209	basically C<host:port> pairs where you expect some long-running nodes. It
210	does no harm to have a node as its own seed (they will eventually be
211	ignored).
212
213	=item setseeds <host:port>,...
214
215	Sets or replaces the list of seeds, which must be specified as a
216	comma-separated list of C<host:port> pairs. The C<host> can be a hostname,
217	an IP address, or C<*> to signify all local host addresses. If the
218	C<:port> is omitted, then the default port of C<4040> is assumed.
219
220	An empty list is allowed.
221
222	Example: use C<doomed> with default port as only seednode.
223
224	aemp setseeds doomed
225
226	=item delseeds
227
228	Removes the seed list again, which means it is inherited again from it's
229	parent profile, or stays unset.
230
231	=item addseed <host:port>
232
233	Adds a single seed address.
234
235	=item delseed <host:port>
236
237	Deletes the given seed address, if it exists.
238
239	=back
240
241	=head2 CONFIGURATION/BINDS
242
243	To be able to be reached from other nodes, a node must I<bind> itself
244	to some listening socket(s). The list of these can either bs specified
245	manually, or AnyEvent::MP can guess them. Nodes without any binds are
246	possible to some extent.
247
248	=over 4
249
250	=item setbinds <host:port>,...
251
252	Sets the list of bind addresses explicitly - see the F<aemp setseeds>
253	command for the exact syntax. In addition, a value of C<0> for the port
254	means to use a dynamically-assigned port.
255
256	Note that the C<>, C<:0> or C<*:port> values are very useful here.
257
258	Example: bind on the default port (4040) on all local interfaces.
259
260	aemp setbinds "*"
261
262	Example: bind on a random port on all local interfaces.
263
264	aemp setbinds "*:0"
265
266	Example: resolve "doomed.mydomain" and try to bind on port C<4040> of all
267	IP addressess returned.
268
269	aep setbinds doomed.mydomain
270
271	=item delbinds
272
273	Removes the bind list again, which means it is inherited again from it's
274	parent profile, or stays unset.
275
276	=item addbind <host:port>
277
278	Adds a single bind address.
279
280	=item delbind <host:port>
281
282	Deletes the given bind address, if it exists.
283
284	=back
285
286	=head2 CONFIGURATION/SERVICES
287
288	Services are modules (or functions) that are automatically loaded (or
289	executed) when a node starts. They are especially useful when used in
290	conjunction with F<aemp run>, to configure which services a node should
291	run.
292
293	=over 4
294
295	=item setservices <initfunc>...
296
297	Sets or replaces the list of services, which must be specified as a
298	comma-separated list.
299
300	Each entry in the list is interpreted as either a module name to
301	load (when it ends with C<::>) or a function to call (all other
302	cases). The algorithm to find the function is the same as used for C<<
303	L<AnyEvent::MP>::spawn >>.
304
305	=item delservices
306
307	Removes the service list again, which means it is inherited again from
308	it's parent profile, or stays unset.
309
310	=item addservice <initfunc>
311
312	Adds a single service.
313
314	=item delservice <initfunc>
315
316	Deletes the given service, if it exists.
317
318	=back
319
320	=head2 CONFIGURATION/PROFILE MANAGEMENT
321
322	All the above configuration functions by default affect the I<global
323	default configuration>, which is basically used to augment every profile
324	and node configuration.
325
326	=over 4
327
328	=item profile <name> ...
329
330	This subcommand makes the following subcommands act only on a specific
331	named profile, instead of on the global default. The profile is created if
332	necessary.
333
334	Example: create a C<server> profile, give it a random node name, some seed
335	nodes and bind it on an unspecified port on all local interfaces. You
336	should add some services then and run the node...
337
338	aemp server setnodeid anon/ setseeds doomed,10.0.0.2:5000 setbinds "*:0"
339
340	=item delprofile <name>
341
342	Deletes the profile of the given name.
343
344	=item showprofile <name>
345
346	Shows the values of the given profile, and only those, no inherited
347	values.
348
349	=item showconfig <name>
350
351	Shows the I<effective> config, i.e. the values as used by a node started with the given profile name.
352
353	=back
354
355	=cut
356
357	use common::sense;
358
359	# should come before anything else, so all modules
360	# will be loaded on each restart
361	BEGIN {
362	if ($ARGV[0] eq "run") {
363	shift;
364
365	# d'oh
366	require AnyEvent::Watchdog;
367	# now we can load extra modules
368
369	AnyEvent::Watchdog::autorestart (1);
370	AnyEvent::Watchdog::heartbeat (300);
371
372	require AnyEvent;
373	require AnyEvent::MP;
374	AnyEvent::MP::initialise_node (@ARGV);
375
376	AnyEvent::detect () eq "AnyEvent::Impl::EV"
377	? EV::loop ()
378	: AE::cv ()->recv;
379	}
380	}
381
382	use Carp ();
383
384	use JSON::XS;
385
386	use AnyEvent;
387	use AnyEvent::Util;
388
389	use AnyEvent::MP;
390	use AnyEvent::MP::Config;
391
392	sub my_run_cmd {
393	my ($cmd) = @_;
394
395	my $cv = &run_cmd;
396	my $status = $cv->recv;
397
398	$status
399	and die "@$cmd: command failed with exit status $status.";
400	}
401
402	sub gen_cert {
403	my_run_cmd [qw(openssl req
404	-new -nodes -x509 -days 3650
405	-newkey rsa:2048 -keyout /dev/fd/3
406	-batch -subj /CN=AnyEvent::MP
407	)],
408	"<", "/dev/null",
409	">" , \my $cert,
410	"3>", \my $key,
411	"2>", "/dev/null";
412
413	"$cert$key"
414	}
415
416	our $cfg = AnyEvent::MP::Config::config;
417	our $profile = $cfg;
418
419	sub trace {
420	my ($node) = @_;
421	my $cv = AE::cv;
422	my %seen;
423
424	my $to = AE::timer 15, 0, sub {
425	warn "timeout\n";
426	$cv->();
427	};
428
429	initialise_node "anon/";
430
431	my $reply = port {
432	my ($node, @neigh) = @_;
433
434	@neigh = grep $_ ne $NODE, @neigh;
435
436	print +(join " ", $node, @neigh), "\n";
437
438	for (@neigh) {
439	unless ($seen{$_}++) {
440	$cv->begin;
441	snd $_, up_nodes => $SELF => $_;
442	}
443	}
444
445	$cv->end;
446	};
447
448	$cv->begin;
449	snd $reply, seed => $node;
450
451	$cv->recv;
452	}
453
454	sub docmd;
455
456	our %CMD = (
457	snd => sub {
458	my $port = shift @ARGV;
459	initialise_node "anon/";
460
461	snd $port, @ARGV; @ARGV = ();
462
463	my $cv = AE::cv;
464	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
465	mon $port, $cv;
466	my $reply = port sub { &$cv };
467	snd node_of $port, snd => $reply, "message sent successfully";
468
469	print join " ", $cv->recv, "\n";
470	},
471
472	rpc => sub {
473	my $port = shift @ARGV;
474	initialise_node "anon/";
475
476	my $cv = AE::cv;
477	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
478	snd $port, @ARGV, port { &$cv }; @ARGV = ();
479	mon $port, $cv;
480
481	print +(substr JSON::XS->new->encode ([$cv->recv]), 1, -1), "\n";
482	},
483
484	mon => sub {
485	my $port = shift @ARGV;
486	initialise_node "anon/";
487
488	mon $port, my $cv = AE::cv;
489	print join " ", $cv->recv, "\n";
490	},
491
492	eval => sub {
493	my $node = node_of shift @ARGV;
494	my $expr = join " ", @ARGV; @ARGV = ();
495	initialise_node "anon/";
496
497	my $cv = AE::cv;
498	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
499	AnyEvent::MP::Kernel::eval_on $node, $expr, port { &$cv };
500	mon $node, $cv;
501
502	my ($err, @res) = $cv->recv;
503
504	die $err if length $err;
505
506	print +(substr JSON::XS->new->encode (\@res), 1, -1), "\n";
507	},
508
509	trace => sub {
510	@ARGV >= 1
511	or die "node id missing\n";
512
513	trace shift @ARGV;
514	},
515
516	setnodeid => sub {
517	@ARGV >= 1
518	or die "shared secret missing\n";
519
520	$profile->{nodeid} = shift @ARGV;
521	++$cfg->{dirty};
522	},
523	delnodeid => sub {
524	delete $profile->{nodeid};
525	++$cfg->{dirty};
526	},
527
528	setsecret => sub {
529	@ARGV >= 1
530	or die "shared secret missing\n";
531
532	$profile->{secret} = shift @ARGV;
533	++$cfg->{dirty};
534	},
535	gensecret => sub {
536	$profile->{secret} = AnyEvent::MP::Kernel::alnumbits AnyEvent::MP::Kernel::nonce 64;
537	++$cfg->{dirty};
538	},
539	delsecret => sub {
540	delete $profile->{secret};
541	++$cfg->{dirty};
542	},
543
544	setcert => sub {
545	@ARGV >= 1
546	or die "key+certificate pem filename missing\n";
547
548	open my $fh, "<", $ARGV[0]
549	or die "$ARGV[0]: $!";
550
551	local $/;
552	$profile->{cert} = <$fh>;
553	++$cfg->{dirty};
554	},
555	gencert => sub {
556	$profile->{cert} = gen_cert;
557	++$cfg->{dirty};
558	},
559	delcert => sub {
560	delete $profile->{cert};
561	++$cfg->{dirty};
562	},
563
564	setbinds => sub {
565	@ARGV >= 1
566	or die "bind addresses missing\n";
567	$profile->{binds} = [split /,/, shift @ARGV];
568	++$cfg->{dirty};
569	},
570	delbinds => sub {
571	delete $profile->{binds};
572	++$cfg->{dirty};
573	},
574	addbind => sub {
575	@ARGV >= 1
576	or die "bind address missing\n";
577	my $bind = shift @ARGV;
578
579	@{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
580	push @{ $profile->{binds} }, $bind;
581	++$cfg->{dirty};
582	},
583	delbind => sub {
584	@ARGV >= 1
585	or die "bind address missing\n";
586	my $bind = shift @ARGV;
587
588	@{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
589	++$cfg->{dirty};
590	},
591
592	setseeds => sub {
593	@ARGV >= 1
594	or die "seed addresses missing\n";
595	$profile->{seeds} = [split /,/, shift @ARGV];
596	++$cfg->{dirty};
597	},
598	delseeds => sub {
599	delete $profile->{seeds};
600	++$cfg->{dirty};
601	},
602	addseed => sub {
603	@ARGV >= 1
604	or die "seed address missing\n";
605	my $seed = shift @ARGV;
606
607	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
608	push @{ $profile->{seeds} }, $seed;
609	++$cfg->{dirty};
610	},
611	delseed => sub {
612	@ARGV >= 1
613	or die "seed address missing\n";
614	my $seed = shift @ARGV;
615
616	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
617	++$cfg->{dirty};
618	},
619
620	setservices => sub {
621	@ARGV >= 1
622	or die "service specifications missing\n";
623	$profile->{services} = [split /,/, shift @ARGV];
624	@ARGV = ();
625	++$cfg->{dirty};
626	},
627	delservices => sub {
628	delete $profile->{services};
629	++$cfg->{dirty};
630	},
631	addservice => sub {
632	@ARGV >= 1
633	or die "service specification missing\n";
634	my $service = shift @ARGV;
635	push @{ $profile->{services} }, $service;
636	++$cfg->{dirty};
637	},
638	delservice => sub {
639	@ARGV >= 1
640	or die "service specification missing\n";
641	my $service = shift @ARGV;
642	for (0 .. $#{ $profile->{services} }) {
643	next unless $profile->{services}[$_] eq $service;
644	splice @{ $profile->{services} }, $_, 1;
645	last;
646	}
647	++$cfg->{dirty};
648	},
649
650	profile => sub {
651	@ARGV >= 1
652	or die "profile name is missing\n";
653	my $name = shift @ARGV;
654
655	$profile = $cfg->{profile}{$name} \|\|= {};
656	++$cfg->{dirty};
657	},
658	delprofile => sub {
659	@ARGV >= 1
660	or die "profile name is missing\n";
661	my $name = shift @ARGV;
662
663	delete $cfg->{profile}{$name};
664	++$cfg->{dirty};
665	},
666	showprofile => sub {
667	@ARGV >= 1
668	or die "profile name is missing\n";
669	my $name = shift @ARGV;
670
671	print JSON::XS->new->pretty->encode ($cfg->{profile}{$name} \|\| {});
672	},
673	showconfig => sub {
674	my $name = @ARGV ? shift @ARGV : AnyEvent::MP::Kernel::_nodename;
675
676	print JSON::XS->new->pretty->encode (AnyEvent::MP::Config::find_profile $name);
677	},
678	);
679
680	sub docmd {
681	my $cmd = shift @ARGV;
682
683	$CMD{$cmd}
684	or die "$cmd: no such aemp command (try perldoc aemp, or man aemp)";
685
686	$CMD{$cmd}();
687	}
688
689	@ARGV
690	or die "Usage: aemp subcommand ... (try perldoc aemp, or man aemp)\n";
691
692	docmd while @ARGV;
693
694