[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

   # 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::Base::asciibits AnyEvent::MP::Base::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.17
Committed:	Thu Aug 27 21:29:37 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.16:	+86 -34 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
16	# run a node
17	aemp run initialise_args... # run a node
18
19	# node configuration: protocol endpoints
20	aemp setnodeid <nodeid> # configure the real node id
21	aemp delnodeid # reset node id to default (= inherit)
22
23	# node configuration: secret
24	aemp gensecret # generate a random shared secret
25	aemp setsecret <secret> # set the shared secret
26	aemp delsecret # remove the secret (= inherit)
27
28	# node configuration: TLS
29	aemp gencert # generate a random certificate
30	aemp setcert <file> # set a certificate (key.pem + certificate.pem)
31	aemp delcert # remove certificate (= inherit)
32
33	# 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
45	# node configuration: services
46	aemp setservices initfunc... # set service functions
47	aemp delservices # clear all services (= inherit)
48	aemp addservice <initfunc> # add an instance of a service
49	aemp delservice <initfunc> # delete one instance of a service
50
51	# profile-specific configuration
52	aemp profile <name> <command>... # apply command to profile only
53	aemp delprofile <name> # eradicate the named profile
54	aemp showprofile <name> # display given profile
55	aemp showconfig <name> # display effective config
56
57	# debugging
58	aemp trace <nodeid> # trace the network topology
59
60	=head1 DESCRIPTION
61
62	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
68	=cut
69
70	use common::sense;
71
72	# must come before anything else
73	BEGIN {
74	if ($ARGV[0] eq "run") {
75	shift;
76
77	# d'oh
78	require AnyEvent::Watchdog;
79	AnyEvent::Watchdog::autorestart (1);
80	AnyEvent::Watchdog::heartbeat (300);
81
82	require AnyEvent;
83	require AnyEvent::MP;
84	AnyEvent::MP::initialise_node (@ARGV);
85
86	AnyEvent::detect () eq "AnyEvent::Impl::EV"
87	? EV::loop ()
88	: AE::cv ()->recv;
89	}
90	}
91
92	use Carp ();
93
94	use JSON::XS;
95
96	use AnyEvent;
97	use AnyEvent::Util;
98
99	use AnyEvent::MP;
100	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	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	"<", "/dev/null",
119	">" , \my $cert,
120	"3>", \my $key,
121	"2>", "/dev/null";
122
123	"$cert$key"
124	}
125
126	our $cfg = AnyEvent::MP::Config::config;
127	our $profile = $cfg;
128
129	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	initialise_node "anon/", $node;
140
141	my $reply = port {
142	my ($node, @neigh) = @_;
143
144	@neigh = grep $_ ne $NODE, @neigh;
145
146	print +(join " ", $node, @neigh), "\n";
147
148	for (@neigh) {
149	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	sub docmd;
165
166	our %CMD = (
167	snd => sub {
168	my $port = shift @ARGV;
169	initialise_node "anon/", node_of $port;
170
171	snd $port, @ARGV; @ARGV = ();
172
173	my $cv = AE::cv;
174	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
175	mon $port, $cv;
176	my $reply = port { &$cv; 1 };
177	snd node_of $port, snd => $reply, "ok";
178
179	print join " ", $cv->recv, "\n";
180	},
181
182	rpc => sub {
183	my $port = shift @ARGV;
184	initialise_node "anon/", node_of $port;
185
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	mon => sub {
196	my $port = shift @ARGV;
197	initialise_node "anon/", node_of $port;
198
199	mon $port, my $cv = AE::cv;
200	print join " ", $cv->recv, "\n";
201	},
202
203	trace => sub {
204	@ARGV >= 1
205	or die "node id missing\n";
206
207	trace shift @ARGV;
208	},
209
210	setnodeid => sub {
211	@ARGV >= 1
212	or die "shared secret missing\n";
213
214	$profile->{nodeid} = shift @ARGV;
215	++$cfg->{dirty};
216	},
217	delnodeid => sub {
218	delete $profile->{nodeid};
219	++$cfg->{dirty};
220	},
221
222	setsecret => sub {
223	@ARGV >= 1
224	or die "shared secret missing\n";
225
226	$profile->{secret} = shift @ARGV;
227	++$cfg->{dirty};
228	},
229	gensecret => sub {
230	$profile->{secret} = AnyEvent::MP::Base::asciibits AnyEvent::MP::Base::nonce 64;
231	++$cfg->{dirty};
232	},
233	delsecret => sub {
234	delete $profile->{secret};
235	++$cfg->{dirty};
236	},
237
238	setcert => sub {
239	@ARGV >= 1
240	or die "key+certificate pem filename missing\n";
241
242	open my $fh, "<", $ARGV[0]
243	or die "$ARGV[0]: $!";
244
245	local $/;
246	$profile->{cert} = <$fh>;
247	++$cfg->{dirty};
248	},
249	gencert => sub {
250	$profile->{cert} = gen_cert;
251	++$cfg->{dirty};
252	},
253	delcert => sub {
254	delete $profile->{cert};
255	++$cfg->{dirty};
256	},
257
258	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	setseeds => sub {
286	$profile->{seeds} = [@ARGV];
287	@ARGV = ();
288	++$cfg->{dirty};
289	},
290	delseeds => sub {
291	delete $profile->{seeds};
292	++$cfg->{dirty};
293	},
294	addseed => sub {
295	@ARGV >= 1
296	or die "seed address missing\n";
297	my $seed = shift @ARGV;
298
299	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
300	push @{ $profile->{seeds} }, $seed;
301	++$cfg->{dirty};
302	},
303	delseed => sub {
304	@ARGV >= 1
305	or die "seed address missing\n";
306	my $seed = shift @ARGV;
307
308	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
309	++$cfg->{dirty};
310	},
311
312	setservices => sub {
313	$profile->{services} = [@ARGV];
314	@ARGV = ();
315	++$cfg->{dirty};
316	},
317	delservices => sub {
318	delete $profile->{services};
319	++$cfg->{dirty};
320	},
321	addservice => sub {
322	@ARGV >= 1
323	or die "service specification missing\n";
324	my $service = shift @ARGV;
325	push @{ $profile->{services} }, $service;
326	++$cfg->{dirty};
327	},
328	delservice => sub {
329	@ARGV >= 1
330	or die "service specification missing\n";
331	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	++$cfg->{dirty};
338	},
339
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	++$cfg->{dirty};
347
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	++$cfg->{dirty};
357	},
358	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	);
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