1 # Copyright (c) 2009-2012 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or
4 # modify it under the terms of the GNU General Public License
5 # as published by the Free Software Foundation; either version 2
6 # of the License, or (at your option) any later version.
8 # This program is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13 # You should have received a copy of the GNU General Public License along
14 # with this program; if not, write to the Free Software Foundation, Inc.,
15 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
20 use Test::More tests => 6;
24 use lib "@amperldir@";
26 use Amanda::IPC::LineProtocol;
34 # Define a test protocol
37 use base "Amanda::IPC::LineProtocol";
38 use Amanda::IPC::LineProtocol;
40 use constant SIMPLE => message("SIMPLE",
44 use constant FOO => message("FOO",
45 format => [ qw( name? nicknames* ) ],
48 use constant FO => message("FO", # prefix of "FOO"
52 use constant ASSYM => message("ASSYM",
59 use constant BAR => message("BAR",
60 match => qr/^BA[Rh]$/i, # more elaborate regex
61 format => [ qw( mandatory optional? ) ],
64 use constant QUIT => message("QUIT",
67 format => [ qw( reason? ) ],
72 # set up debugging so debug output doesn't interfere with test results
73 Amanda::Debug::dbopen("installcheck");
74 Installcheck::log_test_output();
76 # and disable Debug's die() and warn() overrides
77 Amanda::Debug::disable_die_override();
79 # run $code in a separate process, with read and write handles hooked up, and returns
80 # read and write handles.
84 my ($parent_read, $child_write) = POSIX::pipe();
85 my ($child_read, $parent_write) = POSIX::pipe();
88 if (!defined($pid) or $pid < 0) {
89 die("Can't fork: $!");
95 # get our file-handle house in order
96 POSIX::close($parent_read);
97 POSIX::close($parent_write);
99 $code->(IO::Handle->new_from_fd($child_read, "r"),
100 IO::Handle->new_from_fd($child_write, "w"));
106 POSIX::close($child_read);
107 POSIX::close($child_write);
109 return (IO::Handle->new_from_fd($parent_read, "r"),
110 IO::Handle->new_from_fd($parent_write, "w"),
114 # generic "die" message_cb
115 my $message_cb = make_cb(message_cb => sub {
116 my ($msgtype, %params) = @_;
117 if (defined $msgtype) {
118 diag(Dumper(\%params));
119 die("unhandled message: $msgtype");
121 die("IPC error: $params{'error'}");
130 my ($rx_fh, $tx_fh, $pid);
132 # on QUIT, stop the protocol and quit the mainloop
133 my $quit_cb = make_cb(quit_cb => sub {
134 push @events, [ @_ ];
135 $proto->stop(finished_cb => sub {
136 Amanda::MainLoop::quit();
142 # test a simple "QUIT"
145 ($rx_fh, $tx_fh, $pid) = in_fork(sub {
146 my ($rdh, $wrh) = @_;
149 $rdh->getline(); # get 'start\n'
150 $wrh->write("QUIT \"just because\"");
153 $proto = TestProtocol->new(
154 rx_fh => $rx_fh, tx_fh => $tx_fh,
155 message_cb => $message_cb);
156 $proto->set_message_cb(TestProtocol::QUIT, $quit_cb);
157 Amanda::MainLoop::call_later(sub {
158 $tx_fh->autoflush(1);
159 $tx_fh->write("start\n");
161 Amanda::MainLoop::run();
164 is_deeply([ @events ],
166 [ "QUIT", reason => "just because" ],
169 "correct events for a simple 'QUIT \"just because\"")
170 or diag(Dumper(\@events));
174 # test a bogus message
177 ($rx_fh, $tx_fh, $pid) = in_fork(sub {
178 my ($rdh, $wrh) = @_;
181 $rdh->getline(); # get 'start\n'
182 $wrh->write("SNARSBLAT, yo");
185 $proto = TestProtocol->new(
186 rx_fh => $rx_fh, tx_fh => $tx_fh,
187 message_cb => sub { push @events, [ @_ ]; });
188 $proto->set_message_cb(TestProtocol::QUIT, $quit_cb);
189 Amanda::MainLoop::call_later(sub {
190 $tx_fh->autoflush(1);
191 $tx_fh->write("start\n");
193 Amanda::MainLoop::run();
196 is_deeply([ @events ],
198 [ undef, 'error' => 'unknown command' ],
199 [ "QUIT" ], # from EOF
201 "bogus message handled correctly")
202 or diag(Dumper(\@events));
206 # a more complex conversation
209 ($rx_fh, $tx_fh, $pid) = in_fork(sub {
210 my ($rdh, $wrh) = @_;
213 $wrh->write("FOO\n");
214 $rdh->getline() =~ /SIMPLE/ or die("bad response");
216 $wrh->write("FOO one\n");
217 $rdh->getline() =~ /SIMPLE/ or die("bad response");
219 $wrh->write("FOO one \"t w o\"\n");
220 $rdh->getline() =~ /SIMPLE/ or die("bad response");
222 $wrh->write("FOO one \"t w o\" three\n");
223 $rdh->getline() =~ /SIMPLE/ or die("bad response");
226 $proto = TestProtocol->new(
227 rx_fh => $rx_fh, tx_fh => $tx_fh,
228 message_cb => $message_cb);
229 $proto->set_message_cb(TestProtocol::QUIT, $quit_cb);
230 $proto->set_message_cb(TestProtocol::FOO, sub {
231 push @events, [ shift @_, { @_ } ];
232 $proto->send(TestProtocol::SIMPLE);
234 Amanda::MainLoop::run();
237 is_deeply([ @events ],
239 [ "FOO", { nicknames => [] } ],
240 [ "FOO", { nicknames => [], name => "one" } ],
241 [ "FOO", { nicknames => [ "t w o" ], name => "one" } ],
242 [ "FOO", { nicknames => [ "t w o", "three" ], name => "one" } ],
245 "correct events for a few conversation steps, parsing")
246 or diag(Dumper(\@events));
249 # Asymmetrical formats
252 ($rx_fh, $tx_fh, $pid) = in_fork(sub {
253 my ($rdh, $wrh) = @_;
256 $wrh->write("ASSYM 1 2\n");
257 $rdh->getline() =~ /ASSYM a/ or die("bad response");
260 $proto = TestProtocol->new(
261 rx_fh => $rx_fh, tx_fh => $tx_fh,
262 message_cb => $message_cb);
263 $proto->set_message_cb(TestProtocol::QUIT, $quit_cb);
264 $proto->set_message_cb(TestProtocol::ASSYM, sub {
265 push @events, [ shift @_, { @_ } ];
266 $proto->send(TestProtocol::ASSYM, x => "a");
268 Amanda::MainLoop::run();
271 is_deeply([ @events ],
273 [ "ASSYM", { a => "1", b => "2" } ],
276 "correct events for asymmetric message format")
277 or diag(Dumper(\@events));
281 # test queueing up of messages on writing.
283 # The idea here is to write more than a pipe buffer can hold, while the child
284 # process does not read that data, and then to signal the child process,
285 # causing it to read all of that data, write a reply, and exit. Recent linuxes
286 # have a pipe buffer of 64k, so we exceed that threshold. We use an 'alarm' to
287 # fail in the case that this blocks.
292 ($rx_fh, $tx_fh, $pid) = in_fork(sub {
293 my ($rdh, $wrh) = @_;
296 # on USR1, read lots of inputs
298 for (my $i = 0; $i < $NMSGS; $i++) {
302 # send a message that the parent can hope to get
303 $wrh->write("BAR \"got your inputs\"\n");
309 $wrh->write("SIMPLE\n");
311 # and sleep forever, or until killed.
312 while (1) { sleep(100); }
315 $proto = TestProtocol->new(
316 rx_fh => $rx_fh, tx_fh => $tx_fh,
317 message_cb => $message_cb);
318 $proto->set_message_cb(TestProtocol::QUIT, $quit_cb);
319 $proto->set_message_cb(TestProtocol::SIMPLE, sub {
320 push @events, [ shift @_ ];
321 # send $NMSGS messages to the child, which isn't listening yet!
322 for (my $i = 0; $i < $NMSGS; $i++) {
323 $proto->send(TestProtocol::SIMPLE);
325 # and then send it SIGUSR1, so it reads those
328 $proto->set_message_cb(TestProtocol::BAR, sub {
329 push @events, [ shift @_, { @_ } ];
332 # die after 10 minutes
335 Amanda::MainLoop::run();
337 alarm 0; # cancel the alarm
339 is_deeply([ @events ],
342 [ "BAR", { mandatory => "got your inputs" } ],
345 "write buffering handled correctly")
346 or diag(Dumper(\@events));
349 # test the message_obj functionality
351 package main::MessageObj;
355 push @{$self}, [ shift @_, { @_ } ];
356 $proto->send(TestProtocol::SIMPLE);
361 push @{$self}, [ shift @_, { @_ } ];
362 $proto->send(TestProtocol::SIMPLE);
368 ($rx_fh, $tx_fh, $pid) = in_fork(sub {
369 my ($rdh, $wrh) = @_;
372 $wrh->write("FOO\n");
373 $rdh->getline() =~ /SIMPLE/ or die("bad response");
375 $wrh->write("BAR one\n");
376 $rdh->getline() =~ /SIMPLE/ or die("bad response");
378 $wrh->write("BAH one \"t w o\"\n"); # note alternate spelling "BAH"
379 $rdh->getline() =~ /SIMPLE/ or die("bad response");
381 $wrh->write("FOO one \"t w o\" three\n");
382 $rdh->getline() =~ /SIMPLE/ or die("bad response");
385 $proto = TestProtocol->new(
386 rx_fh => $rx_fh, tx_fh => $tx_fh,
387 message_obj => bless(\@events, "main::MessageObj"));
388 $proto->set_message_cb(TestProtocol::QUIT, $quit_cb);
389 Amanda::MainLoop::run();
392 is_deeply([ @events ],
393 [ [ 'FOO', { 'nicknames' => [] } ],
394 [ 'BAR', { 'mandatory' => 'one' } ],
395 [ 'BAR', { 'mandatory' => 'one', 'optional' => 't w o' } ],
396 [ 'FOO', { 'name' => 'one', 'nicknames' => [ 't w o', 'three' ] } ],
400 or diag(Dumper(\@events));