So here's why I just fixed that bug in Test::Builder....
The situation is thus: I've got a little script that's used to
start/restart and stop the ssh daemon. I want to test that it can in
fact stop the ssh daemon. Unfortunately, I ssh'd into that machine!
So stopping it would be Bad. [1]
A TCL test engineer at TPC last year gave me a technique to handle
this. It takes advantage of Perl's ability to replace existing
functions at run-time.
The sshd-stop script basically does its work like so:
use utils;
# this calls /etc/init.d/sshd stop
serviceControl( NAME => 'sshd', ACTION => 'stop' );
# this then kills all existing connections.
killall('HUP', 'sshd');
so the plan is to literally replace serviceControl() and killall()
with stub functions that do nothing but check it got the right
arguments. So write up a little module and run the ssh-stop script
system( $^X, '-It/lib', '-Mreload_overrides', $Original_File );
is( $?, 0, 'ran myself ok' );
the clever thing there is we're loading a little module,
reload_overrides.pm, that plants our stub functions. It looks like
this...
use Test::More 'no_plan';
# Here we tell the test to not use any numbers (because there were
# probably tests output'd before us) and to not do end-of-test
# checks.
my $TB = Test::More->builder;
$TB->use_numbers(0);
$TB->no_ending(1);
first thing that's going on here is we're telling the underlying
Test::Builder object to not use numbers and don't do any extra
processing at the end of the test. This is because it will be run in
a seperate process from the test script itself.
use util;
use util::system;
we load our victims so that when the sshd-stop script goes to load
them it won't blow over our overrides.
package util;
::can_ok('util', 'serviceControl');
no warnings 'redefine';
sub serviceControl {
my(%params) = @_;
::pass('service control called');
::is( $params{NAME}, 'sshd', 'serviceControl NAME == sshd' );
::is( $params{ACTION}, 'stop', ' ACTION == stop' );
return 1;
}
so this is a simple override. First we check to make sure that
serviceControl() is already loaded. Then we tell perl to not warn us
about redefining the function.
The function itself is very simple. It just reads in the arguments
and makes sure its what we expect them to be. We assume that the real
serviceControl() works, so all we care about is how its called.
package util::system;
::can_ok('esmith::util::system', 'killall');
no warnings 'redefine';
sub killall {
my($sig, @commands) = @_;
::pass('killall called');
::is( $sig, 'HUP', ' with a HUP' );
::is( @commands, 1, ' one command' );
::is( $commands[0], 'sshd', ' for sshd' );
return 1;
}
and here's the same for killall().
It has to be called with some care, making sure that we take into
account that the subprocess will be running some tests of its own to
make the test counters all work out.
# this will run 9 tests.
my $tb = Test::More->builder;
$tb->current_test($tb->current_test + 9);
system( $^X, '-It/lib', -Mreload_overrides', $Original_File );
is( $?, 0, 'ran myself ok' );
and the result looks something like this:
ok 1 - ran myself ok
ok 2 - sshd lockfile touched
ok - esmith::util->can(serviceControl)
ok - esmith::util::system->can(killall)
ok - service control called
ok - serviceControl NAME == sshd
ok - ACTION == stop
ok - killall called
ok - with a HUP
ok - one command
ok - for sshd
ok 12 - ran myself ok
ok 13 - ran myself ok
ok 14 - sshd lockfile untouched
1..14
the unnumbered tests are coming from the subprocess. They're
surrounded by the rest of the normal test script.
And that's how you can test something that's otherwise destructive.
Questions? :)
[1] Its not just stop. Its "stop with extreme prejudice". It kills
all existing connections.
--
Michael G. Schwern <[EMAIL PROTECTED]> http://www.pobox.com/~schwern/
Perl Quality Assurance <[EMAIL PROTECTED]> Kwalitee Is Job One
Beer still cheaper than crack!
