initial commit of file from CVS for e-smith-test on Wed 12 Jul 09:10:30 BST 2023

2023-07-12 09:10:30 +01:00
parent 54e4f39dbc
commit b7c1628cf6
18 changed files with 2081 additions and 2 deletions
--- a/root/etc/e-smith/events/actions/testing-conf
+++ b/root/etc/e-smith/events/actions/testing-conf
@@ -0,0 +1,72 @@
+#!/usr/bin/perl -w
+
+#----------------------------------------------------------------------
+# Copyright 1999-2003 Mitel Networks Corporation
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#----------------------------------------------------------------------
+
+=head1 NAME 
+
+testing-conf -- configure testing service
+
+=head1 DESCRIPTION
+
+This action sets up the testing service when you first install
+e-smith-test, setting the "destruction" property to 0 (non-destructive).
+It is a no-op if the "destruction" property is already defined.
+
+=begin testing
+
+use esmith::ConfigDB;
+
+$ENV{ESMITH_CONFIG_DB} = "00e-smith-test/configuration";
+unlink $ENV{ESMITH_CONFIG_DB};
+
+ok(my $conf         = esmith::ConfigDB->create(), "Create new config file");
+ok(my $test_service = $conf->new_record('testing', {type => 'service'}), 
+                      "Create new record for testing service");
+isa_ok($test_service, 'esmith::DB::Record');
+
+ok(not(defined($test_service->prop('destruction'))),
+    "Testing should be absent before we run");
+
+is(system("$^X $Original_File"), 0, "System command returned 0");
+$conf = esmith::ConfigDB->open();
+$test_service = $conf->get('testing');
+ok(defined($test_service->prop('destruction')), "Destruction is now defined");
+
+$test_service->set_prop('destruction', 1);
+is(system("$^X $Original_File"), 0, "System command returned 0");
+$conf = esmith::ConfigDB->open();
+$test_service = $conf->get('testing');
+is($test_service->prop('destruction'), 1,
+    "Destruction is left alone if already defined");
+
+$test_service->set_prop('destruction', 0);
+is(system("$^X $Original_File"), 0, "System command returned 0");
+$conf = esmith::ConfigDB->open();
+$test_service = $conf->get('testing');
+is($test_service->prop('destruction'), 0,
+    "Destruction is left alone if already defined, even if 0");
+
+=end testing
+
+=cut
+
+use strict;
+use esmith::ConfigDB;
+
+my $conf = esmith::ConfigDB->open()
+    or die "Configuration database does not exist";
+
+if (my $test_service = $conf->get('testing') 
+    || $conf->new_record('testing', { type => 'service'} )) 
+{
+    unless (defined $test_service->prop('destruction')) 
+    {
+        $test_service->set_prop('destruction', 0);
+    }
+}
+
+exit 0;
--- a/root/etc/e-smith/events/e-smith-test-update/.gitignore
+++ b/root/etc/e-smith/events/e-smith-test-update/.gitignore
--- a/root/etc/e-smith/tests/00e-smith-test/00sanity.t
+++ b/root/etc/e-smith/tests/00e-smith-test/00sanity.t
@@ -0,0 +1,20 @@
+#!/usr/bin/perl -w
+
+#----------------------------------------------------------------------
+# Copyright 1999-2003 Mitel Networks Corporation
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#----------------------------------------------------------------------
+
+use strict;
+use Test::More tests => 8;
+
+require_ok("Test::Harness");
+require_ok("Test::More");
+require_ok("Test::Inline");
+require_ok("WWW::Automate");
+require_ok("Test::Simple");
+require_ok("esmith::TestUtils");
+
+ok(-e "/etc/e-smith/tests", "Test directory exists");
+ok(-d "/etc/e-smith/tests", "Test directory is a directory");
--- a/root/etc/e-smith/tests/accounts.conf
+++ b/root/etc/e-smith/tests/accounts.conf
@@ -0,0 +1,82 @@
+# DO NOT MODIFY THIS FILE.
+# This file is automatically maintained by the Mitel Networks SME Server
+# configuration software.  Manually editing this file may put your 
+# system in an unknown state.
+#
+# updated: Tue Feb 26 13:56:13 2002
+Bart.Simpson=pseudonym|Account|bart
+Bart_Simpson=pseudonym|Account|bart
+Global=system
+Primary=system
+adm=system|Gid|4|Uid|3
+admin=system|Gid|101|Uid|101
+alias=system|Gid|400|Uid|400
+apache=existing|Gid|48|Uid|48
+bart=user|FirstName|Bart|LastName|Simpson
+bin=system|Gid|1|Uid|1
+cdrom=system
+cgi-bin=url
+console=system
+daemon=system|Gid|2|Uid|2
+dip=system|Gid|40
+disk=system|Gid|6
+dns=existing|Gid|53|Uid|53
+e-smith-manager=url
+e-smith-password=url
+everyone=pseudonym|Account|shared|Visible|internal
+floppy=system|Gid|19
+ftp=system|Gid|50|Uid|14
+games=system|Gid|20|Uid|12
+global=system
+gopher=system|Gid|30|Uid|13
+halt=system
+homes=system
+kmem=system|Gid|9
+ldap=existing|Gid|55|Uid|55
+lp=system|Gid|7|Uid|4
+mail=system|Gid|12|Uid|8
+mailer-daemon=pseudonym|Account|admin
+man=system|Gid|15
+mem=system|Gid|8
+mysql=existing|Gid|27|Uid|27
+named=existing|Gid|25|Uid|25
+netlogon=netlogon|Comment|placeholder for netlogon share
+news=system|Gid|13|Uid|9
+nobody=system|Gid|99|Uid|99
+nofiles=system|Gid|400
+operator=system|Gid|0|Uid|11
+postgres=system
+postmaster=pseudonym|Account|admin
+primary=system
+printers=system
+public=system|Gid|103|Uid|102
+qmail=system|Gid|401
+qmaild=system|Gid|400|Uid|401
+qmaill=system|Gid|400|Uid|402
+qmailp=system|Gid|400|Uid|403
+qmailq=system|Gid|401|Uid|404
+qmailr=system|Gid|401|Uid|405
+qmails=system|Gid|401|Uid|406
+qmailscan=existing|Gid|407|Uid|407
+root=system|Gid|0|Uid|0
+schwern=user|Uid|500|Gid|501|FirstName|Michael|LastName|Schwern
+server-manager=url
+server-manual=url
+shared=system|Gid|500|Visible|internal
+shutdown=system
+simpsons=group|Description|bar|Gid|5005|Members|bart,lisa,homer|Uid|5005
+slocate=system
+somegroup=group|Gid|42
+squid=system|Gid|23|Uid|23
+sync=system
+sys=system|Gid|3
+trend=existing|Gid|408|Uid|408
+tty=system|Gid|5
+user-password=url
+users=system|Gid|100
+utmp=system|Gid|22
+uucp=system|Gid|14|Uid|10
+webmail=url
+wheel=system|Gid|10
+www=system|Gid|102|Uid|100
+wwwpublic=system
--- a/root/etc/e-smith/tests/configuration.conf
+++ b/root/etc/e-smith/tests/configuration.conf
@@ -0,0 +1,102 @@
+# DO NOT MODIFY THIS FILE.
+# This file is automatically maintained by the Mitel Networks SME Server
+# configuration software.  Manually editing this file may put your 
+# system in an unknown state. 
+#=
+#DomainName=e-smith.com
+AccessType=dedicated
+ActiveAccounts=0
+AdminEmail=
+ConsoleMode=login
+ContactEmail=
+ContactName=
+ContactOrg=
+DialupConnOffice=long
+DialupConnOutside=long
+DialupConnWeekend=long
+DialupFreqOffice=every15min
+DialupFreqOutside=everyhour
+DialupFreqWeekend=everyhour
+DialupModemDevice=/dev/ttyS1
+DialupPhoneNumber=
+DialupUserAccount=useraccount
+DialupUserPassword=userpassword
+DomainName=e-smith.com
+DynDnsAccount=dnsaccount
+DynDnsPassword=dnspassword
+DynDnsService=off
+EmailUnknownUser=return
+EthernetDriver1=pcnet32
+EthernetDriver2=unknown
+ExternalDHCP=off
+ExternalNetmask=255.255.255.0
+GatewayIP=192.168.16.1
+LocalIP=192.168.16.228
+LocalNetmask=255.255.255.0
+MinUid=5000
+PasswordSet=yes
+PreviousConfiguration=/home/e-smith/db/configuration.previous
+SMTPSmartHost=
+SambaDomainMaster=no
+SambaServerName=pretz
+SambaWorkgroup=mitel-networks
+ServiceAccountId=
+ServiceDomainName=
+ServiceTargetIP=
+SquidParent=
+SquidParentPort=
+StatusReports=off
+SystemMode=serveronly
+SystemName=pretz
+TimeZone=US/Eastern
+UnsavedChanges=yes
+atalk=service|InitscriptOrder|91|status|enabled
+auth=service|access|public|status|enabled
+blades=service|Host|service.e-smith.com|status|enabled
+bootstrap-console=service|InitscriptOrder|35|Run|no|status|enabled
+branding=service|modified|000000000000|status|enabled
+crond=service|InitscriptOrder|40|status|enabled
+ctrlaltdel=service|status|enabled
+dhcpd=service|InitscriptOrder|65|end|192.168.16.250|start|192.168.16.65|status|disabled
+diald=service|InitscriptOrder|57|status|disabled
+fetchmail=service|FreqOffice|every5min|FreqOutside|every30min|FreqWeekend|never|Method|standard|SecondaryMailAccount|popaccount|SecondaryMailPassword|poppassword|SecondaryMailServer|mail.myisp.xxx|status|disabled
+flexbackup=backupservice|erase_rewind_only|true
+ftp=service|access|private|accessLimits|off|status|enabled
+hdparm=service|InitscriptOrder|40|status|disabled
+horde=service|status|disabled
+httpd-admin=service|InitscriptOrder|86|status|enabled
+httpd-e-smith=service|InitscriptOrder|85|access|private|status|enabled
+imap=service|access|private|status|enabled
+imp=service|status|disabled
+ippp=service|InitscriptOrder|55|status|enabled
+ipsec=service|InitscriptOrder|90|PubKey|0sAQOoIKaOMuDqSdCZJXgv9QI86DAuAwbbvn8uoKn2lRQ9ZVPTn9Ow5znhuw/GopsYD2eujhtvkQo7fszAhWbEpn+lW2LzLCbZYaDov7j8Q9CpeJSVgeuzaBcw3OenSL3ltTwWWtG0pvyaYsfepNqVYvo64YVmrxo0O7dCECySMVBZkQ==|status|disabled
+isdn=service|Protocol|2|UseSyncPPP|yes|status|disabled
+keytable=service|InitscriptOrder|25|status|enabled
+ldap=service|InitscriptOrder|80|access|private|defaultCity|Ottawa|defaultCompany|XYZ Corporation|defaultDepartment|Main|defaultPhoneNumber|555-5555|defaultStreet|123 Main Street|status|enabled
+lilo=service|AddressMode|linear
+local=service|InitscriptOrder|99|status|enabled
+lpd=service|InitscriptOrder|60|status|enabled
+mariadb=service|InitscriptOrder|90|status|enabled
+masq=service|InitscriptOrder|06|Logging|none|Stealth|no|status|disabled
+modSSL=service|status|enabled
+mysql.init=service|InitscriptOrder|99|status|enabled
+named=service|chroot|yes|status|enabled
+network=service|InitscriptOrder|10|status|enabled
+ntpd=service|InitscriptOrder|55|status|disabled
+php=service|status|enabled
+popd=service|access|private|status|enabled
+pppoe=service|DemandIdleTime|no|InitscriptOrder|57|SynchronousPPP|no|status|disabled
+pptpd=service|sessions|10|status|disabled
+qmail=service|InitscriptOrder|80|status|enabled
+random=service|InitscriptOrder|20|status|enabled
+rsyslog=service|InitscriptOrder|05|status|enabled
+scanner=service|ScannerFns|iscan|UpdateTime|1:14|scanMail|yes|status|enabled
+smb=service|InitscriptOrder|91|RoamingProfiles|no|status|enabled
+smtpfwdd=service|InitscriptOrder|81|status|enabled
+squid=service|InitscriptOrder|90|status|enabled
+sshd=service|InitscriptOrder|85|PasswordAuthentication|yes|PermitRootLogin|yes|access|private|status|enabled
+sync=service|Host|service.e-smith.com|LastId|0|SuccessId|0|SyncFrequency|1|SyncMinute|57|status|disabled
+telnet=service|access|private|status|disabled
+testing=service|destruction|1
+wibble=42
+xinetd=service|InitscriptOrder|50|status|enabled
--- a/root/sbin/e-smith/quicktest
+++ b/root/sbin/e-smith/quicktest
@@ -0,0 +1,325 @@
+#!/usr/bin/perl -w
+#----------------------------------------------------------------------
+# Copyright 1999-2003 Mitel Networks Corporation
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#----------------------------------------------------------------------
+
+=head1 NAME
+
+quicktest - quickly run all tests in the current CVS project
+
+=head1 SYNOPSIS
+
+  quicktest
+  quicktest [files ...] [--verbose]
+
+  quicktest [-d] [--verbose] file
+
+
+=head1 DESCRIPTION
+
+This is a little script to let you quickly run your tests while making
+changes to an existing e-smith RPM project.
+
+Unless given a specific set of files to run, it will run all .t files
+and embedded tests in the current CVS project.  It allows you to do a
+quick test of the RPM without having to do much figuring or typing.
+
+It will also use any perl libraries located in the current CVS
+project.
+
+The "current CVS project" is defined by whatever CVS project you're
+current working directory is in.  So if you're sitting in
+~/devel/e-smith-base/root/usr/ it will assume your project is
+e-smith-base.
+
+Emacs backup files, CVS backup files and other temporary and backup
+files will be automatically skipped.
+
+All tests will be run with warnings on.
+
+=head2 Switches
+
+=over 4
+
+=item B<-d>
+
+Tells quicktest to run the test in the debugger.  It will gracefully
+handle embedded tests.
+
+    quicktest -d lib/some/module.pm
+
+=item B<--verbose>
+
+With --verbose quicktest will print out all the lines received from
+the test.
+
+=back
+
+=head1 FILES
+
+  CVS/Repository
+
+=head1 AUTHOR
+
+Mitel Networks Corporation.
+
+For more information, see http://www.e-smith.org/
+
+=cut
+
+use strict;
+use File::Find;
+use File::Spec;
+
+$| = 1;
+
+open(my $repository, 'CVS/Repository') || 
+    die "Can't find a CVS/Repository to look at: $!";
+my $path = <$repository>;
+close $repository;
+
+my($project) = $path =~ m{^([^/]+)};
+chomp $project;
+print STDERR "Testing '$project'\n";
+
+
+use Getopt::Long;
+
+my %Opts = ();
+GetOptions(\%Opts, 'd', 'verbose');
+
+my $Verbose = $ENV{HARNESS_VERBOSE} || $Opts{verbose};
+
+my @names = @ARGV;
+my @files = map File::Spec->rel2abs($_), @ARGV;
+
+
+# Go to the top of the project.
+chomp $path;
+my $updir = join '/', ('..') x $path =~ tr|/||;
+chdir $updir if length $updir;
+
+my $test_dir = 'root/etc/e-smith/tests';
+die "Can't find $test_dir" unless -d $test_dir;
+
+chdir $test_dir;
+@files = map File::Spec->abs2rel($_), @files;
+
+
+# Use any libraries in this CVS repository.  Test::Harness will
+# automatically apply this to the tests.
+our $This_Lib =
+  File::Spec->rel2abs('../../../../root/usr/lib/perl5/site_perl');
+unshift @INC, $This_Lib;
+
+
+if($Opts{d}) {  # debugging
+    die "I need a file to debug.\n" unless @files;
+    die "You can only debug a single program at a time.\n" unless @files == 1;
+
+    my $file = $files[0];
+    my $name = $names[0];
+    warn "Debugging $file\n";
+    my $test_file = _test_file($file);
+    die "There are no tests in $name\n" unless $test_file;
+    system("PERL5LIB=$This_Lib $^X -d $test_file");
+    exit;
+}
+
+unless( @files ) {
+    find(sub { 
+             if( -d $_ and $_ eq 'CVS' ) {
+                 $File::Find::prune = 1;
+                 return;
+             }
+             return if /~$/ || /^\.#/;
+             push @files, $File::Find::name if -f $_ 
+         }, '../../../..'
+    );
+
+    @names = map { (my $name = $_) =~ s[(\.\./){4}root/][]g; $name } @files;
+}
+
+{
+    package My::Strap;
+    use Test::Harness::Straps;
+    our @ISA = qw(Test::Harness::Straps);
+
+    sub _display {
+        my($self, $out) = @_;
+        print $self->{_ml}."$out";
+    }
+
+    sub _print {
+        my($self) = shift;
+        print @_;
+    }
+}
+
+
+### This is using an experimental callback interface in
+### Test::Harness::Straps so it can print out test results as they
+### happen.  As the interface is experimental, check the changelog
+### before upgrading Test::Harness::Straps.
+
+my $s = My::Strap->new;
+
+my %handlers = (
+    bailout     => sub {
+        my($self, $line, $type, $totals) = @_;
+
+        die sprintf "FAILED--Further testing stopped%s\n",
+          $self->{bailout_reason} ? ": $self->{bailout_reason}" : '';
+    },
+    test        => sub {
+        my($self, $line, $type, $totals) = @_;
+        my $curr = $totals->{seen};
+
+        if( $totals->{details}[-1]{ok} ) {
+            $self->_display("ok $curr/$totals->{max}") unless $Verbose;
+        }
+        else {
+            $self->_display("NOK $curr") unless $Verbose;
+        }
+
+        if( $curr > $self->{'next'} ) {
+            $self->_print("Test output counter mismatch [test $curr]\n");
+        }
+        elsif( $curr < $self->{'next'} ) {
+            $self->_print("Confused test output: test $curr answered after ".
+                          "test ", $self->{next} - 1, "\n");
+#            $self->{'next'} = $curr;
+        }
+    },
+);
+
+$s->{callback} = sub {
+    my($self, $line, $type, $totals) = @_;
+    print $line if $Verbose;
+
+    $handlers{$type}->($self, $line, $type, $totals) if $handlers{$type};
+};
+
+
+close STDIN;  # else tests might hang waiting for input.
+
+
+# Iterate through each test or file and run that test.
+# Most of the code herein is for nice formatting.
+my $all_passing = 1;
+my $width = _leader_width(@names);
+$width = 70 if $width > 70;
+foreach my $idx (0..$#files) {
+    my($file, $name) = ($files[$idx], $names[$idx]);
+    my %result = ();
+
+    my $test_file = _test_file($file);
+    next unless $test_file;
+
+    my($leader, $ml) = _mk_leader($name, $width);
+    print $leader;
+    print "\n" if $Verbose;
+    $s->{_ml} = $ml;
+
+    local $ENV{HARNESS_PERL_SWITCHES} = '-w';
+    %result = $s->analyze_file($test_file);
+
+    $all_passing = 0 unless $result{passing};
+    $s->_display($result{passing} ? 'ok' : 'FAILED');
+    print "\n";
+}
+
+if( $all_passing ) {
+    print "All tests successful!\n"
+}
+else {
+    print "SOME TESTS FAILED!\n";
+}
+
+
+=begin private
+
+=over 4
+
+=item B<_test_file>
+
+    my $test_file = _test_file($file);
+
+Determines this $file is a test or has embedded tests and generates
+a runable $test_file based on this.
+
+=cut
+
+sub _test_file {
+    my $file = shift;
+
+    my $test_file;
+    if( $file =~ /\.t$/ ) {
+        $test_file = $file;
+    }
+    elsif( system("pod2test '$file' > /tmp/embedded$$.t") == 0 ) {
+        $test_file = "/tmp/embedded$$.t";
+    }
+
+    return $test_file;
+}
+
+=item B<_mk_leader>
+
+  my($leader, $ml) = _mk_leader($test_file, $width);
+
+Generates the 't/foo........' $leader for the given $test_file as well
+as a similar version which will overwrite the current line (by use of
+\r and such).  $ml may be empty if Test::Harness doesn't think you're
+on TTY.
+
+The $width is the width of the "yada/blah.." string.
+
+=cut
+
+sub _mk_leader {
+    my($te, $width) = @_;
+    chomp($te);
+    $te =~ s/\.\w+$/./;
+
+    if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
+    my $blank = (' ' x 77);
+    my $leader = "$te" . '.' x ($width - length($te));
+    my $ml = "";
+
+    $ml = "\r$blank\r$leader"
+      if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $ENV{HARNESS_VERBOSE};
+
+    return($leader, $ml);
+}
+
+=item B<_leader_width>
+
+  my($width) = _leader_width(@test_files);
+
+Calculates how wide the leader should be based on the length of the
+longest test name.
+
+=cut
+
+sub _leader_width {
+    my $maxlen = 0;
+    my $maxsuflen = 0;
+    foreach (@_) {
+        my $suf    = /\.(\w+)$/ ? $1 : '';
+        my $len    = length;
+        my $suflen = length $suf;
+        $maxlen    = $len    if $len    > $maxlen;
+        $maxsuflen = $suflen if $suflen > $maxsuflen;
+    }
+    # + 3 : we want three dots between the test name and the "ok"
+    return $maxlen + 3 - $maxsuflen;
+}
+
+=back
+
+=end private
+
+
--- a/root/sbin/e-smith/smoketest
+++ b/root/sbin/e-smith/smoketest
@@ -0,0 +1,62 @@
+#!/usr/bin/perl -w
+#----------------------------------------------------------------------
+# Copyright 1999-2003 Mitel Networks Corporation
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#----------------------------------------------------------------------
+
+=head1 NAME
+
+smoketest -- run a smoketest on the SMEServer
+
+=head1 SYNOPSIS
+
+  smoketest <test directory>
+
+=head1 DESCRIPTION
+
+This smoketest script walks the given I<test directory> (or
+F</etc/e-smith/tests> if none is given) looking for test scripts
+(F<*.t>).
+
+It runs these tests in turn, through Test::Harness, and generates a
+simple report telling you whether the tests passed or failed.
+
+All tests are run from the I<test directory>.
+
+=head1 AUTHOR
+
+Mitel Networks Corporation.
+
+For more information, see http://www.e-smith.org/
+
+=cut
+
+use strict;
+use File::Find;
+use Test::Harness;
+
+my $testdir = shift || "/etc/e-smith/tests";
+die "$testdir is not a directory\n" unless -d $testdir;
+chdir $testdir or die "Can't chdir into $testdir: $!\n";
+
+my @tests = ();
+find \&wanted, '.';
+# Let's sort to get the order correct
+
+if( @tests ) {
+    print "Running tests in $testdir.\n";
+    local $ENV{PERL5LIB} = '../../../usr/lib/perl5/site_perl';
+    runtests @tests;
+}
+else {
+    warn "No tests found in or below '$testdir'!\n";
+}
+
+sub wanted {
+    push @tests, $File::Find::name if /\.t$/;
+}
+
+
+
+
--- a/root/usr/share/perl5/vendor_perl/esmith/TestUtils.pm
+++ b/root/usr/share/perl5/vendor_perl/esmith/TestUtils.pm
@@ -0,0 +1,374 @@
+package    esmith::TestUtils;
+
+use strict;
+use Exporter;
+use Carp;
+use esmith::ConfigDB;
+use esmith::AccountsDB;
+use vars qw( @ISA @EXPORT);
+
+@ISA = qw( Exporter );
+@EXPORT = qw( 
+    destruction_ok
+
+    get_random_username 
+    new_random_username 
+
+    simulate_perl_program
+
+    scratch_copy
+);
+
+
+=head1 NAME
+
+esmith::TestUtils -- general utilities for writing esmith tests
+
+=head1 SYNOPSIS
+
+  my $username = get_random_username();
+  my $newuser  = new_random_username();
+
+  my $exit = simulate_perl_program($program);
+
+  if (destruction_ok()) { ... }
+
+  my $scratch_file = scratch_copy($file);
+
+=head1 DESCRIPTION
+
+This module provides a bunch of useful little utility routines to 
+facilitate writing tests on the SMEServer.
+
+=head2 destruction_ok()
+
+Returns true or false depending on whether or not it's OK for tests to be destructive 
+on this server.
+
+=for testing
+use_ok(esmith::TestUtils);
+is(destruction_ok(), 0, "Destruction turned off by default");
+$ENV{ESMITH_CONFIG_DB}  = "configuration.conf";
+is(destruction_ok(), 1, "Destruction turned on in config file");
+
+=cut
+
+sub destruction_ok {
+    if (my $configdb = esmith::ConfigDB->open()) {
+        if (my $test_record = $configdb->get('testing')) {
+	    if ($test_record->prop('destruction')) {
+                return 1;
+            }
+        }	
+    }
+    return 0;
+}
+
+=head2 get_random_username()
+
+    my $username = get_random_username;
+
+Gets a random username from the accounts database.
+
+=begin testing
+
+use_ok(esmith::AccountsDB);
+$ENV{ESMITH_ACCOUNT_DB} = "accounts.conf";
+$ENV{ESMITH_CONFIG_DB}  = "configuration.conf";
+
+my $u = get_random_username();
+my $accountdb = esmith::AccountsDB->open();
+my @users = $accountdb->users();
+@users = map { $_->key() } @users;
+ok((grep !/^$u$/, @users), "get_random_username got username $u from accounts");
+
+=end testing
+
+=cut
+
+sub get_random_username {
+    my $accountdb = esmith::AccountsDB->open();
+    my @users = $accountdb->users();
+    my $user = $users[rand(@users)];
+    return $user->key();
+}
+
+=head2 new_random_username()
+
+    my $username = new_random_username;
+
+Returns a random username (just a random string of at least 3 letters) which 
+is not yet in the accounts database.
+
+=begin testing
+
+my $u = new_random_username();
+use esmith::AccountsDB;
+my $accountdb = esmith::AccountsDB->open();
+my @users = $accountdb->users();
+@users = map { $_->key() } @users;
+ok((grep !/^$u$/, @users), "new_random_username invented new username $u");
+
+=end testing
+
+=cut
+
+sub new_random_username {
+    my $accountdb = esmith::AccountsDB->open();
+    my @users = $accountdb->users();
+    @users = map { $_->key() } @users;
+    my @alphabet = split "", "abcdefghijklmnopqrstuvwxyz";
+    my $guessed = "test-";
+    while (1) {
+        $guessed .= $alphabet[rand(26)];
+        return $guessed unless grep /^$guessed$/, @users;
+    }
+}
+
+=head2 simulate_perl_program
+
+    my $exit = simulate_perl_program($program_file, @args);
+
+"runs" the given $program_file for testing and reports it's $exit
+code.  @args will be expanded via glob() and passed into the program.
+
+The $program_file is not actually run in a seperate process.  Instead,
+it is run in the current processs, simulating calling the program.
+
+You'd do this in order to override certain functions it may call
+for testing purposes.  For example:
+
+    =begin testing
+
+    use esmith::Broker ();
+
+    # override esmith::Broker::saveConfig so it does not
+    # actually save the config.  Instead, we trap the arguments
+    # for examination.
+    my @sSC_args;
+    sub esmith::Broker::saveServerConfig {
+	@sSC_args = @_;
+	return 1;
+    }
+
+    my $exit = simulate_perl_program($Original_File, qw(wibble));
+
+    is( $exit, 0, 'exited normally' );
+    is( $_STDOUT_, "wibble was frobnized\n" );
+    is( $_STDERR_, '', 'no warnings' );
+    is_deeply( \@sSC_args, [('Broker', 1234, { foo => 23 })],
+    	                    'saveServerConfig called correctly' );
+
+    =end testing
+
+
+B<Restrictions>
+
+  $program_file must be a Perl program.
+
+  any args on the #! line may not be honored.
+
+  it cannot assume it's in package main.
+
+If the program dies the error will be on $@.  The output of the
+program will be available on $_STDOUT_ and $_STDERR_ as provided by
+Test::Inline.
+
+=begin testing
+
+use esmith::TestUtils qw(simulate_perl_program);
+
+can_ok(__PACKAGE__, 'simulate_perl_program');
+
+my $Temp_File = '00e-smith-test/tmp_program';
+END { unlink $Temp_File; }
+
+sub _temp_program {
+    open(FILE, ">$Temp_File") or die $!;
+    print FILE @_;
+    close FILE;
+    $_STDOUT_ = '';
+    $_STDERR_ = '';
+}
+
+_temp_program(<<'OUT');
+print "ok 1\n";
+print STDERR "ok 2\n";
+$Foo = 'present';
+OUT
+
+my $exit = simulate_perl_program($Temp_File);
+is( $exit, 0 );
+is( $@, '' );
+is( $_STDOUT_, "ok 1\n" );
+is( $_STDERR_, "ok 2\n" );
+
+ok( !defined &CORE::GLOBAL::exit,   'trick exit() doesnt leak out' );
+
+_temp_program(<<'OUT');
+print $Foo ? "\$Foo should not carry over:  $Foo" : "ok";
+warn "wibble";
+OUT
+
+$exit = simulate_perl_program($Temp_File);
+is( $exit, 0 );
+is( $@, '' );
+is( $_STDOUT_, "ok" );
+is( $_STDERR_, "wibble at $Temp_File line 2.\n" );
+
+
+_temp_program(<<'OUT');
+die "Ack!\n";
+OUT
+
+$exit = simulate_perl_program($Temp_File);
+is( $exit, 255*256,     'die sets the right error code' );
+is( $@, "Ack!\n" );
+is( $_STDOUT_, '' );
+is( $_STDERR_, '' );
+
+
+_temp_program(<<'OUT');
+exit(42);
+OUT
+
+$exit = simulate_perl_program($Temp_File);
+is( $exit, 256*42,      'exit code propagated' );
+is( $@, '' );
+is( $_STDOUT_, '' );
+is( $_STDERR_, '' );
+
+_temp_program(<<'OUT');
+print "@ARGV";
+OUT
+
+$exit = simulate_perl_program($Temp_File, qw(this that));
+is( $exit, 0 );
+is( $@, '' );
+is( $_STDOUT_, 'this that', 'args passed in' );
+is( $_STDERR_, '' );
+
+_temp_program(<<'OUT');
+print "@ARGV";
+OUT
+
+$exit = simulate_perl_program($Temp_File, qw(00*));
+is( $exit, 0 );
+is( $@, '' );
+is( $_STDOUT_, '00e-smith-test', 'args expanded' );
+is( $_STDERR_, '' );
+
+
+=end testing
+
+=cut
+
+my $Pack = 0;
+sub simulate_perl_program {
+    my($prog, @args) = @_;
+
+    my $error;
+    eval sprintf q{
+        BEGIN {
+            no warnings 'redefine';
+            *CORE::GLOBAL::exit = sub (;$) {
+                my $exit = $_[0] || 0;
+                bless \$exit, 'esmith::TestUtils::simulate_perl_program::exit';
+                die \$exit;
+            };
+        }
+
+        package esmith::TestUtils::simulate_perl_program::%d;
+
+        local @ARGV = map glob($_), @args;
+        do $prog;
+        $error = $@;   # make the do error visible outside the eval
+    }, $Pack++;
+
+    # so future eval's aren't effected.
+    undef &CORE::GLOBAL::exit;
+    delete $::CORE::GLOBAL::{exit};
+
+    if( $error ) {
+        if( UNIVERSAL::isa($error,
+                           'esmith::TestUtils::simulate_perl_program::exit')
+          )
+        {   
+            return 256 * ${$error};
+        }
+        else {
+            $@ = $error;
+            return 255 * 256;
+        }
+    }
+    else {
+        return 0;
+    }
+}
+
+
+=head2 scratch_copy
+
+  my $scratch = scratch_copy($src);
+  my $scratch = scratch_copy($src, $dest);
+
+Creates a scratch copy of the $src file that you can safely scribbled
+around with for testing.  Returns the location of the $scratch file.
+If $dest is given it will use that for $scratch.
+
+If the copy fails, $scratch will be undefined.
+
+When the program exits the $scratch file will be deleted.
+
+=begin testing
+
+use esmith::TestUtils qw(scratch_copy);
+
+my $src = 'accounts.conf';
+my $scratch = scratch_copy($src);
+isnt( $scratch, undef );
+ok( -e $scratch,    'scratch_copy() created a scratch file' ) || diag $!;
+
+use Digest::MD5;
+open(FILE, $src) || die $!;
+my $srcmd5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
+open(FILE, $scratch) || die $1;
+my $destmd5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
+close FILE;
+
+is( $srcmd5, $destmd5,  '  same as the original' );
+
+=end testing
+
+=cut
+
+my @Scratch_Files = ();
+sub scratch_copy {
+    my($src, $dest) = @_;
+
+    $dest = "$src.scratch" unless defined $dest;
+
+    require File::Copy;
+    my $ret = File::Copy::copy($src, $dest);
+
+    if($ret) {
+        push @Scratch_Files, $dest;
+        return $dest;
+    }
+    else {
+        return undef;
+    }
+}
+
+END { unlink @Scratch_Files }
+
+=head1 AUTHOR
+
+Mitel Networks Corporation
+
+See http://www.e-smith.org/ for more information.
+
+=cut
+
+
+1;