} else {
    print("Un-handled command -- $the_command\n");
    return(-1);
}
[download]

Note to Ian and chromatic -- after reading your book I have come to the conclusion that there is **nothing** that is un-testable. You just have to look in the right chapter of PTaDN.... </code>

I'm trying to apply the mocking technique shown on pp. 85-86 of "Perl Testing A Developer's Notebook" using Perl 5.14.2. It works for module subroutines, but not for system():

2014-03-20 15:53:01 dpchrist@p43200 ~/sandbox/perl
$ cat mock-system.pl 
#! /usr/bin/perl
use strict;
use warnings;
$| = 1;

package Foo;

sub foo { system @_ }

package main;

print Foo::foo("echo", "-n", __LINE__ . "\n"), "\n";

{
    package Foo;
    use subs "system";
    package main;
    *Foo::system = sub { print "mock system() called: @_"; 1 };
    print Foo::foo("echo", "-n", __LINE__ . "\n"), "\n";
}

{
    package Foo;
    use subs "foo";
    package main;
    *Foo::foo = sub { print "mock foo() called: @_"; 2 };
    print Foo::foo("echo", "-n", __LINE__ . "\n"), "\n";
}

2014-03-20 15:53:06 dpchrist@p43200 ~/sandbox/perl
$ perl mock-system.pl 
12
0
19
0
Subroutine Foo::foo redefined at mock-system.pl line 26.
mock foo() called: echo -n 27
2
[download]

Does anybody know why the technique doesn't work for system()?

I don't think there's a pure Perl solution... However, you could try to intercept the underlying execvp library function call (at least on unix-ish systems — I think Windows uses spawn). Then, in your wrapper function you could decide what to do, e.g. return fake results, or just pass through to the real function...  I know this is highly platform dependent, ugly and probably otherwise tricky in a number of ways... but anyhow, these would be the basic steps — just to illustrate the idea... (quite a number of issues remain to be solved!)

Demo perl program

#!/usr/bin/perl

system "/bin/echo", "hello";
# or
# system "/bin/echo hello";
# or 
# my $out = `/bin/echo hello`;
[download]

This is the sample wrapper library, which does nothing except printing a message to stderr, and then forwarding the call to the original library function:

/* fakesys.c */
#include <unistd.h>   /* for execvp */
#include <dlfcn.h>    /* for dlsym */
#include <stdio.h>

static int (*real_execvp)(const char *file, char *const argv[]);

int execvp(const char *file, char *const argv[]) {
    char *msg;
    
    /* lookup original shared lib function */
    real_execvp = dlsym(RTLD_NEXT, "execvp");   /* see dlsym(3) */
    if ( (msg = dlerror() ) != NULL ) {
        fprintf(stderr, "dlopen of execvp() failed : %s\n", msg);
    }
    
    fprintf(stderr, "calling execvp(\"%s\", ...)\n", file);
    
    /* execute original lib function */
    return real_execvp(file, argv);
}
[download]

Compile a shared lib (on Linux):

$ gcc -D_GNU_SOURCE -fPIC -shared fakesys.c -o libfakesys.so
[download]

and call the program with the intercepted execvp call, using the LD_PRELOAD mechanism (—> "man ld-linux.so"):

$ LD_PRELOAD=./libfakesys.so perl ./685699.pl
[download]

Output:

calling execvp("/bin/echo", ...)
hello
[download]

You get the idea... :)

spawn() is just a wrapper for DOS compatibility. There are WinExec, ShellExecute, ShellExecuteEx, CreateProcess, CreateProcessEx, CreateProcessAsUser, CreateProcessWithLogonW, CreateProcessWithTokenW, and perhaps another dozen of functions and wrappers for creating a process in different ways, and with ridiculusly complicated data structures for input and output parameters. It's just pain once you understand how simple and elegant fork() and exec() are. Hooking those Windows functions may be possible, some have documented hook functions, others don't.

On Unix (Linux), the fakeroot package (a Debian project) may help, perhaps combined with chroot. chroot the entire script collection in a root jail, then run perl as unprivileged user via fakeroot. While everything seems to be a "real" root environment, it isn't. All files belong the unprivileged user, and if they don't, the faked root simply can't open/read/modify/delete them -- unless you give explicit permissions to the unprivileged user. And thanks to chroot, a rm -rf / "just" damages the root jail, which can be restored with a simple tar xf.

Alexander

Alternatively, I'd look into running your program in some sort of sandbox (a chroot-ed environment or even a virtual machine), so that it can do something like rm -rf / without affecting your system.

I know I can replace system via *CORE::GLOBAL::system

Actually, you can't. system isn't overridable

>perl -le"print defined(prototype('CORE::system'))?1:0"
0
[download]

If you could override readpipe, then you could override backticks, since they're the same thing, but you can't.

(Perl 5.8.8)

Hmm, if that's true why does this work for me on v5.8.8?

$ perl -e 'BEGIN { *CORE::GLOBAL::system = sub { print "hello $_[0]\n"
+ } } system "foo"'
hello foo
[download]

I think overriding with *CORE::GLOBAL::system does actually work in most cases... The main reason that system doesn't have a prototype (which could be specified with Perl's prototype system), and thus is formally not overridable, is its "indirect object" syntax (without a comma after the first argument — see exec), which you can't (syntactically) handle with a Perl routine... As long as you don't need it, you should be fine. (But there would still be the problem with overriding backticks, as you're saying.)

Update: Here's a sample command using this indirect object syntax

system {'bash'} 'zsh', '-c', 'echo I think I am a $0';
# outputs "I think I am a zsh" (although it's a bash)
[download]

which works fine as long as system isn't overridden. If you try to override it, you'd just get a compile-time error

syntax error at ./685741.pl line 7, near "} 'zsh'"
Execution of ./685741.pl aborted due to compilation errors.
[download]

Perhaps you could replace your path variable for your tests. Remove all directories containing 'sensitive' commands, and then write a program for each command you'll call with system that simply prints some boilerplate for you to test against.

• calls system on the command, redirecting STDOUT to a fixed name (say, /log/application.out)
• if successful, read the file back in

...but that won't help if the "commands are either executable only by the root-user and/or do things you'd rather not do in a test" — as desired by the OP.

I just want to clarify: You want to test code that you don't control, right? If it were your own code, you could just change it to do something other than system() and backticks.

Can you tell us more about the job this code is doing? Even if we can't figure out how to bamboozle system(), backticks, etc, we might be able to come up with an alternative approach.

--Pileofrogs

The script runs a handful of root-owned commands and parses the output to gather information into a reporting system.

For my own sake I'd like to add some basic automated tests which make it simple to run this and other scripts as a non-root user, both for development purposes, and to have some regression tests in place.

It's code I currently control, so refactoring is an option, but I'd rather avoid refactoring something which works into something that imposes what may be perceived as pointless complexity on future custodians.

So, I was hoping for was a module someone had already written, or a simple trick, which could do this fairly transparently and effortlessly.

By the way, thanks for the suggestions so far, it's always educational to ask for help. I quite like the PATH idea, and overriding readpipe is in fact doable in the same way as it is for system, but a quick experiment suggests that it's not that easy to change the behaviour of backticks:

 $ perl -le 'BEGIN { *CORE::GLOBAL::readpipe = sub { print "hello $_[0
+]" } } readpipe "foo";  `bar` '
hello foo
[download]

Trapping all exits from perl may indeed make your code too complex.

I like pc88mxer's idea above of controlling your test environment with a VM or chroot solution. This way you can "mock" the expected, root owned external commands as you see fit w/o touching your perl code.

open() also needs to be checked. Running into open PIPE,"| /bin/rm -rf / > /dev/null 2>&1" as root would be rather unpleasant.

Alexander

Indeed that's true, and ideally this would be trapped/mocked also, but in this case I don't need to.

When I work on code that makes expensive calls to external programs, I mock the dynamic data with cat. I make a static copy of real output (e.g. $ du / > du.txt ) and then I change $binary in my script.

my $du = '/bin/du';
defined $DEBUG and $du = '/bin/cat ./du.txt';
[download]

Perhaps something like that could work for you.

Why are some keywords not overridable? The main reason is that those keywords are used as part of some further parsing magic, i.e. they don't follow the usual function call style parsing.

The good news is that change #29168 to perl made qx// overridable. Hooray! That was released in Perl 5.9.5, and will eventually make it to a maintenance release as Perl 5.10.1. When that happens, setting *CORE::GLOBAL::readpipe will override readpipe(), qx// and ``.

http://search.cpan.org/~kyz/Test-MockCommand-0.02/