[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

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

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

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

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

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

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

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

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

   # debugging
   aemp trace <nodeid>          # trace the network topology

=head1 DESCRIPTION

With aemp you can configure various aspects of AnyEvent::MP and its
protocol.

You can also start a "default node", a node that only depends on the
static configuration.

=cut

use common::sense;

# must come before anything else
BEGIN {
   if ($ARGV[0] eq "run") {
      shift;

      # d'oh
      require AnyEvent::Watchdog;
      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/", $node;

   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/", node_of $port;

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

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

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

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

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

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

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

      mon $port, my $cv = AE::cv;
      print join " ", $cv->recv, "\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 {
      $profile->{binds} = [@ARGV];
      @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 {
      $profile->{seeds} = [@ARGV];
      @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 {
      $profile->{services} = [@ARGV];
      @ARGV = ();
      ++$cfg->{dirty};
   },
   delservices => sub {
      delete $profile->{services};
      ++$cfg->{dirty};
   },
   addservice => sub {
      @ARGV >= 1
         or die "service specification missing\n";
      my $service = shift @ARGV;
      push @{ $profile->{services} }, $service;
      ++$cfg->{dirty};
   },
   delservice => sub {
      @ARGV >= 1
         or die "service specification missing\n";
      my $service = shift @ARGV;
      for (0 .. $#{ $profile->{services} }) {
         next unless $profile->{services}[$_] eq $service;
         splice @{ $profile->{services} }, $_, 1;
         last;
      }
      ++$cfg->{dirty};
   },

   profile => sub {
      @ARGV >= 2
         or die "profile name or subcommand are missing\n";
      my $name = shift @ARGV;

      $profile = $cfg->{profile}{$name} ||= {};
      ++$cfg->{dirty};

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

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

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

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

sub docmd {
   my $cmd = shift @ARGV;

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

   $CMD{$cmd}();
}

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

docmd;


Revision:	1.18
Committed:	Thu Aug 27 23:46:33 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_9
Changes since 1.17:	+1 -1 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.8	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
16			# run a node
17			aemp run initialise_args... # run a node
18
19			# node configuration: protocol endpoints
20	root	1.17	aemp setnodeid <nodeid> # configure the real node id
21			aemp delnodeid # reset node id to default (= inherit)
22	root	1.1
23			# node configuration: secret
24	root	1.8	aemp gensecret # generate a random shared secret
25			aemp setsecret <secret> # set the shared secret
26	root	1.17	aemp delsecret # remove the secret (= inherit)
27	root	1.1
28			# node configuration: TLS
29	root	1.17	aemp gencert # generate a random certificate
30	root	1.8	aemp setcert <file> # set a certificate (key.pem + certificate.pem)
31	root	1.17	aemp delcert # remove certificate (= inherit)
32	root	1.8
33	root	1.17	# node configuration: seed addresses for bootstrapping
34			aemp setseeds <host:port>... # set seeds
35			aemp delseeds # clear all seeds (= inherit)
36			aemp addseed <host:port> # add a seed
37			aemp delseed <host:port> # remove seed
38
39			# node configuration: bind addresses
40			aemp setbinds <host:port>... # set binds
41			aemp delbinds # clear all binds (= inherit)
42			aemp addbind <host:port> # add a bind address
43			aemp delbind <host:port> # remove a bind address
44	root	1.8
45			# node configuration: services
46			aemp setservices initfunc... # set service functions
47	root	1.17	aemp delservices # clear all services (= inherit)
48	root	1.8	aemp addservice <initfunc> # add an instance of a service
49			aemp delservice <initfunc> # delete one instance of a service
50	root	1.6
51	root	1.10	# profile-specific configuration
52			aemp profile <name> <command>... # apply command to profile only
53			aemp delprofile <name> # eradicate the named profile
54	root	1.17	aemp showprofile <name> # display given profile
55			aemp showconfig <name> # display effective config
56	root	1.10
57	root	1.11	# debugging
58	root	1.17	aemp trace <nodeid> # trace the network topology
59	root	1.11
60	root	1.1	=head1 DESCRIPTION
61
62	root	1.8	With aemp you can configure various aspects of AnyEvent::MP and its
63			protocol.
64
65			You can also start a "default node", a node that only depends on the
66			static configuration.
67	root	1.1
68			=cut
69
70			use common::sense;
71
72	root	1.15	# must come before anything else
73	root	1.8	BEGIN {
74			if ($ARGV[0] eq "run") {
75			shift;
76
77	root	1.13	# d'oh
78	root	1.15	require AnyEvent::Watchdog;
79			AnyEvent::Watchdog::autorestart (1);
80			AnyEvent::Watchdog::heartbeat (300);
81	root	1.13
82	root	1.8	require AnyEvent;
83			require AnyEvent::MP;
84			AnyEvent::MP::initialise_node (@ARGV);
85
86	root	1.16	AnyEvent::detect () eq "AnyEvent::Impl::EV"
87	root	1.8	? EV::loop ()
88			: AE::cv ()->recv;
89			}
90			}
91
92	root	1.1	use Carp ();
93
94	root	1.17	use JSON::XS;
95
96	root	1.1	use AnyEvent;
97	root	1.4	use AnyEvent::Util;
98
99	root	1.8	use AnyEvent::MP;
100	root	1.1	use AnyEvent::MP::Config;
101
102			sub my_run_cmd {
103			my ($cmd) = @_;
104
105			my $cv = &run_cmd;
106			my $status = $cv->recv;
107
108			$status
109			and die "@$cmd: command failed with exit status $status.";
110			}
111
112			sub gen_cert {
113	root	1.2	my_run_cmd [qw(openssl req
114			-new -nodes -x509 -days 3650
115			-newkey rsa:2048 -keyout /dev/fd/3
116			-batch -subj /CN=AnyEvent::MP
117			)],
118	root	1.5	"<", "/dev/null",
119	root	1.1	">" , \my $cert,
120			"3>", \my $key,
121	root	1.4	"2>", "/dev/null";
122	root	1.1
123			"$cert$key"
124			}
125
126	root	1.10	our $cfg = AnyEvent::MP::Config::config;
127	root	1.8	our $profile = $cfg;
128	root	1.1
129	root	1.11	sub trace {
130			my ($node) = @_;
131			my $cv = AE::cv;
132			my %seen;
133
134			my $to = AE::timer 15, 0, sub {
135			warn "timeout\n";
136			$cv->();
137			};
138
139	root	1.17	initialise_node "anon/", $node;
140	root	1.11
141			my $reply = port {
142	root	1.12	my ($node, @neigh) = @_;
143	root	1.11
144	root	1.12	@neigh = grep $_ ne $NODE, @neigh;
145
146			print +(join " ", $node, @neigh), "\n";
147
148			for (@neigh) {
149	root	1.11	unless ($seen{$_}++) {
150			$cv->begin;
151			snd $_, up_nodes => $SELF => $_;
152			}
153			}
154
155			$cv->end;
156			};
157
158			$cv->begin;
159			snd $reply, seed => $node;
160
161			$cv->recv;
162			}
163
164	root	1.10	sub docmd;
165
166	root	1.1	our %CMD = (
167			snd => sub {
168	root	1.17	my $port = shift @ARGV;
169			initialise_node "anon/", node_of $port;
170	root	1.1
171	root	1.7	snd $port, @ARGV; @ARGV = ();
172	root	1.1
173			my $cv = AE::cv;
174	root	1.7	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
175	root	1.1	mon $port, $cv;
176	root	1.7	my $reply = port { &$cv; 1 };
177	root	1.15	snd node_of $port, snd => $reply, "ok";
178	root	1.1
179			print join " ", $cv->recv, "\n";
180			},
181
182	root	1.7	rpc => sub {
183	root	1.17	my $port = shift @ARGV;
184			initialise_node "anon/", node_of $port;
185	root	1.7
186			my $cv = AE::cv;
187			my $to = AE::timer 5, 0, sub { $cv->("timeout") };
188			my $reply = port { &$cv; 1 };
189			snd $port, @ARGV, $reply; @ARGV = ();
190			mon $port, $cv;
191
192			print join " ", $cv->recv, "\n";
193			},
194
195	root	1.1	mon => sub {
196	root	1.17	my $port = shift @ARGV;
197			initialise_node "anon/", node_of $port;
198	root	1.1
199			mon $port, my $cv = AE::cv;
200			print join " ", $cv->recv, "\n";
201			},
202
203	root	1.11	trace => sub {
204			@ARGV >= 1
205	root	1.17	or die "node id missing\n";
206	root	1.11
207	root	1.17	trace shift @ARGV;
208	root	1.11	},
209
210	root	1.17	setnodeid => sub {
211	root	1.8	@ARGV >= 1
212			or die "shared secret missing\n";
213
214	root	1.17	$profile->{nodeid} = shift @ARGV;
215	root	1.8	++$cfg->{dirty};
216			},
217	root	1.17	delnodeid => sub {
218			delete $profile->{nodeid};
219	root	1.8	++$cfg->{dirty};
220			},
221
222	root	1.1	setsecret => sub {
223	root	1.8	@ARGV >= 1
224	root	1.1	or die "shared secret missing\n";
225
226	root	1.8	$profile->{secret} = shift @ARGV;
227	root	1.1	++$cfg->{dirty};
228			},
229			gensecret => sub {
230	root	1.18	$profile->{secret} = AnyEvent::MP::Kernel::alnumbits AnyEvent::MP::Kernel::nonce 64;
231	root	1.1	++$cfg->{dirty};
232			},
233	root	1.17	delsecret => sub {
234	root	1.8	delete $profile->{secret};
235	root	1.1	++$cfg->{dirty};
236			},
237
238			setcert => sub {
239	root	1.8	@ARGV >= 1
240	root	1.1	or die "key+certificate pem filename missing\n";
241
242			open my $fh, "<", $ARGV[0]
243			or die "$ARGV[0]: $!";
244
245			local $/;
246	root	1.8	$profile->{cert} = <$fh>;
247	root	1.1	++$cfg->{dirty};
248			},
249			gencert => sub {
250	root	1.8	$profile->{cert} = gen_cert;
251	root	1.1	++$cfg->{dirty};
252			},
253	root	1.17	delcert => sub {
254	root	1.8	delete $profile->{cert};
255	root	1.1	++$cfg->{dirty};
256			},
257	root	1.6
258	root	1.17	setbinds => sub {
259			$profile->{binds} = [@ARGV];
260			@ARGV = ();
261			++$cfg->{dirty};
262			},
263			delbinds => sub {
264			delete $profile->{binds};
265			++$cfg->{dirty};
266			},
267			addbind => sub {
268			@ARGV >= 1
269			or die "bind address missing\n";
270			my $bind = shift @ARGV;
271
272			@{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
273			push @{ $profile->{binds} }, $bind;
274			++$cfg->{dirty};
275			},
276			delbind => sub {
277			@ARGV >= 1
278			or die "bind address missing\n";
279			my $bind = shift @ARGV;
280
281			@{ $profile->{binds} } = grep $_ ne $bind, @{ $profile->{binds} };
282			++$cfg->{dirty};
283			},
284
285	root	1.6	setseeds => sub {
286	root	1.8	$profile->{seeds} = [@ARGV];
287	root	1.6	@ARGV = ();
288			++$cfg->{dirty};
289			},
290	root	1.17	delseeds => sub {
291			delete $profile->{seeds};
292			++$cfg->{dirty};
293			},
294	root	1.6	addseed => sub {
295	root	1.10	@ARGV >= 1
296	root	1.17	or die "seed address missing\n";
297	root	1.6	my $seed = shift @ARGV;
298	root	1.10
299	root	1.8	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
300			push @{ $profile->{seeds} }, $seed;
301			++$cfg->{dirty};
302			},
303			delseed => sub {
304	root	1.10	@ARGV >= 1
305	root	1.17	or die "seed address missing\n";
306	root	1.8	my $seed = shift @ARGV;
307	root	1.10
308	root	1.8	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
309			++$cfg->{dirty};
310			},
311
312			setservices => sub {
313			$profile->{services} = [@ARGV];
314			@ARGV = ();
315	root	1.6	++$cfg->{dirty};
316			},
317	root	1.17	delservices => sub {
318			delete $profile->{services};
319			++$cfg->{dirty};
320			},
321	root	1.9	addservice => sub {
322	root	1.10	@ARGV >= 1
323			or die "service specification missing\n";
324	root	1.8	my $service = shift @ARGV;
325			push @{ $profile->{services} }, $service;
326			++$cfg->{dirty};
327			},
328	root	1.9	delservice => sub {
329	root	1.10	@ARGV >= 1
330			or die "service specification missing\n";
331	root	1.8	my $service = shift @ARGV;
332			for (0 .. $#{ $profile->{services} }) {
333			next unless $profile->{services}[$_] eq $service;
334			splice @{ $profile->{services} }, $_, 1;
335			last;
336			}
337	root	1.6	++$cfg->{dirty};
338			},
339	root	1.10
340			profile => sub {
341			@ARGV >= 2
342			or die "profile name or subcommand are missing\n";
343			my $name = shift @ARGV;
344
345			$profile = $cfg->{profile}{$name} \|\|= {};
346	root	1.14	++$cfg->{dirty};
347	root	1.10
348			docmd;
349			},
350			delprofile => sub {
351			@ARGV >= 1
352			or die "profile name is missing\n";
353			my $name = shift @ARGV;
354
355			delete $cfg->{profile}{$name};
356	root	1.14	++$cfg->{dirty};
357	root	1.10	},
358	root	1.17	showprofile => sub {
359			@ARGV >= 1
360			or die "profile name is missing\n";
361			my $name = shift @ARGV;
362
363			print JSON::XS->new->pretty->encode ($cfg->{profile}{$name} \|\| {});
364			},
365			showconfig => sub {
366			my $name = @ARGV ? shift @ARGV : AnyEvent::MP::Kernel::_nodename;
367
368			print JSON::XS->new->pretty->encode (AnyEvent::MP::Config::find_profile $name);
369			},
370	root	1.1	);
371
372			sub docmd {
373			my $cmd = shift @ARGV;
374
375			$CMD{$cmd}
376			or die "$cmd: no such aemp command (try man aemp)";
377
378			$CMD{$cmd}();
379			}
380
381			@ARGV
382			or die "Usage: aemp subcommand ... (try man aemp)\n";
383
384			docmd;
385
386