[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

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

      #TODO: watchdog? how?
      #require AnyEvent::Watchdog;
      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::CFG;
our $profile = $cfg;

sub resolve_port {
   my ($node, $port) = split /#/, $_[0], 2;

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

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";
   },

   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 {
      my $seed = shift @ARGV;
      @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
      push @{ $profile->{seeds} }, $seed;
      ++$cfg->{dirty};
   },
   delseed => sub {
      my $seed = shift @ARGV;
      @{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
      ++$cfg->{dirty};
   },

   setservices => sub {
      $profile->{services} = [@ARGV];
      @ARGV = ();
      ++$cfg->{dirty};
   },
   addservice => sub {
      my $service = shift @ARGV;
      push @{ $profile->{services} }, $service;
      ++$cfg->{dirty};
   },
   delservice => sub {
      my $service = shift @ARGV;
      for (0 .. $#{ $profile->{services} }) {
         next unless $profile->{services}[$_] eq $service;
         splice @{ $profile->{services} }, $_, 1;
         last;
      }
      ++$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.9
Committed:	Thu Aug 13 03:34:24 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.8:	+2 -2 lines
Log Message:	services...
#	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	=head1 DESCRIPTION
44
45	With aemp you can configure various aspects of AnyEvent::MP and its
46	protocol.
47
48	You can also start a "default node", a node that only depends on the
49	static configuration.
50
51	=cut
52
53	use common::sense;
54
55	BEGIN {
56	if ($ARGV[0] eq "run") {
57	shift;
58
59	#TODO: watchdog? how?
60	#require AnyEvent::Watchdog;
61	require AnyEvent;
62	require AnyEvent::MP;
63	AnyEvent::MP::initialise_node (@ARGV);
64
65	AnyEvent::detect () eq "AnyEvent::Impl::E"
66	? EV::loop ()
67	: AE::cv ()->recv;
68	}
69	}
70
71	use Carp ();
72
73	use AnyEvent;
74	use AnyEvent::Util;
75
76	use AnyEvent::MP;
77	use AnyEvent::MP::Config;
78
79	sub my_run_cmd {
80	my ($cmd) = @_;
81
82	my $cv = &run_cmd;
83	my $status = $cv->recv;
84
85	$status
86	and die "@$cmd: command failed with exit status $status.";
87	}
88
89	sub gen_cert {
90	my_run_cmd [qw(openssl req
91	-new -nodes -x509 -days 3650
92	-newkey rsa:2048 -keyout /dev/fd/3
93	-batch -subj /CN=AnyEvent::MP
94	)],
95	"<", "/dev/null",
96	">" , \my $cert,
97	"3>", \my $key,
98	"2>", "/dev/null";
99
100	"$cert$key"
101	}
102
103	our $cfg = \%AnyEvent::MP::Config::CFG;
104	our $profile = $cfg;
105
106	sub resolve_port {
107	my ($node, $port) = split /#/, $_[0], 2;
108
109	$node = (resolve_node $node)->recv;
110	"$node#$port"
111	}
112
113	our %CMD = (
114	snd => sub {
115	my $port = resolve_port shift @ARGV;
116	initialise_node "slave/", node_of $port;
117
118	snd $port, @ARGV; @ARGV = ();
119
120	my $cv = AE::cv;
121	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
122	mon $port, $cv;
123	my $reply = port { &$cv; 1 };
124	snd node_of $port, relay => $reply, "ok";
125
126	print join " ", $cv->recv, "\n";
127	},
128
129	rpc => sub {
130	my $port = resolve_port shift @ARGV;
131	initialise_node "slave/", node_of $port;
132
133	my $cv = AE::cv;
134	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
135	my $reply = port { &$cv; 1 };
136	snd $port, @ARGV, $reply; @ARGV = ();
137	mon $port, $cv;
138
139	print join " ", $cv->recv, "\n";
140	},
141
142	mon => sub {
143	my $port = resolve_port shift @ARGV;
144	initialise_node "slave/", node_of $port;
145
146	mon $port, my $cv = AE::cv;
147	print join " ", $cv->recv, "\n";
148	},
149
150	setnoderef => sub {
151	@ARGV >= 1
152	or die "shared secret missing\n";
153
154	$profile->{noderef} = shift @ARGV;
155	++$cfg->{dirty};
156	},
157	clrnoderef => sub {
158	delete $profile->{noderef};
159	++$cfg->{dirty};
160	},
161
162	setsecret => sub {
163	@ARGV >= 1
164	or die "shared secret missing\n";
165
166	$profile->{secret} = shift @ARGV;
167	++$cfg->{dirty};
168	},
169	gensecret => sub {
170	$profile->{secret} = AnyEvent::MP::Base::asciibits AnyEvent::MP::Base::nonce 64;
171	++$cfg->{dirty};
172	},
173	clrsecret => sub {
174	delete $profile->{secret};
175	++$cfg->{dirty};
176	},
177
178	setcert => sub {
179	@ARGV >= 1
180	or die "key+certificate pem filename missing\n";
181
182	open my $fh, "<", $ARGV[0]
183	or die "$ARGV[0]: $!";
184
185	local $/;
186	$profile->{cert} = <$fh>;
187	++$cfg->{dirty};
188	},
189	gencert => sub {
190	$profile->{cert} = gen_cert;
191	++$cfg->{dirty};
192	},
193	clrcert => sub {
194	delete $profile->{cert};
195	++$cfg->{dirty};
196	},
197
198	setseeds => sub {
199	$profile->{seeds} = [@ARGV];
200	@ARGV = ();
201	++$cfg->{dirty};
202	},
203	addseed => sub {
204	my $seed = shift @ARGV;
205	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
206	push @{ $profile->{seeds} }, $seed;
207	++$cfg->{dirty};
208	},
209	delseed => sub {
210	my $seed = shift @ARGV;
211	@{ $profile->{seeds} } = grep $_ ne $seed, @{ $profile->{seeds} };
212	++$cfg->{dirty};
213	},
214
215	setservices => sub {
216	$profile->{services} = [@ARGV];
217	@ARGV = ();
218	++$cfg->{dirty};
219	},
220	addservice => sub {
221	my $service = shift @ARGV;
222	push @{ $profile->{services} }, $service;
223	++$cfg->{dirty};
224	},
225	delservice => sub {
226	my $service = shift @ARGV;
227	for (0 .. $#{ $profile->{services} }) {
228	next unless $profile->{services}[$_] eq $service;
229	splice @{ $profile->{services} }, $_, 1;
230	last;
231	}
232	++$cfg->{dirty};
233	},
234	);
235
236	sub docmd {
237	my $cmd = shift @ARGV;
238
239	$CMD{$cmd}
240	or die "$cmd: no such aemp command (try man aemp)";
241
242	$CMD{$cmd}();
243	}
244
245	@ARGV
246	or die "Usage: aemp subcommand ... (try man aemp)\n";
247
248	docmd;
249
250