[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

   # 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
   aemp setseeds noderef...    # set seednodes
   aemp addseed noderef        # add a seednode
   aemp delseed noderef        # remove seednode

=head1 DESCRIPTION

With aemp you can configure various aspects of AnyEvent::MP and it's protocol.

=cut

use common::sense;

use Carp ();

use AnyEvent;
use AnyEvent::Util;

use AnyEvent::MP::Config;
use AnyEvent::MP;

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

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

      $nodecfg->{secret} = shift @ARGV;
      ++$cfg->{dirty};
   },
   gensecret => sub {
      $nodecfg->{secret} = AnyEvent::MP::Base::asciibits AnyEvent::MP::Base::nonce 64;
      ++$cfg->{dirty};
   },
   clrsecret => sub {
      delete $nodecfg->{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 $/;
      $nodecfg->{cert} = <$fh>;
      ++$cfg->{dirty};
   },
   gencert => sub {
      $nodecfg->{cert} = gen_cert;
      ++$cfg->{dirty};
   },
   clrcert => sub {
      delete $nodecfg->{cert};
      ++$cfg->{dirty};
   },

   setseeds => sub {
      $cfg->{seeds} = [@ARGV];
      @ARGV = ();
      ++$cfg->{dirty};
   },
   addseed => sub {
      my $seed = shift @ARGV;
      @{ $cfg->{seeds} } = grep $_ ne $seed, @{ $cfg->{seeds} };
      push @{ $cfg->{seeds} }, $seed;
      ++$cfg->{dirty};
   },
   addseed => sub {
      my $seed = shift @ARGV;
      @{ $cfg->{seeds} } = grep $_ ne $seed, @{ $cfg->{seeds} };
      ++$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.7
Committed:	Thu Aug 13 00:49:23 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
CVS Tags:	rel-0_6
Changes since 1.6:	+17 -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			aemp snd <port> <arg...> # send a message
13			aemp mon <port> # wait till port is killed
14	root	1.7	aemp rpc <port> <arg...> # send message, append reply
15	root	1.1
16			# node configuration: secret
17			aemp gensecret # generate a random shared secret
18			aemp setsecret <secret> # set the shared secret
19			aemp clrsecret # remove the secret
20
21			# node configuration: TLS
22			aemp setcert <file> # set a certificate (key.pem + certificate.pem)
23			aemp clrcert # remove certificate
24			aemp gencert # generate a random certificate
25
26	root	1.6	# node configuration
27			aemp setseeds noderef... # set seednodes
28			aemp addseed noderef # add a seednode
29			aemp delseed noderef # remove seednode
30
31	root	1.1	=head1 DESCRIPTION
32
33			With aemp you can configure various aspects of AnyEvent::MP and it's protocol.
34
35			=cut
36
37			use common::sense;
38
39			use Carp ();
40
41			use AnyEvent;
42	root	1.4	use AnyEvent::Util;
43
44	root	1.1	use AnyEvent::MP::Config;
45			use AnyEvent::MP;
46
47			sub my_run_cmd {
48			my ($cmd) = @_;
49
50			my $cv = &run_cmd;
51			my $status = $cv->recv;
52
53			$status
54			and die "@$cmd: command failed with exit status $status.";
55			}
56
57			sub gen_cert {
58	root	1.2	my_run_cmd [qw(openssl req
59			-new -nodes -x509 -days 3650
60			-newkey rsa:2048 -keyout /dev/fd/3
61			-batch -subj /CN=AnyEvent::MP
62			)],
63	root	1.5	"<", "/dev/null",
64	root	1.1	">" , \my $cert,
65			"3>", \my $key,
66	root	1.4	"2>", "/dev/null";
67	root	1.1
68			"$cert$key"
69			}
70
71			our $cfg = \%AnyEvent::MP::Config::CFG;
72	root	1.3	our $nodecfg = $cfg;
73	root	1.1
74			sub resolve_port {
75			my ($node, $port) = split /#/, $_[0], 2;
76
77			$node = (resolve_node $node)->recv;
78			"$node#$port"
79			}
80
81			our %CMD = (
82			snd => sub {
83			my $port = resolve_port shift @ARGV;
84			initialise_node "slave/", node_of $port;
85
86	root	1.7	snd $port, @ARGV; @ARGV = ();
87	root	1.1
88			my $cv = AE::cv;
89	root	1.7	my $to = AE::timer 5, 0, sub { $cv->("timeout") };
90	root	1.1	mon $port, $cv;
91	root	1.7	my $reply = port { &$cv; 1 };
92	root	1.1	snd node_of $port, relay => $reply, "ok";
93
94			print join " ", $cv->recv, "\n";
95			},
96
97	root	1.7	rpc => sub {
98			my $port = resolve_port shift @ARGV;
99			initialise_node "slave/", node_of $port;
100
101			my $cv = AE::cv;
102			my $to = AE::timer 5, 0, sub { $cv->("timeout") };
103			my $reply = port { &$cv; 1 };
104			snd $port, @ARGV, $reply; @ARGV = ();
105			mon $port, $cv;
106
107			print join " ", $cv->recv, "\n";
108			},
109
110	root	1.1	mon => sub {
111			my $port = resolve_port shift @ARGV;
112			initialise_node "slave/", node_of $port;
113
114			mon $port, my $cv = AE::cv;
115			print join " ", $cv->recv, "\n";
116			},
117
118			setsecret => sub {
119			@ARGV == 1
120			or die "shared secret missing\n";
121
122			$nodecfg->{secret} = shift @ARGV;
123			++$cfg->{dirty};
124			},
125			gensecret => sub {
126			$nodecfg->{secret} = AnyEvent::MP::Base::asciibits AnyEvent::MP::Base::nonce 64;
127			++$cfg->{dirty};
128			},
129			clrsecret => sub {
130			delete $nodecfg->{secret};
131			++$cfg->{dirty};
132			},
133
134			setcert => sub {
135			@ARGV == 1
136			or die "key+certificate pem filename missing\n";
137
138			open my $fh, "<", $ARGV[0]
139			or die "$ARGV[0]: $!";
140
141			local $/;
142			$nodecfg->{cert} = <$fh>;
143			++$cfg->{dirty};
144			},
145			gencert => sub {
146			$nodecfg->{cert} = gen_cert;
147			++$cfg->{dirty};
148			},
149			clrcert => sub {
150			delete $nodecfg->{cert};
151			++$cfg->{dirty};
152			},
153	root	1.6
154			setseeds => sub {
155			$cfg->{seeds} = [@ARGV];
156			@ARGV = ();
157			++$cfg->{dirty};
158			},
159			addseed => sub {
160			my $seed = shift @ARGV;
161			@{ $cfg->{seeds} } = grep $_ ne $seed, @{ $cfg->{seeds} };
162			push @{ $cfg->{seeds} }, $seed;
163			++$cfg->{dirty};
164			},
165			addseed => sub {
166			my $seed = shift @ARGV;
167			@{ $cfg->{seeds} } = grep $_ ne $seed, @{ $cfg->{seeds} };
168			++$cfg->{dirty};
169			},
170	root	1.1	);
171
172			sub docmd {
173			my $cmd = shift @ARGV;
174
175			$CMD{$cmd}
176			or die "$cmd: no such aemp command (try man aemp)";
177
178			$CMD{$cmd}();
179			}
180
181			@ARGV
182			or die "Usage: aemp subcommand ... (try man aemp)\n";
183
184			docmd;
185
186