github.com/xen-tools.xen-tools
1
0
Fork 0
mirror of synced 2026-01-25 19:36:27 +00:00
Code Releases Activity

2007-09-01 19:25:25 by steve

Browse Source 
Removed ./tests/ - contents moved to ./t/
This commit is contained in:
steve
2007-09-01 19:25:25 +00:00
parent eb4a542c4a
commit ec106c1b0c
22 changed files with 0 additions and 1897 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
tests/Makefile
View File

@@ -1,17 +0,0 @@
all:
@cd ..; prove --shuffle tests/
verbose:
@cd ..; prove --shuffle --verbose tests/
modules: .PHONY
./modules.sh > modules.t
.PHONY:
true
clean:
rm *~

141
tests/argument-check.t
View File

@@ -1,141 +0,0 @@
#!/usr/bin/perl -w
#
# Test that the arguments in etc/xen-tools.conf match those used in
# xen-create-image.
#
# Steve
# --
# $Id: argument-check.t,v 1.8 2007-08-08 22:43:18 steve Exp $
#
use strict;
use Test::More qw( no_plan );
#
# Open and parse the xen-tools.conf configuration file.
#
my %OPTIONS;
%OPTIONS = parseConfigFile( "etc/xen-tools.conf" );
#
# Test we got something back.
#
ok( %OPTIONS, "Options successfully parsed" );
#
# Now open and read the file "xen-create-image"
#
my @lines = readFile( "bin/xen-create-image" );
ok ( @lines, "We read the 'xen-create-image' script" );
#
# For each option we found we want to make sure it is
# contained in the script, via the documentation.
#
foreach my $key ( sort keys %OPTIONS )
{
my $found = 0;
foreach my $line ( @lines )
{
if ( $line =~ /--$key/ )
{
$found = 1;
}
}
next if ( $key =~ /mirror_/i );
next if ( $key =~ /_options/i );
is( $found, 1 , " Found documentation for '$key'" );
}
=head2 parseConfigFile
Parse the 'key=value' configuration file passed to us, and
return a hash of the reults.
=cut
sub parseConfigFile
{
my ($file) = ( @_ );
#
# Options we read
#
my %CONFIG;
open( FILE, "<", $file ) or die "Cannot read file '$file' - $!";
my $line = "";
while (defined($line = <FILE>) )
{
chomp $line;
if ($line =~ s/\\$//)
{
$line .= <FILE>;
redo unless eof(FILE);
}
# Skip blank lines
next if ( length( $line ) < 1 );
# skip false positive
next if ( $line =~ /Otherwise/ );
# Find variable settings
if ( $line =~ /([^=]+)=([^\n]+)/ )
{
my $key = $1;
my $val = $2;
if ( $key =~ /([ \t#]*)(.*)/ )
{
$key = $2;
}
# Strip leading and trailing whitespace.
$key =~ s/^\s+//;
$key =~ s/\s+$//;
$val =~ s/^\s+//;
$val =~ s/\s+$//;
next if ( $key =~ /--/ );
# Store value.
$CONFIG{ $key } = $val;
}
}
close( FILE );
return( %CONFIG );
}
=head2 readFile
Read a named file and return an array of its contents.
=cut
sub readFile
{
my ($file) = ( @_ );
open( FILE, "<", $file ) or die "Cannot read file '$file' - $!";
my @LINES = <FILE>;
close( FILE );
return( @LINES );
}

143
tests/getopt.t
View File

@@ -1,143 +0,0 @@
#!/usr/bin/perl -w
#
# Test that every perl script accepts and processes each of the options
# documented in its POD.
#
# Cute test :)
#
# Steve
# --
# $Id: getopt.t,v 1.4 2007-03-19 22:14:43 steve Exp $
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Test each file
#
foreach my $file ( sort( glob "./bin/*-*" ) )
{
testFile( $file );
}
#
# Check that the given file implements all the option processing it
# is supposed to.
#
#
sub testFile
{
my ($file ) = (@_);
is( -e $file, 1, "File exists: $file" );
is( -x $file, 1, "File is executable" );
#
# Run the file with "--help" and capture the output.
#
my $output = `$file --help`;
#
# Parse out the options we accept
#
my @documented = ();
foreach my $line ( split( /\n/, $output ) )
{
if ( $line =~ /[ \t]*--([a-z-_]+)/ )
{
push @documented, $1;
}
}
#
# Test we discovered some documented options.
#
ok( $#documented > 1, "We found some options documented." );
#
# Now read the input file so that we can see if these advertised
# options are actually used.
#
open( IN, "<", $file ) or die "Failed to open file for reading $file - $!";
my @LINES = <IN>;
close( IN );
#
# Options accepted
#
my %accepted;
#
# Do minimal parsing to find the options we process with
# Getopt::Long;
#
my $complete = join( "\n", @LINES );
if ( $complete =~ /GetOptions\(([^\)]+)\)/mi )
{
#
# Multi-line text which should have all the options we've
# invoked GetOptions with.
#
my $opt = $1;
#
# Process each one.
#
foreach my $o ( split( /\n/, $opt ) )
{
#print "O: $o ";
#
# Strip trailing comments.
#
if ( $o =~ /([^#]+)#/ )
{
$o = $1;
}
#print " - strip comments : $o ";
#
# Remove "" from around it.
#
if ( $o =~ /"([^"]+)"/ )
{
$o = $1;
}
#print " - remove quotes : $o ";
#
# Discard anything after "=", or " "
#
if ( $o =~ /(.*)[ \t=]+(.*)/ )
{
$o = $1;
}
#print " - remove = : $o ";
#
# Now avoid blank lines.
#
next if ( $o =~ /^[ \t]*$/ );
#
# Phew. Now we're done.
#
# This option '$o' is something we call GetOptions with.
#
$accepted{$o} = 1;
}
}
#
# Now we want to make sure that each documented option is
# present in the list of options we pass to getopt.
#
foreach my $argument ( @documented )
{
is( $accepted{$argument}, 1, "Option '--$argument' accepted: $file" );
}
}

106
tests/hook-daemons.t
View File

@@ -1,106 +0,0 @@
#!/usr/bin/perl -w
#
# Test that our policy-rc.d file is created and removed as we expect in our hooks.
#
# Steve
# --
# $Id: hook-daemons.t,v 1.1 2007-06-12 14:05:38 steve Exp $
#
use strict;
use Test::More qw( no_plan );
use File::Temp;
#
# Rather than having a hardwired list of distributions to test
# against we look for subdirectories beneath hooks/ and test each
# one.
#
foreach my $dir ( glob( "hooks/*" ) )
{
next if ( $dir =~ /CVS/i );
next if ( ! -d $dir );
if ( $dir =~ /hooks\/(.*)/ )
{
my $dist = $1;
maybeCallHook( $dist );
}
}
#
# If the given distribution has the following two files test them:
#
# 01-disable-daemons
# 99-enable-daemons
#
sub maybeCallHook
{
my( $dist ) = (@_);
#
# Do the two files exist?
#
foreach my $file ( qw/ 01-disable-daemons 99-enable-daemons / )
{
return if ( ! -e "./hooks/$dist/$file" );
}
#
# Call the test on the given distribution
#
testHook( $dist );
}
#
# Test that the two hooks work.
#
sub testHook
{
my ( $dist ) = ( @_ );
#
# Output
#
ok( $dist, "Testing: $dist" );
#
# Create a temporary directory.
#
my $dir = File::Temp::tempdir( CLEANUP => 1 );
#
# Test we got a directory and there is no /usr/sbin there.
#
ok( -d $dir, "Temporary directory created OK" );
ok( ! -d $dir . "/usr/sbin", "There is no /usr/sbin directory there. yet" );;
#
# Call the first hook
#
`./hooks/$dist/01-disable-daemons $dir`;
#
# Now /usr/sbin should exist.
#
ok( -d $dir . "/usr/sbin", "The /usr/sbin directory was created" );
ok( -x $dir . "/usr/sbin/policy-rc.d", "The policy-rc.d file was created" );
#
# Now call the second hook
#
`./hooks/$dist/99-enable-daemons $dir`;
ok( ! -x $dir . "/usr/sbin/policy-rc.d", "The policy-rc.d file was correctly removed" );
}

107
tests/hook-hostname.t
View File

@@ -1,107 +0,0 @@
#!/usr/bin/perl -w
#
# Test that we get an /etc/hosts etc file created when DHCP is used.
#
# Steve
# --
# $Id: hook-hostname.t,v 1.1 2006-12-26 22:27:25 steve Exp $
#
use strict;
use Test::More qw( no_plan );
use File::Temp;
#
# Rather than having a hardwired list of distributions to test
# against we look for subdirectories beneath hooks/ and test each
# one.
#
foreach my $dir ( glob( "hooks/*" ) )
{
next if ( $dir =~ /CVS/i );
next if ( ! -d $dir );
if ( $dir =~ /hooks\/(.*)/ )
{
my $dist = $1;
testHostCreation( $dist ) unless ( $dist =~ /fedora/i );
}
}
#
# Test that the creation succeeds.
#
sub testHostCreation
{
my ( $dist ) = ( @_ );
#
# Setup the environment.
#
$ENV{'hostname'} = "steve";
$ENV{'dhcp'} = 1;
#
# Create a temporary directory.
#
my $dir = File::Temp::tempdir( CLEANUP => 1 );
mkdir( $dir . "/etc", 0777 );
#
# Gentoo
#
if ( $dist =~ /gentoo/i )
{
mkdir( $dir . "/etc/conf.d", 0777 );
}
ok( -d $dir, "Temporary directory created OK" );
ok( -d $dir . "/etc/conf.d" , "Temporary directory created OK" ) if ( $dist =~ /gentoo/i );
#
# Make sure there are no files.
#
ok( -d $dir . "/etc/", "Temporary directory created OK" );
ok( ! -e $dir . "/etc/hosts", " There is no hosts file present" );
ok( ! -e $dir . "/etc/mailname", " There is no mailname file present" );
ok( ! -e $dir . "/etc/hostname", " There is no hostname file present" );
#
# Make sure we have the distro-specific hook directory, and
# TLS-disabling hook script.
#
ok( -d "hooks/$dist", "There is a hook directory for the distro $dist" );
ok( -e "hooks/$dist/50-setup-hostname", "There is a hook for setting up hostname stuff." );
#
# Call the hook
#
`hooks/$dist/50-setup-hostname $dir`;
ok( -e $dir . "/etc/hosts", " There is now a hosts file present" );
#
# These files are not used in Gentoo
#
if ( $dist =~ /gentoo/i )
{
ok( -e $dir . "/etc/conf.d/domainname", " There is now a domainname file present" );
ok( -e $dir . "/etc/conf.d/hostname", " There is now a hostname file present" );
}
else
{
ok( -e $dir . "/etc/mailname", " There is now a mailname file present" );
ok( -e $dir . "/etc/hostname", " There is now a hostname file present" );
}
}

108
tests/hook-inittab.t
View File

@@ -1,108 +0,0 @@
#!/usr/bin/perl -w
#
# Test that the /etc/inittab file is modified as we expect.
#
# Steve
# --
# $Id: hook-inittab.t,v 1.9 2006-12-03 12:16:45 radu Exp $
#
use strict;
use Test::More qw( no_plan );
use File::Temp;
use File::Copy;
#
# Sanity check.
#
ok( -e "/etc/inittab", "/etc/inittab exists." );
#
# Rather than having a hardwired list of distributions to test
# against we look for subdirectories beneath hooks/ and test each
# one.
#
foreach my $dir ( glob( "hooks/*" ) )
{
next if ( $dir =~ /CVS/i );
next if ( ! -d $dir );
if ( $dir =~ /hooks\/(.*)/ )
{
my $dist = $1;
next if ( $dist =~ /(edgy|dapper|ubuntu)/i );
testHook( $dist );
}
}
sub testHook
{
my ( $dist ) = ( @_ );
#
# Create a temporary directory, and copy our inittab into it.
#
my $dir = File::Temp::tempdir( CLEANUP => 1 );
mkdir( $dir . "/etc", 0777 );
File::Copy::cp( "/etc/inittab", $dir . "/etc" );
#
# Make sure that worked.
#
ok( -d $dir, "Temporary directory created OK" );
ok( -e $dir . "/etc/inittab", "/etc/inittab copied correctly." );
ok( -e "hooks/$dist/30-disable-gettys", "$dist inittab fixing hook exists" );
ok( -x "hooks/$dist/30-disable-gettys", "$dist inittab fixing hook is executable" );
#
# Call the hook
#
`hooks/$dist/30-disable-gettys $dir`;
#
# Now we read the new file, and make sure it looks like we expect.
#
open( INIT, "<", $dir . "/etc/inittab" )
or die "Failed to open modified inittab.";
my @lines = <INIT>;
close( INIT );
#
# Test we read some lines.
#
ok( $#lines > 0, "We read the new inittab." );
#
# Now test that the lines look like they should.
#
my $count = 0;
foreach my $line ( @lines )
{
if ( $line =~ /^([1-9])(.*) (.*)$/ )
{
#
# This should be our only line:
#
# 1:2345:respawn:/sbin/getty 38400 console
#
ok( $1 eq "1", "We found the first getty line." );
ok( $3 eq "tty1", "Which does uses the correct driver: $3" );
}
if ( $line =~ /^(.).*getty/ )
{
$count += 1 if ( $1 ne "#" );
}
}
ok( $count = 1, "Only found one uncommented getty line" );
}

87
tests/hook-tls.t
View File

@@ -1,87 +0,0 @@
#!/usr/bin/perl
#
# Test that the tls-disabling hook works.
#
# Steve
# --
# $Id: hook-tls.t,v 1.9 2007-03-19 22:10:54 steve Exp $
#
use Config qw(config_vars);
use Test::More;
use File::Temp;
if ( $Config::Config{archname} =~ /64/ )
{
plan skip_all => "This test will fail upon 64 bit systems" ;
}
else
{
plan no_plan;
}
#
# Rather than having a hardwired list of distributions to test
# against we look for subdirectories beneath hooks/ and test each
# one.
#
foreach my $dir ( glob( "hooks/*" ) )
{
next if ( $dir =~ /CVS/i );
next if ( ! -d $dir );
if ( $dir =~ /hooks\/(.*)/ )
{
my $dist = $1;
testTLSDisabling( $dist ) unless ( $dist =~ /(dapper|edgy|ubuntu|debian)/i );
}
}
#
# Test that there is a hook for the given distribution, and that
# it successfully disables a faked TLS.
#
sub testTLSDisabling
{
my ( $dist ) = ( @_ );
#
# Create a temporary directory.
#
my $dir = File::Temp::tempdir( CLEANUP => 1 );
mkdir( $dir . "/lib", 0777 );
mkdir( $dir . "/lib/tls", 0777 );
mkdir( $dir . "/lib/tls/foo", 0777 );
ok( -d $dir, "Temporary directory created OK" );
ok( -d $dir . "/lib/tls", "TLS directory OK" );
ok( -d $dir . "/lib/tls/foo", "TLS directory is non-empty" );
#
# Make sure we have the distro-specific hook directory, and
# TLS-disabling hook script.
#
ok( -d "hooks/$dist", "There is a hook directory for the distro $dist" );
ok( -e "hooks/$dist/10-disable-tls", "TLS Disabling hook exists" );
ok( -x "hooks/$dist/10-disable-tls", "TLS Disabling hook is executable" );
#
# Call the hook
#
`hooks/$dist/10-disable-tls $dir`;
#
# Make sure the the TLS directory is empty
#
ok( ! -e "$dir/lib/tls/foo", "The fake library from /lib/tls is gone" );
ok( -e "$dir/lib/tls.disabled/foo", "The fake library ended up in /lib/tls.disabled" );
ok( -d "$dir/lib/tls", "There is a new /lib/tls directory" );
}

54
tests/hooks.t
View File

@@ -1,54 +0,0 @@
#!/usr/bin/perl -w
#
# Test that all the hook files we install are executable.
#
# Steve
# --
# $Id: hooks.t,v 1.7 2006-06-25 20:02:33 steve Exp $
#
use strict;
use Test::More qw( no_plan );
#
# Rather than having a hardwired list of distributions to test
# against we look for subdirectories beneath hooks/ and test each
# one.
#
foreach my $dir ( glob( "hooks/*" ) )
{
next if ( $dir =~ /CVS/i );
next if ( ! -d $dir );
if ( $dir =~ /hooks\/(.*)/ )
{
my $dist = $1;
testDistroHooks( $dist );
}
}
sub testDistroHooks
{
my ( $dist ) = ( @_ );
#
# Make sure we have a distro-specific hook directory.
#
ok( -d "hooks/$dist", "There is a hook directory for distro $dist" );
#
# Now make sure we just have files, and that they are executable.
#
foreach my $file ( glob( "hooks/$dist/*" ) )
{
if ( ! -d $file )
{
ok( -e $file, "$file" );
ok( -x $file, " File is executable: $file" );
}
}
}

35
tests/modules.sh
View File

@@ -1,35 +0,0 @@
#!/bin/sh
#
# Automatically attempt to create a test which ensures all the modules
# used in the code are availabe.
#
# Steve
# --
# http://www.steve.org.uk/
#
# $Id: modules.sh,v 1.5 2007-06-12 14:04:08 steve Exp $
#
cat <<EOF
#!/usr/bin/perl -w -I..
#
# Test that all the Perl modules we require are available.
#
# This list is automatically generated by modules.sh
#
# Steve
# --
#
use Test::More qw( no_plan );
EOF
for i in `rgrep '^use ' .. | grep -v Expect | awk '{print $2}' | tr -d
\;\(\) | sort | uniq`; \
do \
echo "BEGIN{ use_ok( '$i' ); }"; \
echo "require_ok( '$i' );" ; \
echo -e "\n" ; \
done

68
tests/modules.t
View File

@@ -1,68 +0,0 @@
#!/usr/bin/perl -w -I..
#
# Test that all the Perl modules we require are available.
#
# This list is automatically generated by modules.sh
#
# Steve
# --
#
use Test::More qw( no_plan );
BEGIN{ use_ok( 'Config' ); }
require_ok( 'Config' );
BEGIN{ use_ok( 'Digest::MD5' ); }
require_ok( 'Digest::MD5' );
BEGIN{ use_ok( 'English' ); }
require_ok( 'English' );
BEGIN{ use_ok( 'Env' ); }
require_ok( 'Env' );
BEGIN{ use_ok( 'File::Copy' ); }
require_ok( 'File::Copy' );
BEGIN{ use_ok( 'File::Find' ); }
require_ok( 'File::Find' );
BEGIN{ use_ok( 'File::Path' ); }
require_ok( 'File::Path' );
BEGIN{ use_ok( 'File::Temp' ); }
require_ok( 'File::Temp' );
BEGIN{ use_ok( 'Getopt::Long' ); }
require_ok( 'Getopt::Long' );
BEGIN{ use_ok( 'Pod::Usage' ); }
require_ok( 'Pod::Usage' );
BEGIN{ use_ok( 'strict' ); }
require_ok( 'strict' );
BEGIN{ use_ok( 'Test::More' ); }
require_ok( 'Test::More' );
BEGIN{ use_ok( 'Text::Template' ); }
require_ok( 'Text::Template' );
BEGIN{ use_ok( 'warnings' ); }
require_ok( 'warnings' );

99
tests/no-tabs.t
View File

@@ -1,99 +0,0 @@
#!/usr/bin/perl -w
#
# Test that every perl + shell script we have contains no tabs.
#
# Steve
# --
# $Id: no-tabs.t,v 1.2 2006-06-13 13:26:00 steve Exp $
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Find all the files beneath the current directory,
# and call 'checkFile' with the name.
#
find( { wanted => \&checkFile, no_chdir => 1 }, '.' );
#
# Check a file.
#
#
sub checkFile
{
# The file.
my $file = $File::Find::name;
# We don't care about directories
return if ( ! -f $file );
# Nor about backup files.
return if ( $file =~ /~$/ );
# Nor about files which start with ./debian/
return if ( $file =~ /^\.\/debian\// );
# See if it is a shell/perl file.
my $isShell = 0;
my $isPerl = 0;
# Read the file.
open( INPUT, "<", $file );
foreach my $line ( <INPUT> )
{
if ( ( $line =~ /\/bin\/sh/ ) ||
( $line =~ /\/bin\/bash/ ) )
{
$isShell = 1;
}
if ( $line =~ /\/usr\/bin\/perl/ )
{
$isPerl = 1;
}
}
close( INPUT );
#
# Return if it wasn't a perl file.
#
if ( $isShell || $isPerl )
{
#
# Count TAB characters
#
my $count = countTabCharacters( $file );
is( $count, 0, "Script has no tab characters: $file" );
}
}
=head2 countTabCharacters
=cut
sub countTabCharacters
{
my ( $file ) = (@_);
my $count = 0;
open( FILE, "<", $file )
or die "Cannot open $file - $!";
foreach my $line ( <FILE> )
{
while( $line =~ /(.*)\t(.*)/ )
{
$count += 1;
$line = $1 . $2;
}
}
close( FILE );
return( $count );
}

73
tests/perl-syntax.t
View File

@@ -1,73 +0,0 @@
#!/usr/bin/perl -w
#
# Test that every perl file we have passes the syntax check.
#
# Steve
# --
# $Id: perl-syntax.t,v 1.4 2007-03-19 22:16:20 steve Exp $
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Find all the files beneath the current directory,
# and call 'checkFile' with the name.
#
find( { wanted => \&checkFile, no_chdir => 1 }, '.' );
#
# Check a file.
#
# If this is a perl file then call "perl -c $name", otherwise
# return
#
sub checkFile
{
# The file.
my $file = $File::Find::name;
# We don't care about directories
return if ( ! -f $file );
# `modules.sh` is a false positive.
return if ( $file =~ /modules.sh$/ );
# `tests/hook-tls.t` is too.
return if ( $file =~ /hook-tls.t$/ );
# See if it is a perl file.
my $isPerl = 0;
# Read the file.
open( INPUT, "<", $file );
foreach my $line ( <INPUT> )
{
if ( $line =~ /\/usr\/bin\/perl/ )
{
$isPerl = 1;
}
}
close( INPUT );
#
# Return if it wasn't a perl file.
#
return if ( ! $isPerl );
#
# Now run 'perl -c $file' to see if we pass the syntax
# check. We add a couple of parameters to make sure we're
# really OK.
#
# use strict "vars";
# use strict "subs";
#
my $retval = system( "perl -Mstrict=subs -Mstrict=vars -c $file 2>/dev/null >/dev/null" );
is( $retval, 0, "Perl file passes our syntax check: $file" );
}

98
tests/plugin-checks.t
View File

@@ -1,98 +0,0 @@
#!/usr/bin/perl -w
#
# Test that the plugins each refer to environmental variables,
# not the perl config hash.
#
# Steve
# --
# $Id: plugin-checks.t,v 1.7 2006-06-25 20:02:33 steve Exp $
#
use strict;
use Test::More qw( no_plan );
#
# Rather than having a hardwired list of distributions to test
# against we look for subdirectories beneath hooks/ and test each
# one.
#
foreach my $dir ( glob( "hooks/*" ) )
{
next if ( $dir =~ /CVS/i );
next if ( ! -d $dir );
if ( $dir =~ /hooks\/(.*)/ )
{
my $dist = $1;
testPlugins( $dist );
}
}
=head2 testPlugins
Test each plugin associated with the given directory.
=cut
sub testPlugins
{
my ( $dist ) = ( @_ );
#
# Make sure there is a hook directory for the named distro
#
ok( -d "hooks/$dist/", "There is a hook directory for the distro $dist" );
#
# Make sure the plugins are OK.
#
foreach my $file ( glob( "hooks/$dist/*" ) )
{
ok( -e $file, "$file" );
if ( -f $file )
{
ok( -x $file, "File is executable" );
#
# Make sure the file is OK
#
my $result = testFile( $file );
is( $result, 0, " File contains no mention of the config hash" );
}
}
}
#
# Test that the named file contains no mention of '$CONFIG{'xx'};'
#
sub testFile
{
my ( $file ) = ( @_ );
open( FILY, "<", $file ) or die "Failed to open $file - $!";
foreach my $line ( <FILY> )
{
if ( $line =~ /\$CONFIG{[ \t'"]+(.*)[ \t'"]+}/ )
{
close( FILY );
return $line;
}
}
close( FILY );
#
# Success
#
return 0;
}

33
tests/pod-check.t
View File

@@ -1,33 +0,0 @@
#!/usr/bin/perl -w
#
# Test that the POD we include in our scripts is valid, via the external
# podcheck command.
#
# Steve
# --
# $Id: pod-check.t,v 1.5 2006-06-13 13:26:01 steve Exp $
#
use strict;
use Test::More qw( no_plan );
foreach my $file ( glob( "bin/*-*" ) )
{
ok( -e $file, "$file" );
ok( -x $file, " File is executable: $file" );
ok( ! -d $file, " File is not a directory: $file" );
if ( ( -x $file ) && ( ! -d $file ) )
{
#
# Execute the command giving STDERR to STDOUT where we
# can capture it.
#
my $cmd = "podchecker $file";
my $output = `$cmd 2>&1`;
chomp( $output );
is( $output, "$file pod syntax OK.", " File has correct POD syntax: $file" );
}
}

17
tests/pod.t
View File

@@ -1,17 +0,0 @@
#!/usr/bin/perl -w
#
# Test that the POD we use in our modules is valid.
#
use strict;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
#
# Run the test(s).
#
my @poddirs = qw( bin );
all_pod_files_ok( all_pod_files( @poddirs ) );

88
tests/portable-shell.t
View File

@@ -1,88 +0,0 @@
#!/usr/bin/perl -w
#
# Test that we don't use non-portable shell syntax in our hooks.
#
# Specifically we test for:
#
# 1. "[[" & "]]" around tests.
#
# 2. The "function" keyword
#
# Steve
# --
# $Id: portable-shell.t,v 1.1 2006-10-19 17:10:31 steve Exp $
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Find all the files beneath the current directory,
# and call 'checkFile' with the name.
#
find( { wanted => \&checkFile, no_chdir => 1 }, '.' );
#
# Check a file.
#
# If this is a shell script then call "sh -n $name", otherwise
# return
#
sub checkFile
{
# The file.
my $file = $File::Find::name;
# We don't care about directories
return if ( ! -f $file );
# We're only testing things beneath hooks
return if ( $file !~ /hooks/ );
# See if it is a shell script.
my $isShell = 0;
# Read the file.
open( INPUT, "<", $file );
foreach my $line ( <INPUT> )
{
if ( ( $line =~ /\/bin\/sh/ ) ||
( $line =~ /\/bin\/bash/ ) )
{
$isShell = 1;
}
}
close( INPUT );
#
# Return if it wasn't a shell script.
#
return if ( ! $isShell );
# The result
my $result = 0;
#
# Open the file and read it.
#
open( INPUT, "<", $file )
or die "Failed to open '$file' - $!";
while( my $line = <INPUT> )
{
# [[ or ]]
$result += 1 if ( $line =~ /\[\[/ );
$result += 1 if ( $line =~ /\]\]/ );
# function
$result += 1 if ( $line =~ /^[ \t]*function/ );
}
close( INPUT );
is( $result, 0, "Shell script passes our portability check: $file" );
}

43
tests/programs.t
View File

@@ -1,43 +0,0 @@
#!/usr/bin/perl -w -I..
#
# Test that we have several required programs present.
#
# Steve
# --
#
use Test::More qw( no_plan );
#
# Files that we want to use.
#
my @required = qw( /usr/sbin/debootstrap /bin/ls /bin/dd /bin/mount /bin/cp /bin/tar );
#
# Files that we might wish to use.
#
my @optional = qw( /usr/bin/rpmstrap /usr/sbin/xm /sbin/mkfs.ext3 /sbin/mkfs.xfs/sbin/mkfs.reiserfs );
#
# Test required programs
#
foreach my $file ( @required )
{
ok( -x $file , "Required binary installed: $file" );
}
#
# Test optional programs - if they exist then we ensure they are
# executable. If they don't we'll not complain since they are optional.
#
foreach my $file ( @optional )
{
if ( -e $file )
{
ok( -x $file , "Optional binary installed: $file" );
}
}

64
tests/shell-syntax.t
View File

@@ -1,64 +0,0 @@
#!/usr/bin/perl -w
#
# Test that every shell script we have passes a syntax check.
#
# Steve
# --
# $Id: shell-syntax.t,v 1.3 2006-06-14 13:46:25 steve Exp $
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Find all the files beneath the current directory,
# and call 'checkFile' with the name.
#
find( { wanted => \&checkFile, no_chdir => 1 }, '.' );
#
# Check a file.
#
# If this is a shell script then call "sh -n $name", otherwise
# return
#
sub checkFile
{
# The file.
my $file = $File::Find::name;
# We don't care about directories
return if ( ! -f $file );
# See if it is a shell script.
my $isShell = 0;
# Read the file.
open( INPUT, "<", $file );
foreach my $line ( <INPUT> )
{
if ( ( $line =~ /\/bin\/sh/ ) ||
( $line =~ /\/bin\/bash/ ) )
{
$isShell = 1;
}
}
close( INPUT );
#
# Return if it wasn't a perl file.
#
return if ( ! $isShell );
#
# Now run 'sh -n $file' to see if we pass the syntax
# check
#
my $retval = system( "sh -n $file 2>/dev/null >/dev/null" );
is( $retval, 0, "Shell script passes our syntax check: $file" );
}

61
tests/test-trailing-whitespace.t
View File

@@ -1,61 +0,0 @@
#!/usr/bin/perl -w
#
# Test that every script in ./bin/ has no trailing whitespace.
#
# Steve
# --
# $Id: test-trailing-whitespace.t,v 1.1 2007-06-16 13:36:41 steve Exp $
use strict;
use File::Find;
use Test::More qw( no_plan );
#
# Find our bin/ directory.
#
my $dir = undef;
$dir = "./bin/" if ( -d "./bin/" );
$dir = "../bin/" if ( -d "../bin/" );
plan skip_all => "No bin directory found" if (!defined( $dir ) );
#
# Process each file.
#
foreach my $file (sort( glob ( $dir . "*" ) ) )
{
# skip backups, and directories.
next if ( $file =~ /~$/ );
next if ( -d $file );
ok( -e $file, "Found file : $file" );
checkFile( $file );
}
#
# Check a file.
#
#
sub checkFile
{
my( $file ) = (@_);
my $trailing = 0;
# Read the file.
open( INPUT, "<", $file );
foreach my $line ( <INPUT> )
{
$trailing = 1 if ( $line =~ /^(.*)[ \t]+$/ )
}
close( INPUT );
is( $trailing, 0, "File has no trailing whitespace" );
}

94
tests/xen-delete-image.t
View File

@@ -1,94 +0,0 @@
#!/usr/bin/perl -w
#
# Test that the xen-delete-image script will delete an images
# contents correctly.
#
# Steve
# --
# $Id: xen-delete-image.t,v 1.4 2006-06-13 13:26:01 steve Exp $
#
use strict;
use Test::More qw( no_plan );
use File::Temp;
#
# Create a temporary directory.
#
my $dir = File::Temp::tempdir( CLEANUP => 1 );
my $domains = $dir . "/domains";
#
# Test that we can make the directory.
#
ok ( -d $dir, "The temporary directory was created: $dir" );
#
# Create the domains directory.
#
ok ( ! -d $domains, "The temp directory doesn't have a domains directory." );
mkdir( $domains, 0777 );
ok ( -d $domains, "The temp directory now has a domains directory." );
#
# Generate a random hostname.
#
my $hostname = join ( '', map {('a'..'z')[rand 26]} 0..17 );
ok( ! -d $domains . "/" . $hostname, "The virtual hostname doesnt exist." );
#
# Make the hostname directory
#
mkdir( $domains . "/" . $hostname, 0777 );
ok( -d $domains . "/" . $hostname, "The virtual hostname now exists." );
#
# Create a stub disk image
#
open( IMAGE, ">", $domains . "/" . $hostname . "/" . "disk.img" )
or warn "Failed to open disk image : $!";
print IMAGE "Test";
close( IMAGE );
#
# Create a stub swap image
#
open( IMAGE, ">", $domains . "/" . $hostname . "/" . "swap.img" )
or warn "Failed to open swap image : $!";
print IMAGE "Test";
close( IMAGE );
#
# Now we have :
#
# $dir/
# $dir/domains/
# $dir/domains/$hostname
# $dir/domains/$hostname/disk.img
# $dir/domains/$hostname/swap.img
#
# So we need to run the deletion script and verify the images
# are removed correctly.
#
`./bin/xen-delete-image --test --dir=$dir $hostname`;
#
# If the deletion worked our images are gone.
#
ok( ! -e $domains . "/" . $hostname . "/" . "disk.img",
"Disk image deleted successfully." );
ok( ! -e $domains . "/" . $hostname . "/" . "swap.img",
"Swap image deleted successfully." );
#
# And the hostname directory should have gone too.
#
ok( ! -d $domains . "/" . $hostname,
"The hostname directory was removed" );

137
tests/xen-lists-images.t
View File

@@ -1,137 +0,0 @@
#!/usr/bin/perl -w
#
# Test that the xen-list-images script can process two "fake"
# installations which we construct manually.
#
#
# Steve
# --
# $Id: xen-lists-images.t,v 1.6 2007-07-23 19:55:25 steve Exp $
#
use strict;
use Test::More qw( no_plan );
use File::Temp;
#
# Test some random instances.
#
testRandomInstance( "foo.my.flat", 0 );
testRandomInstance( "foo.my.flat", 1 );
testRandomInstance( "bar.my.flat", 0 );
testRandomInstance( "bar.my.flat", 1 );
testRandomInstance( "baz.my.flat", 0 );
testRandomInstance( "baz.my.flat", 1 );
=head2 testRandomInstance
Create a fake Xen configuration file and test that the xen-list-images
script can work with it.
=cut
sub testRandomInstance
{
my ( $name, $dhcp ) = ( @_ );
# Create a temporary directory.
my $dir = File::Temp::tempdir( CLEANUP => 1 );
ok ( -d $dir, "The temporary directory was created for test: $name" );
#
# Generate a random amount of memory
#
my $memory = int( rand( 4096 ) );
#
# Generate a random IP address.
#
my $ip = '';
my $count = 0;
while( $count < 4 )
{
$ip .= int( rand( 256 ) ) . ".";
$count += 1;
}
#
# Write a xen configuration file to the temporary directory.
#
open( TMP, ">", $dir . "/foo.cfg" );
if ( $dhcp )
{
print TMP <<EOD;
kernel = '/boot/vmlinuz-2.6.16-2-xen-686'
ramdisk = '/boot/initrd.img-2.6.16-2-xen-686'
memory = $memory
name = '$name'
root = '/dev/sda1 ro'
disk = [ 'phy:skx-vg/foo.my.flat-disk,sda1,w', 'phy:skx-vg/foo.my.flat-swap,sda2,w' ]
dhcp = "dhcp"
EOD
}
else
{
print TMP <<EOS;
kernel = '/boot/vmlinuz-2.6.16-2-xen-686'
ramdisk = '/boot/initrd.img-2.6.16-2-xen-686'
memory = $memory
name = '$name'
root = '/dev/sda1 ro'
disk = [ 'phy:skx-vg/foo.my.flat-disk,sda1,w', 'phy:skx-vg/foo.my.flat-swap,sda2,w' ]
vif = [ 'ip=$ip' ]
EOS
}
close( TMP );
#
# Now run the xen-list-images script to make sure we can read
# the relevant details back from it.
#
my $cmd = "./bin/xen-list-images --test=$dir";
my $output = `$cmd`;
ok( defined( $output ) && length( $output ), "Runing the list command produced some output" );
#
# Process the output of the command, and make sure it was correct.
#
my $success = 0;
foreach my $line ( split( /\n/, $output ) )
{
if ( $line =~ /Memory: ([0-9]+)/i )
{
is( $1, $memory, "We found the right amount of memory: $memory" );
$success += 1;
}
if ( $line =~ /Name: (.*)/i )
{
is( $1, $name, "We found the correct hostname: $name" );
$success += 1;
}
if ( $line =~ /DHCP/i )
{
is( $dhcp, 1, "Found the right DHCP details" );
$success += 1;
}
if ( $line =~ /IP: ([0-9.]+)/i )
{
is( $1, $ip, "We found the IP address: $ip" );
is( $dhcp, 0, "And DHCP is disabled" );
$success += 1;
}
}
is( $success, 3, "All output accounted for!" );
}

224
tests/xt-create-xen-config.t
View File

@@ -1,224 +0,0 @@
#!/usr/bin/perl -w
#
# Test that calling xt-create-xen-config with the appropriate parameters
# results in output we expect.
#
# Steve
# --
# $Id: xt-create-xen-config.t,v 1.5 2007-07-07 23:49:02 steve Exp $
#
use strict;
use Test::More qw( no_plan );
use File::Temp;
#
# What we basically do here is setup a collection of environmental
# variables, and then call the script. We then make a couple of simple
# tests against the output file which is written.
#
#
#
# Look for mention of DHCP when setting up DHCP, this conflicts with
# a static IP address.
#
testOutputContains( "dhcp",
memory => 128, dhcp => 1, dir => '/tmp' );
noMentionOf( "ip=",
memory => 128, dhcp => 1, dir => '/tmp' );
#
# Look for an IP address when specifying one, and make sure there
# is no mention of DHCP.
#
testOutputContains( "ip=192.168.1.1",
memory => 128, ip1 => '192.168.1.1', dir => '/tmp' );
noMentionOf( "dhcp",
memory => 128, ip1 => '192.168.1.1', dir => '/tmp' );
#
# SCSI based systems:
#
testOutputContains( "sda1",
memory => 128, ip1 => '192.168.1.1', dir => '/tmp' );
testOutputContains( "/dev/sda1 ro",
memory => 128, ip1 => '192.168.1.1', dir => '/tmp' );
noMentionOf( "hda1",
memory => 128, ip1 => '192.168.1.1', dir => '/tmp' );
#
# IDE based systems
#
testOutputContains( "hda1",
memory => 128, ip1 => '192.168.1.1', dir => '/tmp', ide => 1 );
testOutputContains( "/dev/hda1 ro",
memory => 128, ip1 => '192.168.1.1', dir => '/tmp', ide => 1 );
#
# Test memory size.
#
testOutputContains( "128",
memory => 128, dhcp => 1, dir => '/tmp' );
testOutputContains( "211",
memory => 211, dhcp => 1, dir => '/tmp' );
testOutputContains( "912",
memory => 912, dhcp => 1, lvm => 'skx-vg0' );
#
# Test LVM stuff.
#
testOutputContains( "phy:",
memory => 128, dhcp => 1, lvm => 'skx-vg0' );
testOutputContains( "skx-vg0",
memory => 128, dhcp => 1, lvm => 'skx-vg0' );
noMentionOf( "/tmp",
memory => 128, dhcp => 1, lvm => 'skx-vg0' );
noMentionOf( "domains",
memory => 128, dhcp => 1, lvm => 'skx-vg0' );
#
# Now test the loopback devices.
#
testOutputContains( "/tmp",
memory => 128, dhcp => 1, dir => '/tmp' );
testOutputContains( "/tmp/domains",
memory => 128, dhcp => 1, dir => '/tmp' );
testOutputContains( "/tmp/domains/foo.my.flat",
memory => 128, dhcp => 1, dir => '/tmp' );
noMentionOf( "phy:",
memory => 128, dhcp => 1, dir => '/tmp' );
=head2 runCreateCommand
Run the xt-create-xen-config command and return the output.
This involves setting up the environment and running the command,
once complete return the text which has been written to the xen
configuration file.
=cut
sub runCreateCommand
{
my ( %params ) = ( @_ );
#
# Force a hostname
#
$params{'hostname'} = 'foo.my.flat';
$params{'noswap'} = 1;
#
# Create a temporary directory, and make sure it is present.
#
my $dir = File::Temp::tempdir( CLEANUP => 0 );
ok ( -d $dir, "The temporary directory was created: $dir" );
#
# Save the environment.
#
my %SAFE_ENV = %ENV;
#
# Update the environment with our parameters.
#
foreach my $p ( keys %params )
{
$ENV{$p} = $params{$p};
}
#
# Run the command
#
system( "./bin/xt-create-xen-config --output=$dir --template=./etc/xm.tmpl" );
#
# Reset the environment
#
%ENV = %SAFE_ENV;
#
# Read the Xen configuration file which the xt-creaat...
# command wrote and return it to the caller.
#
open( OUTPUT, "<", $dir . "/foo.my.flat.cfg" );
my @LINES = <OUTPUT>;
close( OUTPUT );
return( join( "\n", @LINES ) );
}
=head2 testOutputContains
Run the xt-create-xen-config and ensure that the output
contains the text we're looking for.
=cut
sub testOutputContains
{
my ( $text, %params ) = ( @_ );
# Get the output of running the command.
my $output = runCreateCommand( %params );
#
# Look to see if we got the text.
#
my $found = 0;
if ( $output =~ /\Q$text\E/ )
{
$found += 1;
}
ok( $found > 0, "We found the output we wanted: $text" );
}
=head2 noMentionOf
Make sure that the creation of a given Xen configuration
file contains no mention of the given string.
=cut
sub noMentionOf
{
my ( $text, %params ) = ( @_ );
# Get the output of running the command.
my $output = runCreateCommand( %params );
#
# Look to see if we got the text.
#
my $found = 0;
if ( $output =~ /\Q$text\E/ )
{
$found += 1;
}
ok( $found == 0, "The output didn't contain the excluded text: $text" );
}