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

# 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::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, snd => $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} ||= {};
      ++$cfg->{dirty};

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

      delete $cfg->{profile}{$name};
      ++$cfg->{dirty};
   },
);

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