[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

   # 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
   aemp forcetls <0|1>         # enforce TLS connections?

=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::MP::Config;
use AnyEvent::MP;

sub run_cmd {
   my $cmd = shift;

   require POSIX;

   local $^F = 1023; #d#

   my $cv = AE::cv;

   my %redir;
   my @exe;

   while (@_) {
      my $type = shift;

      my $fd = $type =~ s/^(\d+)// ? $1 : undef;

      if ($type eq ">") {
         my ($pr, $pw) = AnyEvent::Util::portable_pipe;
         my $cb = shift;

         $cv->begin;
         my $w; $w = AE::io $pr, 0,
            "SCALAR" eq ref $cb
               ? sub {
                    sysread $pr, $$cb, 8192, length $$cb
                       and return;
                    undef $w; $cv->end;
                 }
               : sub {
                    my $buf;
                    sysread $pr, $buf, 8192
                       and return $cb->($buf);
                    undef $w; $cv->end;
                 }
         ;
         $redir{defined $fd ? $fd : 1} = $pw;

      } elsif ($type eq "<") {
         my ($pr, $pw) = AnyEvent::Util::portable_pipe;
         my $cb = shift;

         #TODO
#         $cv->begin;
#         my $w; $w = AE::io $pw, 0,
#            "SCALAR" eq ref $cb
#               ? sub {
#                    my $len = syswrite $pr, $$cb, 8192, length $$cb
#                       and return;
#                    undef $w; $cv->end;
#                 }
#               : sub {
#                    my $buf;
#                    sysread $pr, $buf, 8192
#                       and return $cb->($buf);
#                    undef $w; $cv->end;
#                 }
#         ;
#         $redir{defined $fd ? $fd : 0} = $pr;

      } elsif ($type =~ s/^>//) {
         push @exe, sub {
            open my $fh, ">", $type
               or POSIX::_exit (125);
            $redir{defined $fd ? $fd : 1} = $fh;
         };

      } elsif ($type =~ s/^<//) {
         push @exe, sub {
            open my $fh, "<", $type
               or POSIX::_exit (125);
            $redir{defined $fd ? $fd : 0} = $fh;
         };
      }
   }

   my $pid = fork;

   defined $pid
      or Carp::croak "fork: $!";

   unless ($pid) {
      # step 1, execute
      $_->() for @exe;

      # step 2, move any existing fd's out of the way
      my @oldfh;
      for my $fh (values %redir) {
         push @oldfh, $fh;
         $fh = fileno $fh;

         defined ($fh = POSIX::dup ($fh)) or POSIX::_exit (124)
            while exists $redir{$fh};
      }

      # step 3, execute redirects
      while (my ($k, $v) = each %redir) {
         defined POSIX::dup2 ($v, $k)
            or POSIX::_exit (123);
      }

      # step 4, close everything else
      for (3..1023) { #TODO
         POSIX::close ($_)
            unless exists $redir{$_};
      }

      exec @$cmd;

      POSIX::_exit (126);
   }

   close $_ for values %redir;

   my $status;
   $cv->begin (sub { shift->send ($status) });
   my $cw; $cw = AE::child $pid, sub {
      $status = $_[1];
      undef $cw; $cv->end;
   };

   $cv
}

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->{node}{"#default"} ||= {};

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;

      my $cv = AE::cv;
      mon $port, $cv;
      my $reply = port { &$cv };
      snd node_of $port, relay => $reply, "ok";

      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};
   },
   forcetls => sub {
      @ARGV == 1
         or die "enable value missing\n";

      $nodecfg->{forcetls} = !!shift @ARGV;
      ++$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.2
Committed:	Mon Aug 10 02:07:02 2009 UTC (14 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.1:	+27 -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
15			# node configuration: secret
16			aemp gensecret # generate a random shared secret
17			aemp setsecret <secret> # set the shared secret
18			aemp clrsecret # remove the secret
19
20			# node configuration: TLS
21			aemp setcert <file> # set a certificate (key.pem + certificate.pem)
22			aemp clrcert # remove certificate
23			aemp gencert # generate a random certificate
24			aemp forcetls <0\|1> # enforce TLS connections?
25
26			=head1 DESCRIPTION
27
28			With aemp you can configure various aspects of AnyEvent::MP and it's protocol.
29
30			=cut
31
32			use common::sense;
33
34			use Carp ();
35
36			use AnyEvent;
37			use AnyEvent::MP::Config;
38			use AnyEvent::MP;
39
40			sub run_cmd {
41			my $cmd = shift;
42
43			require POSIX;
44
45			local $^F = 1023; #d#
46
47			my $cv = AE::cv;
48
49			my %redir;
50			my @exe;
51
52			while (@_) {
53			my $type = shift;
54
55			my $fd = $type =~ s/^(\d+)// ? $1 : undef;
56
57			if ($type eq ">") {
58			my ($pr, $pw) = AnyEvent::Util::portable_pipe;
59			my $cb = shift;
60
61			$cv->begin;
62			my $w; $w = AE::io $pr, 0,
63			"SCALAR" eq ref $cb
64			? sub {
65			sysread $pr, $$cb, 8192, length $$cb
66			and return;
67			undef $w; $cv->end;
68			}
69			: sub {
70			my $buf;
71			sysread $pr, $buf, 8192
72			and return $cb->($buf);
73			undef $w; $cv->end;
74			}
75			;
76			$redir{defined $fd ? $fd : 1} = $pw;
77
78	root	1.2	} elsif ($type eq "<") {
79			my ($pr, $pw) = AnyEvent::Util::portable_pipe;
80			my $cb = shift;
81
82			#TODO
83			# $cv->begin;
84			# my $w; $w = AE::io $pw, 0,
85			# "SCALAR" eq ref $cb
86			# ? sub {
87			# my $len = syswrite $pr, $$cb, 8192, length $$cb
88			# and return;
89			# undef $w; $cv->end;
90			# }
91			# : sub {
92			# my $buf;
93			# sysread $pr, $buf, 8192
94			# and return $cb->($buf);
95			# undef $w; $cv->end;
96			# }
97			# ;
98			# $redir{defined $fd ? $fd : 0} = $pr;
99
100	root	1.1	} elsif ($type =~ s/^>//) {
101			push @exe, sub {
102			open my $fh, ">", $type
103			or POSIX::_exit (125);
104			$redir{defined $fd ? $fd : 1} = $fh;
105			};
106
107			} elsif ($type =~ s/^<//) {
108			push @exe, sub {
109			open my $fh, "<", $type
110			or POSIX::_exit (125);
111			$redir{defined $fd ? $fd : 0} = $fh;
112			};
113			}
114			}
115
116			my $pid = fork;
117
118			defined $pid
119			or Carp::croak "fork: $!";
120
121			unless ($pid) {
122			# step 1, execute
123			$_->() for @exe;
124
125			# step 2, move any existing fd's out of the way
126			my @oldfh;
127			for my $fh (values %redir) {
128			push @oldfh, $fh;
129			$fh = fileno $fh;
130
131			defined ($fh = POSIX::dup ($fh)) or POSIX::_exit (124)
132			while exists $redir{$fh};
133			}
134
135			# step 3, execute redirects
136			while (my ($k, $v) = each %redir) {
137			defined POSIX::dup2 ($v, $k)
138			or POSIX::_exit (123);
139			}
140
141			# step 4, close everything else
142			for (3..1023) { #TODO
143			POSIX::close ($_)
144			unless exists $redir{$_};
145			}
146
147			exec @$cmd;
148
149			POSIX::_exit (126);
150			}
151
152			close $_ for values %redir;
153
154			my $status;
155			$cv->begin (sub { shift->send ($status) });
156			my $cw; $cw = AE::child $pid, sub {
157			$status = $_[1];
158			undef $cw; $cv->end;
159			};
160
161			$cv
162			}
163
164			sub my_run_cmd {
165			my ($cmd) = @_;
166
167			my $cv = &run_cmd;
168			my $status = $cv->recv;
169
170			$status
171			and die "@$cmd: command failed with exit status $status.";
172			}
173
174			sub gen_cert {
175	root	1.2	my_run_cmd [qw(openssl req
176			-new -nodes -x509 -days 3650
177			-newkey rsa:2048 -keyout /dev/fd/3
178			-batch -subj /CN=AnyEvent::MP
179			)],
180	root	1.1	"</dev/null",
181			">" , \my $cert,
182			"3>", \my $key,
183			"2>/dev/null";
184
185			"$cert$key"
186			}
187
188			our $cfg = \%AnyEvent::MP::Config::CFG;
189			our $nodecfg = $cfg->{node}{"#default"} \|\|= {};
190
191			sub resolve_port {
192			my ($node, $port) = split /#/, $_[0], 2;
193
194			$node = (resolve_node $node)->recv;
195			"$node#$port"
196			}
197
198			our %CMD = (
199			snd => sub {
200			my $port = resolve_port shift @ARGV;
201			initialise_node "slave/", node_of $port;
202
203			snd $port, @ARGV;
204
205			my $cv = AE::cv;
206			mon $port, $cv;
207			my $reply = port { &$cv };
208			snd node_of $port, relay => $reply, "ok";
209
210			print join " ", $cv->recv, "\n";
211			},
212
213			mon => sub {
214			my $port = resolve_port shift @ARGV;
215			initialise_node "slave/", node_of $port;
216
217			mon $port, my $cv = AE::cv;
218			print join " ", $cv->recv, "\n";
219			},
220
221			setsecret => sub {
222			@ARGV == 1
223			or die "shared secret missing\n";
224
225			$nodecfg->{secret} = shift @ARGV;
226			++$cfg->{dirty};
227			},
228			gensecret => sub {
229			$nodecfg->{secret} = AnyEvent::MP::Base::asciibits AnyEvent::MP::Base::nonce 64;
230			++$cfg->{dirty};
231			},
232			clrsecret => sub {
233			delete $nodecfg->{secret};
234			++$cfg->{dirty};
235			},
236
237			setcert => sub {
238			@ARGV == 1
239			or die "key+certificate pem filename missing\n";
240
241			open my $fh, "<", $ARGV[0]
242			or die "$ARGV[0]: $!";
243
244			local $/;
245			$nodecfg->{cert} = <$fh>;
246			++$cfg->{dirty};
247			},
248			gencert => sub {
249			$nodecfg->{cert} = gen_cert;
250			++$cfg->{dirty};
251			},
252			clrcert => sub {
253			delete $nodecfg->{cert};
254			++$cfg->{dirty};
255			},
256			forcetls => sub {
257			@ARGV == 1
258			or die "enable value missing\n";
259
260			$nodecfg->{forcetls} = !!shift @ARGV;
261			++$cfg->{dirty};
262			},
263			);
264
265			sub docmd {
266			my $cmd = shift @ARGV;
267
268			$CMD{$cmd}
269			or die "$cmd: no such aemp command (try man aemp)";
270
271			$CMD{$cmd}();
272			}
273
274			@ARGV
275			or die "Usage: aemp subcommand ... (try man aemp)\n";
276
277			docmd;
278
279