[ViewVC] Annotation 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 *
#	User	Rev	Content
1	root	1.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	root	1.19	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	root	1.22	aemp trace <nodeid> # trace the network topology
17	root	1.8
18			# run a node
19	root	1.19	aemp run initialise_args... # run a node
20	root	1.8
21	root	1.23	# node configuration: node ID
22	root	1.19	aemp setnodeid <nodeid> # configure the real node id
23			aemp delnodeid # reset node id to default (= inherit)
24	root	1.1
25			# node configuration: secret
26	root	1.19	aemp gensecret # generate a random shared secret
27			aemp setsecret <secret> # set the shared secret
28			aemp delsecret # remove the secret (= inherit)
29	root	1.1
30			# node configuration: TLS
31	root	1.19	aemp gencert # generate a random certificate
32			aemp setcert <file> # set a certificate (key.pem + certificate.pem)
33			aemp delcert # remove certificate (= inherit)
34	root	1.8
35	root	1.17	# node configuration: seed addresses for bootstrapping
36	root	1.19	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	root	1.17
41			# node configuration: bind addresses
42	root	1.19	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	root	1.8
47			# node configuration: services
48	root	1.19	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	root	1.6
53	root	1.10	# profile-specific configuration
54			aemp profile <name> <command>... # apply command to profile only
55	root	1.24	aemp parent <name> # specify a parent profile
56	root	1.19	aemp delprofile <name> # eradicate the named profile
57			aemp showprofile <name> # display given profile
58			aemp showconfig <name> # display effective config
59	root	1.10
60	root	1.1	=head1 DESCRIPTION
61
62	root	1.8	With aemp you can configure various aspects of AnyEvent::MP and its
63	root	1.22	protocol, send various messages and even run a node.
64	root	1.1
65	root	1.23	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	root	1.24	=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	root	1.23	=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	root	1.24	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	root	1.23
377			=back
378
379	root	1.1	=cut
380
381			use common::sense;
382
383	root	1.19	# should come before anything else, so all modules
384			# will be loaded on each restart
385	root	1.22	BEGIN {
386	root	1.8	if ($ARGV[0] eq "run") {
387			shift;
388
389	root	1.13	# d'oh
390	root	1.22	require AnyEvent::Watchdog;
391	root	1.19	# now we can load extra modules
392
393	root	1.22	AnyEvent::Watchdog::autorestart (1);
394			AnyEvent::Watchdog::heartbeat (300);
395	root	1.13
396	root	1.8	require AnyEvent;
397			require AnyEvent::MP;
398			AnyEvent::MP::initialise_node (@ARGV);
399
400	root	1.16	AnyEvent::detect () eq "AnyEvent::Impl::EV"
401	root	1.8	? EV::loop ()
402			: AE::cv ()->recv;
403			}
404	root	1.22	}
405	root	1.8
406	root	1.1	use Carp ();
407
408	root	1.17	use JSON::XS;
409
410	root	1.1	use AnyEvent;
411	root	1.4	use AnyEvent::Util;
412
413	root	1.8	use AnyEvent::MP;
414	root	1.1	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	root	1.2	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	root	1.5	"<", "/dev/null",
433	root	1.1	">" , \my $cert,
434			"3>", \my $key,
435	root	1.4	"2>", "/dev/null";
436	root	1.1
437			"$cert$key"
438			}
439
440	root	1.10	our $cfg = AnyEvent::MP::Config::config;
441	root	1.8	our $profile = $cfg;
442	root	1.1
443	root	1.11	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	root	1.19	initialise_node "anon/";
454	root	1.11
455			my $reply = port {
456	root	1.12	my ($node, @neigh) = @_;
457	root	1.11
458	root	1.12	@neigh = grep $_ ne $NODE, @neigh;
459
460			print +(join " ", $node, @neigh), "\n";
461
462			for (@neigh) {
463	root	1.11	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	root	1.10	sub docmd;
479
480	root	1.1	our %CMD = (
481			snd => sub {
482	root	1.17	my $port = shift @ARGV;
483	root	1.19	initialise_node "anon/";
484	root	1.1
485	root	1.7	snd $port, @ARGV; @ARGV = ();
486	root	1.1
487			my $cv = AE::cv;
488	root	1.7	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
489	root	1.1	mon $port, $cv;
490	root	1.19	my $reply = port sub { &$cv };
491			snd node_of $port, snd => $reply, "message sent successfully";
492	root	1.1
493			print join " ", $cv->recv, "\n";
494			},
495
496	root	1.7	rpc => sub {
497	root	1.17	my $port = shift @ARGV;
498	root	1.19	initialise_node "anon/";
499	root	1.7
500			my $cv = AE::cv;
501			my $to = AE::timer 5, 0, sub { $cv->("timeout") };
502	root	1.19	snd $port, @ARGV, port { &$cv }; @ARGV = ();
503	root	1.7	mon $port, $cv;
504
505	root	1.23	print +(substr JSON::XS->new->encode ([$cv->recv]), 1, -1), "\n";
506	root	1.7	},
507
508	root	1.1	mon => sub {
509	root	1.17	my $port = shift @ARGV;
510	root	1.19	initialise_node "anon/";
511	root	1.1
512			mon $port, my $cv = AE::cv;
513			print join " ", $cv->recv, "\n";
514			},
515
516	root	1.19	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	root	1.11	trace => sub {
534			@ARGV >= 1
535	root	1.17	or die "node id missing\n";
536	root	1.11
537	root	1.17	trace shift @ARGV;
538	root	1.11	},
539
540	root	1.17	setnodeid => sub {
541	root	1.8	@ARGV >= 1
542			or die "shared secret missing\n";
543
544	root	1.17	$profile->{nodeid} = shift @ARGV;
545	root	1.8	++$cfg->{dirty};
546			},
547	root	1.17	delnodeid => sub {
548			delete $profile->{nodeid};
549	root	1.8	++$cfg->{dirty};
550			},
551
552	root	1.1	setsecret => sub {
553	root	1.8	@ARGV >= 1
554	root	1.1	or die "shared secret missing\n";
555
556	root	1.8	$profile->{secret} = shift @ARGV;
557	root	1.1	++$cfg->{dirty};
558			},
559			gensecret => sub {
560	root	1.18	$profile->{secret} = AnyEvent::MP::Kernel::alnumbits AnyEvent::MP::Kernel::nonce 64;
561	root	1.1	++$cfg->{dirty};
562			},
563	root	1.17	delsecret => sub {
564	root	1.8	delete $profile->{secret};
565	root	1.1	++$cfg->{dirty};
566			},
567
568			setcert => sub {
569	root	1.8	@ARGV >= 1
570	root	1.1	or die "key+certificate pem filename missing\n";
571
572			open my $fh, "<", $ARGV[0]
573			or die "$ARGV[0]: $!";
574
575			local $/;
576	root	1.8	$profile->{cert} = <$fh>;
577	root	1.1	++$cfg->{dirty};
578			},
579			gencert => sub {
580	root	1.8	$profile->{cert} = gen_cert;
581	root	1.1	++$cfg->{dirty};
582			},
583	root	1.17	delcert => sub {
584	root	1.8	delete $profile->{cert};
585	root	1.1	++$cfg->{dirty};
586			},
587	root	1.6
588	root	1.17	setbinds => sub {
589	root	1.19	@ARGV >= 1
590			or die "bind addresses missing\n";
591			$profile->{binds} = [split /,/, shift @ARGV];
592	root	1.17	++$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	root	1.6	setseeds => sub {
617	root	1.19	@ARGV >= 1
618			or die "seed addresses missing\n";
619			$profile->{seeds} = [split /,/, shift @ARGV];
620	root	1.6	++$cfg->{dirty};
621			},
622	root	1.17	delseeds => sub {
623			delete $profile->{seeds};
624			++$cfg->{dirty};
625			},
626	root	1.6	addseed => sub {
627	root	1.10	@ARGV >= 1
628	root	1.17	or die "seed address missing\n";
629	root	1.6	my $seed = shift @ARGV;
630	root	1.10
631	root	1.8	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
632			push @{ $profile->{seeds} }, $seed;
633			++$cfg->{dirty};
634			},
635			delseed => sub {
636	root	1.10	@ARGV >= 1
637	root	1.17	or die "seed address missing\n";
638	root	1.8	my $seed = shift @ARGV;
639	root	1.10
640	root	1.8	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
641			++$cfg->{dirty};
642			},
643
644			setservices => sub {
645	root	1.19	@ARGV >= 1
646			or die "service specifications missing\n";
647			$profile->{services} = [split /,/, shift @ARGV];
648	root	1.6	++$cfg->{dirty};
649			},
650	root	1.17	delservices => sub {
651			delete $profile->{services};
652			++$cfg->{dirty};
653			},
654	root	1.9	addservice => sub {
655	root	1.10	@ARGV >= 1
656			or die "service specification missing\n";
657	root	1.8	my $service = shift @ARGV;
658			push @{ $profile->{services} }, $service;
659			++$cfg->{dirty};
660			},
661	root	1.9	delservice => sub {
662	root	1.10	@ARGV >= 1
663			or die "service specification missing\n";
664	root	1.8	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	root	1.6	++$cfg->{dirty};
671			},
672	root	1.10
673			profile => sub {
674	root	1.19	@ARGV >= 1
675			or die "profile name is missing\n";
676	root	1.10	my $name = shift @ARGV;
677
678			$profile = $cfg->{profile}{$name} \|\|= {};
679	root	1.14	++$cfg->{dirty};
680	root	1.10	},
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	root	1.14	++$cfg->{dirty};
688	root	1.10	},
689	root	1.24	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	root	1.17	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	root	1.24	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	root	1.17	},
718	root	1.1	);
719
720			sub docmd {
721			my $cmd = shift @ARGV;
722
723			$CMD{$cmd}
724	root	1.23	or die "$cmd: no such aemp command (try perldoc aemp, or man aemp)";
725	root	1.1
726			$CMD{$cmd}();
727			}
728
729			@ARGV
730	root	1.23	or die "Usage: aemp subcommand ... (try perldoc aemp, or man aemp)\n";
731	root	1.1
732	root	1.19	docmd while @ARGV;
733	root	1.1
734