[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 parent <name>            # specify a parent profile
   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 parent <name>

Sets the parent profile to use - values not specified in a profile will be
taken from the parent profile (even recursively, with the global default
config being the default parent). This is useful to configure profile
I<classes> and then to inherit from them for individual nodes.

Note that you can specify circular parent chains and even a parent for the
global configuration. Neither will do you any good, however.

Example: inherit all values not specified in the C<doomed> profile from
the C<server> profile.

   aemp profile doomed parent server

=item delparent

Removes the parent again from the profile, if any was set, so the profile
inherits directly from the global default config again.

=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.

If the name is omitted, show the global default config.

=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];
      ++$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};
   },
   parent => sub {
      @ARGV >= 1
         or die "profile name is missing\n";

      $profile->{parent} = shift @ARGV;
      ++$cfg->{dirty};
   },
   delparent => sub {
      delete $profile->{parent};
      ++$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;

      my $profile = AnyEvent::MP::Config::find_profile $name;

      # make it look nicer:
      delete $profile->{profile};
      delete $profile->{parent};

      print JSON::XS->new->pretty->encode ($profile);
   },
);

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