[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 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

=head1 DESCRIPTION

With aemp you can configure various aspects of AnyEvent::MP and its
protocol, send various messages and even run a node.

=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 join " ", $cv->recv, "\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];
      @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};
   },
   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 while @ARGV;


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