[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 setnoderef <noderef>    # configure the real noderef
   aemp clrnoderef              # reset noderef to default

   # node configuration: secret
   aemp gensecret               # generate a random shared secret
   aemp setsecret <secret>      # set the shared secret
   aemp clrsecret               # remove the secret

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

   # node configuration: seed nodes for bootstrapping
   aemp setseeds <noderef>...   # set seednodes
   aemp addseed <noderef>       # add a seednode
   aemp delseed <noderef>       # remove seednode

   # node configuration: services
   aemp setservices initfunc... # set service functions
   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

   # debugging
   aemp trace <noderef>         # 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;

BEGIN {
   if ($ARGV[0] eq "run") {
      shift;

      # d'oh
      eval "use AnyEvent::Watchdog qw(autorestart heartbeat=300)";

      require AnyEvent;
      require AnyEvent::MP;
      AnyEvent::MP::initialise_node (@ARGV);

      AnyEvent::detect () eq "AnyEvent::Impl::E"
         ? EV::loop ()
         : AE::cv ()->recv;
   }
}

use Carp ();

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 resolve_port {
   my ($node, $port) = split /#/, $_[0], 2;

   $node = (resolve_node $node)->recv;
   "$node#$port"
}

sub trace {
   my ($node) = @_;
   my $cv = AE::cv;
   my %seen;

   my $to = AE::timer 15, 0, sub {
      warn "timeout\n";
      $cv->();
   };

   initialise_node "slave/", $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 = resolve_port shift @ARGV;
      initialise_node "slave/", 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, relay => $reply, "ok";

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

   rpc => sub {
      my $port = resolve_port shift @ARGV;
      initialise_node "slave/", 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 = resolve_port shift @ARGV;
      initialise_node "slave/", node_of $port;

      mon $port, my $cv = AE::cv;
      print join " ", $cv->recv, "\n";
   },

   trace => sub {
      @ARGV >= 1
         or die "noderef missing\n";

      trace +(resolve_node shift @ARGV)->recv;
   },

   setnoderef => sub {
      @ARGV >= 1
         or die "shared secret missing\n";

      $profile->{noderef} = shift @ARGV;
      ++$cfg->{dirty};
   },
   clrnoderef => sub {
      delete $profile->{noderef};
      ++$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};
   },
   clrsecret => 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};
   },
   clrcert => sub {
      delete $profile->{cert};
      ++$cfg->{dirty};
   },

   setseeds => sub {
      $profile->{seeds} = [@ARGV];
      @ARGV = ();
      ++$cfg->{dirty};
   },
   addseed => sub {
      @ARGV >= 1
         or die "seed noderef 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 noderef missing\n";
      my $seed = shift @ARGV;

      @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
      ++$cfg->{dirty};
   },

   setservices => sub {
      $profile->{services} = [@ARGV];
      @ARGV = ();
      ++$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} ||= {};

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

      delete $cfg->{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.13
Committed:	Fri Aug 14 03:27:59 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.12:	+3 -2 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			aemp setnoderef <noderef> # configure the real noderef
21			aemp clrnoderef # reset noderef to default
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			aemp clrsecret # remove the secret
27	root	1.1
28			# node configuration: TLS
29	root	1.8	aemp setcert <file> # set a certificate (key.pem + certificate.pem)
30			aemp clrcert # remove certificate
31			aemp gencert # generate a random certificate
32
33			# node configuration: seed nodes for bootstrapping
34			aemp setseeds <noderef>... # set seednodes
35			aemp addseed <noderef> # add a seednode
36			aemp delseed <noderef> # remove seednode
37
38			# node configuration: services
39			aemp setservices initfunc... # set service functions
40			aemp addservice <initfunc> # add an instance of a service
41			aemp delservice <initfunc> # delete one instance of a service
42	root	1.6
43	root	1.10	# profile-specific configuration
44			aemp profile <name> <command>... # apply command to profile only
45			aemp delprofile <name> # eradicate the named profile
46
47	root	1.11	# debugging
48			aemp trace <noderef> # trace the network topology
49
50	root	1.1	=head1 DESCRIPTION
51
52	root	1.8	With aemp you can configure various aspects of AnyEvent::MP and its
53			protocol.
54
55			You can also start a "default node", a node that only depends on the
56			static configuration.
57	root	1.1
58			=cut
59
60			use common::sense;
61
62	root	1.8	BEGIN {
63			if ($ARGV[0] eq "run") {
64			shift;
65
66	root	1.13	# d'oh
67			eval "use AnyEvent::Watchdog qw(autorestart heartbeat=300)";
68
69	root	1.8	require AnyEvent;
70			require AnyEvent::MP;
71			AnyEvent::MP::initialise_node (@ARGV);
72
73			AnyEvent::detect () eq "AnyEvent::Impl::E"
74			? EV::loop ()
75			: AE::cv ()->recv;
76			}
77			}
78
79	root	1.1	use Carp ();
80
81			use AnyEvent;
82	root	1.4	use AnyEvent::Util;
83
84	root	1.8	use AnyEvent::MP;
85	root	1.1	use AnyEvent::MP::Config;
86
87			sub my_run_cmd {
88			my ($cmd) = @_;
89
90			my $cv = &run_cmd;
91			my $status = $cv->recv;
92
93			$status
94			and die "@$cmd: command failed with exit status $status.";
95			}
96
97			sub gen_cert {
98	root	1.2	my_run_cmd [qw(openssl req
99			-new -nodes -x509 -days 3650
100			-newkey rsa:2048 -keyout /dev/fd/3
101			-batch -subj /CN=AnyEvent::MP
102			)],
103	root	1.5	"<", "/dev/null",
104	root	1.1	">" , \my $cert,
105			"3>", \my $key,
106	root	1.4	"2>", "/dev/null";
107	root	1.1
108			"$cert$key"
109			}
110
111	root	1.10	our $cfg = AnyEvent::MP::Config::config;
112	root	1.8	our $profile = $cfg;
113	root	1.1
114			sub resolve_port {
115			my ($node, $port) = split /#/, $_[0], 2;
116
117			$node = (resolve_node $node)->recv;
118			"$node#$port"
119			}
120
121	root	1.11	sub trace {
122			my ($node) = @_;
123			my $cv = AE::cv;
124			my %seen;
125
126			my $to = AE::timer 15, 0, sub {
127			warn "timeout\n";
128			$cv->();
129			};
130
131			initialise_node "slave/", $node;
132
133			my $reply = port {
134	root	1.12	my ($node, @neigh) = @_;
135	root	1.11
136	root	1.12	@neigh = grep $_ ne $NODE, @neigh;
137
138			print +(join " ", $node, @neigh), "\n";
139
140			for (@neigh) {
141	root	1.11	unless ($seen{$_}++) {
142			$cv->begin;
143			snd $_, up_nodes => $SELF => $_;
144			}
145			}
146
147			$cv->end;
148			};
149
150			$cv->begin;
151			snd $reply, seed => $node;
152
153			$cv->recv;
154			}
155
156	root	1.10	sub docmd;
157
158	root	1.1	our %CMD = (
159			snd => sub {
160			my $port = resolve_port shift @ARGV;
161			initialise_node "slave/", node_of $port;
162
163	root	1.7	snd $port, @ARGV; @ARGV = ();
164	root	1.1
165			my $cv = AE::cv;
166	root	1.7	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
167	root	1.1	mon $port, $cv;
168	root	1.7	my $reply = port { &$cv; 1 };
169	root	1.1	snd node_of $port, relay => $reply, "ok";
170
171			print join " ", $cv->recv, "\n";
172			},
173
174	root	1.7	rpc => sub {
175			my $port = resolve_port shift @ARGV;
176			initialise_node "slave/", node_of $port;
177
178			my $cv = AE::cv;
179			my $to = AE::timer 5, 0, sub { $cv->("timeout") };
180			my $reply = port { &$cv; 1 };
181			snd $port, @ARGV, $reply; @ARGV = ();
182			mon $port, $cv;
183
184			print join " ", $cv->recv, "\n";
185			},
186
187	root	1.1	mon => sub {
188			my $port = resolve_port shift @ARGV;
189			initialise_node "slave/", node_of $port;
190
191			mon $port, my $cv = AE::cv;
192			print join " ", $cv->recv, "\n";
193			},
194
195	root	1.11	trace => sub {
196			@ARGV >= 1
197			or die "noderef missing\n";
198
199			trace +(resolve_node shift @ARGV)->recv;
200			},
201
202	root	1.8	setnoderef => sub {
203			@ARGV >= 1
204			or die "shared secret missing\n";
205
206			$profile->{noderef} = shift @ARGV;
207			++$cfg->{dirty};
208			},
209			clrnoderef => sub {
210			delete $profile->{noderef};
211			++$cfg->{dirty};
212			},
213
214	root	1.1	setsecret => sub {
215	root	1.8	@ARGV >= 1
216	root	1.1	or die "shared secret missing\n";
217
218	root	1.8	$profile->{secret} = shift @ARGV;
219	root	1.1	++$cfg->{dirty};
220			},
221			gensecret => sub {
222	root	1.8	$profile->{secret} = AnyEvent::MP::Base::asciibits AnyEvent::MP::Base::nonce 64;
223	root	1.1	++$cfg->{dirty};
224			},
225			clrsecret => sub {
226	root	1.8	delete $profile->{secret};
227	root	1.1	++$cfg->{dirty};
228			},
229
230			setcert => sub {
231	root	1.8	@ARGV >= 1
232	root	1.1	or die "key+certificate pem filename missing\n";
233
234			open my $fh, "<", $ARGV[0]
235			or die "$ARGV[0]: $!";
236
237			local $/;
238	root	1.8	$profile->{cert} = <$fh>;
239	root	1.1	++$cfg->{dirty};
240			},
241			gencert => sub {
242	root	1.8	$profile->{cert} = gen_cert;
243	root	1.1	++$cfg->{dirty};
244			},
245			clrcert => sub {
246	root	1.8	delete $profile->{cert};
247	root	1.1	++$cfg->{dirty};
248			},
249	root	1.6
250			setseeds => sub {
251	root	1.8	$profile->{seeds} = [@ARGV];
252	root	1.6	@ARGV = ();
253			++$cfg->{dirty};
254			},
255			addseed => sub {
256	root	1.10	@ARGV >= 1
257			or die "seed noderef missing\n";
258	root	1.6	my $seed = shift @ARGV;
259	root	1.10
260	root	1.8	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
261			push @{ $profile->{seeds} }, $seed;
262			++$cfg->{dirty};
263			},
264			delseed => sub {
265	root	1.10	@ARGV >= 1
266			or die "seed noderef missing\n";
267	root	1.8	my $seed = shift @ARGV;
268	root	1.10
269	root	1.8	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
270			++$cfg->{dirty};
271			},
272
273			setservices => sub {
274			$profile->{services} = [@ARGV];
275			@ARGV = ();
276	root	1.6	++$cfg->{dirty};
277			},
278	root	1.9	addservice => sub {
279	root	1.10	@ARGV >= 1
280			or die "service specification missing\n";
281	root	1.8	my $service = shift @ARGV;
282			push @{ $profile->{services} }, $service;
283			++$cfg->{dirty};
284			},
285	root	1.9	delservice => sub {
286	root	1.10	@ARGV >= 1
287			or die "service specification missing\n";
288	root	1.8	my $service = shift @ARGV;
289			for (0 .. $#{ $profile->{services} }) {
290			next unless $profile->{services}[$_] eq $service;
291			splice @{ $profile->{services} }, $_, 1;
292			last;
293			}
294	root	1.6	++$cfg->{dirty};
295			},
296	root	1.10
297			profile => sub {
298			@ARGV >= 2
299			or die "profile name or subcommand are missing\n";
300			my $name = shift @ARGV;
301
302			$profile = $cfg->{profile}{$name} \|\|= {};
303
304			docmd;
305			},
306			delprofile => sub {
307			@ARGV >= 1
308			or die "profile name is missing\n";
309			my $name = shift @ARGV;
310
311			delete $cfg->{profile}{$name};
312			},
313	root	1.1	);
314
315			sub docmd {
316			my $cmd = shift @ARGV;
317
318			$CMD{$cmd}
319			or die "$cmd: no such aemp command (try man aemp)";
320
321			$CMD{$cmd}();
322			}
323
324			@ARGV
325			or die "Usage: aemp subcommand ... (try man aemp)\n";
326
327			docmd;
328
329