[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 configure_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 setparent <name>         # specify a parent profile
   aemp delparent                # clear parent again
   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::Kernel::configure> 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 C<aemp> (specifying a dfeault node ID of C<anon/> and a
binds list containing C<*:*> only).

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<*:*> 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 "*:*"

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 "*:*"

=item delprofile <name>

Deletes the profile of the given name.

=item setparent <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 setparent 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> <key value...>

Shows the I<effective> config, i.e. the values as used by a node started
with the given profile name. Any additional key-value pairs specified
augment the configuration, just as with C<configure>.

If all arguments are 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::Kernel;
      AnyEvent::MP::Kernel::configure (@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"
}

sub init {
   configure profile => "aemp", nodeid => "anon/";
}

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->();
   };

   init;

   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;
      init;

      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;
      init;

      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;
      init;

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

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

      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};
   },
   setparent => 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, @ARGV;
      @ARGV = ();

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

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

   # undocumented
   _resolve => sub {
      print +(join ",", (AnyEvent::MP::Kernel::_resolve shift @ARGV)->recv), "\n";
   },
);

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