[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 binds 4040,4041 nodeid anon/

Please note that all C<setxxx> subcommands have an alias without the
C<set> prefix.

=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 { exit 1 };

   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 { exit 1 };
      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 { exit 1 };
      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 { exit 1 };
      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";
   },
);

for (keys %CMD) {
   $CMD{$1} = $CMD{$_} if /^set(.*)$/;
}

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.28
Committed:	Mon Aug 31 13:46:32 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_95
Changes since 1.27:	+5 -8 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 binds 4040,4041 nodeid anon/
76
77	Please note that all C<setxxx> subcommands have an alias without the
78	C<set> prefix.
79
80	=head2 RUNNING A NODE
81
82	This can be used to run a node - together with some services, this makes
83	it unnecesary to write any wrapper programs.
84
85	=over 4
86
87	=item run <profile> <...>
88
89	Runs a node by calling C<AnyEvent::MP::Kernel::configure> with the given
90	arguments. The node runs under L<AnyEvent::Watchdog>, can be restarted
91	(and autorestarted, see the L<AnyEvent::Watchdog> manual).
92
93	Care has been taken to load (almost) no modules other than
94	L<AnyEvent::Watchdog> and the modules it loads, so everything (including
95	the L<AnyEvent::MP> modules themselves) will be freshly loaded on restart,
96	which makes upgrading everything except the perl binary easy.
97
98	=back
99
100	=head2 PROTOCOL COMMANDS
101
102	These commands actually communicate with other nodes. They all use a node
103	profile name of C<aemp> (specifying a dfeault node ID of C<anon/> and a
104	binds list containing C<:> only).
105
106	They all use a timeout of five seconds, after which they give up.
107
108	=over 4
109
110	=item snd <port> <arguments...>
111
112	Simply send a message to the given port - where you get the port ID from
113	is your problem.
114
115	Exits after ensuring that the message has been delivered to its node.
116
117	Most useful to take avdantage of some undocumented functionality inside
118	nodes, such as node ports being able to call any method:
119
120	aemp snd doomed AnyEvent::Watchdog::restart 1
121
122	=item rpc <port> <arg...>
123
124	Like F<aemp snd>, but appends a local reply port to the message and waits
125	for a message to it.
126
127	Any return values will be JSON-encoded and printed separated by commas
128	(kind of like a JSON array without []-brackets).
129
130	Example: ask the (undocumented) time service of a node for it'S current
131	time.
132
133	aemp rpc mynode time
134
135	=item mon <port>
136
137	Monitors the port and exits when it's monitorign callback is called. Most
138	useful to monitor node ports.
139
140	Example: monitor some node.
141
142	aemp mon doomed
143
144	=item eval <node> <expr...>
145
146	Joins all remaining arguments into a string and evaluates it on the given
147	node. Return values are handled as with F<aemp rpc>.
148
149	Example: find the unix process ID of the node called posicks.
150
151	aemp eval posicks '$$'
152
153	=item trace <node>
154
155	Asks the given node for all currently connected nodes, then asks those
156	nodes for the same, thus tracing all node connections.
157
158	=cut
159
160	=head2 CONFIGURATION/NODE ID/SECRET/CERTIFICATE
161
162	These commands deal with rather basic settings, the node ID, the shared
163	secret and the TLS certificate.
164
165	=over 4
166
167	=item setnodeid <nodeid>
168
169	Set the node ID to the given string.
170
171	=item delnodeid
172
173	Removes the node ID again, which means it is inherited again from it's
174	parent profile, or stays unset.
175
176	=item gensecret
177
178	Generates a random shared secret and sets it. The shared secret is used to
179	authenticate nodes to each other when TLS is not required.
180
181	=item setsecret <secret>
182
183	Sets the shared secret tot he given string, which can be anything.
184
185	=item delsecret
186
187	Removes the shared secret again, which means it is inherited again from
188	it's parent profile, or stays unset.
189
190	=item gencert
191
192	Generates a self-signed certficate and key, and sets it. This works
193	similarly to a shared secret: when all nodes have it, TLS will be used to
194	authenticate and encrypt all traffic.
195
196	=item setcert <file>
197
198	Set a node certificate (and optionally any CA certificates) from the given
199	file. The file must contain the key, followed by the certificate, followed
200	by any CA certificates you want to trust, all in PEM format.
201
202	See L<AnyEvent::TLS> for some more details - this sets the C<cert> and
203	C<ca_cert> options.
204
205	=item delcert
206
207	Removes the certificate(s) again, which means it is inherited again from
208	it's parent profile, or stays unset.
209
210	=back
211
212	=head2 CONFIGURATION/SEEDS
213
214	To discover the network you have to specify some seed addresses, which are
215	basically C<host:port> pairs where you expect some long-running nodes. It
216	does no harm to have a node as its own seed (they will eventually be
217	ignored).
218
219	=item setseeds <host:port>,...
220
221	Sets or replaces the list of seeds, which must be specified as a
222	comma-separated list of C<host:port> pairs. The C<host> can be a hostname,
223	an IP address, or C<*> to signify all local host addresses. If the
224	C<:port> is omitted, then the default port of C<4040> is assumed.
225
226	An empty list is allowed.
227
228	Example: use C<doomed> with default port as only seednode.
229
230	aemp setseeds doomed
231
232	=item delseeds
233
234	Removes the seed list again, which means it is inherited again from it's
235	parent profile, or stays unset.
236
237	=item addseed <host:port>
238
239	Adds a single seed address.
240
241	=item delseed <host:port>
242
243	Deletes the given seed address, if it exists.
244
245	=back
246
247	=head2 CONFIGURATION/BINDS
248
249	To be able to be reached from other nodes, a node must I<bind> itself
250	to some listening socket(s). The list of these can either bs specified
251	manually, or AnyEvent::MP can guess them. Nodes without any binds are
252	possible to some extent.
253
254	=over 4
255
256	=item setbinds <host:port>,...
257
258	Sets the list of bind addresses explicitly - see the F<aemp setseeds>
259	command for the exact syntax. In addition, a value of C<0> for the port
260	means to use a dynamically-assigned port.
261
262	Note that the C<>, C<:> or C<:port> values are very useful here.
263
264	Example: bind on the default port (4040) on all local interfaces.
265
266	aemp setbinds "*"
267
268	Example: bind on a random port on all local interfaces.
269
270	aemp setbinds ":"
271
272	Example: resolve "doomed.mydomain" and try to bind on port C<4040> of all
273	IP addressess returned.
274
275	aep setbinds doomed.mydomain
276
277	=item delbinds
278
279	Removes the bind list again, which means it is inherited again from it's
280	parent profile, or stays unset.
281
282	=item addbind <host:port>
283
284	Adds a single bind address.
285
286	=item delbind <host:port>
287
288	Deletes the given bind address, if it exists.
289
290	=back
291
292	=head2 CONFIGURATION/SERVICES
293
294	Services are modules (or functions) that are automatically loaded (or
295	executed) when a node starts. They are especially useful when used in
296	conjunction with F<aemp run>, to configure which services a node should
297	run.
298
299	=over 4
300
301	=item setservices <initfunc>...
302
303	Sets or replaces the list of services, which must be specified as a
304	comma-separated list.
305
306	Each entry in the list is interpreted as either a module name to
307	load (when it ends with C<::>) or a function to call (all other
308	cases). The algorithm to find the function is the same as used for C<<
309	L<AnyEvent::MP>::spawn >>.
310
311	=item delservices
312
313	Removes the service list again, which means it is inherited again from
314	it's parent profile, or stays unset.
315
316	=item addservice <initfunc>
317
318	Adds a single service.
319
320	=item delservice <initfunc>
321
322	Deletes the given service, if it exists.
323
324	=back
325
326	=head2 CONFIGURATION/PROFILE MANAGEMENT
327
328	All the above configuration functions by default affect the I<global
329	default configuration>, which is basically used to augment every profile
330	and node configuration.
331
332	=over 4
333
334	=item profile <name> ...
335
336	This subcommand makes the following subcommands act only on a specific
337	named profile, instead of on the global default. The profile is created if
338	necessary.
339
340	Example: create a C<server> profile, give it a random node name, some seed
341	nodes and bind it on an unspecified port on all local interfaces. You
342	should add some services then and run the node...
343
344	aemp server setnodeid anon/ setseeds doomed,10.0.0.2:5000 setbinds ":"
345
346	=item delprofile <name>
347
348	Deletes the profile of the given name.
349
350	=item setparent <name>
351
352	Sets the parent profile to use - values not specified in a profile will be
353	taken from the parent profile (even recursively, with the global default
354	config being the default parent). This is useful to configure profile
355	I<classes> and then to inherit from them for individual nodes.
356
357	Note that you can specify circular parent chains and even a parent for the
358	global configuration. Neither will do you any good, however.
359
360	Example: inherit all values not specified in the C<doomed> profile from
361	the C<server> profile.
362
363	aemp profile doomed setparent server
364
365	=item delparent
366
367	Removes the parent again from the profile, if any was set, so the profile
368	inherits directly from the global default config again.
369
370	=item showprofile <name>
371
372	Shows the values of the given profile, and only those, no inherited
373	values.
374
375	=item showconfig <name> <key value...>
376
377	Shows the I<effective> config, i.e. the values as used by a node started
378	with the given profile name. Any additional key-value pairs specified
379	augment the configuration, just as with C<configure>.
380
381	If all arguments are omitted, show the global default config.
382
383	=back
384
385	=cut
386
387	use common::sense;
388
389	# should come before anything else, so all modules
390	# will be loaded on each restart
391	BEGIN {
392	if ($ARGV[0] eq "run") {
393	shift;
394
395	# d'oh
396	require AnyEvent::Watchdog;
397	# now we can load extra modules
398
399	AnyEvent::Watchdog::autorestart (1);
400	AnyEvent::Watchdog::heartbeat (300);
401
402	require AnyEvent;
403	require AnyEvent::MP::Kernel;
404	AnyEvent::MP::Kernel::configure (@ARGV);
405
406	AnyEvent::detect () eq "AnyEvent::Impl::EV"
407	? EV::loop ()
408	: AE::cv ()->recv;
409	}
410	}
411
412	use Carp ();
413
414	use JSON::XS;
415
416	use AnyEvent;
417	use AnyEvent::Util;
418
419	use AnyEvent::MP;
420	use AnyEvent::MP::Config;
421
422	sub my_run_cmd {
423	my ($cmd) = @_;
424
425	my $cv = &run_cmd;
426	my $status = $cv->recv;
427
428	$status
429	and die "@$cmd: command failed with exit status $status.";
430	}
431
432	sub gen_cert {
433	my_run_cmd [qw(openssl req
434	-new -nodes -x509 -days 3650
435	-newkey rsa:2048 -keyout /dev/fd/3
436	-batch -subj /CN=AnyEvent::MP
437	)],
438	"<", "/dev/null",
439	">" , \my $cert,
440	"3>", \my $key,
441	"2>", "/dev/null";
442
443	"$cert$key"
444	}
445
446	sub init {
447	configure profile => "aemp", nodeid => "anon/";
448	}
449
450	our $cfg = AnyEvent::MP::Config::config;
451	our $profile = $cfg;
452
453	sub trace {
454	my ($node) = @_;
455	my $cv = AE::cv;
456	my %seen;
457
458	my $to = AE::timer 15, 0, sub { exit 1 };
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 { exit 1 };
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 { exit 1 };
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 { exit 1 };
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	for (keys %CMD) {
734	$CMD{$1} = $CMD{$_} if /^set(.*)$/;
735	}
736
737	sub docmd {
738	my $cmd = shift @ARGV;
739
740	$CMD{$cmd}
741	or die "$cmd: no such aemp command (try perldoc aemp, or man aemp)";
742
743	$CMD{$cmd}();
744	}
745
746	@ARGV
747	or die "Usage: aemp subcommand ... (try perldoc aemp, or man aemp)\n";
748
749	docmd while @ARGV;
750
751