[libvirt] [PATCH] Add TCK script for verifying disk based storage pools

[Daniel P. Berrange]

This adds a reasonably comprehensive test script for working with
disk based storage pools. It checks

 - Prevent re-formating an existing partition table (currently
   missing this check in libvirt)
 - Formating of a partiton table
 - Wiping a partition table (currently missing in libvirt)
 - Creating multiple storage volumes
 - Deleteing storage volumes

* conf/default.cfg: add config entry for specifying host block
  devices that a test script can use
* lib/Sys/Virt/TCK.pm: Add API to get a host block device
* lib/Sys/Virt/TCK/StoragePoolBuilder.pm: Fix typo in device
  XML formatting. Allow pool source format to be specified
* scripts/storage/110-disk-pool.t: Test which creates a storage
  pool, creates some volumes, then deletes it all again.
---
 conf/default.cfg                       |    9 ++
 lib/Sys/Virt/TCK.pm                    |    7 ++
 lib/Sys/Virt/TCK/StoragePoolBuilder.pm |   13 +++-
 scripts/storage/110-disk-pool.t        |  127 ++++++++++++++++++++++++++++++++
 4 files changed, 155 insertions(+), 1 deletions(-)
 create mode 100644 scripts/storage/110-disk-pool.t

diff --git a/conf/default.cfg b/conf/default.cfg
index 5b85cbc..288540f 100644
--- a/conf/default.cfg
+++ b/conf/default.cfg
@@ -127,3 +127,12 @@ host_pci_devices = (
 #   }
 # Can list more than one PCI device if many are available
 )
+
+# List of host block devices that the test suite can trash all
+# data on, for purposes of testing. You have been warned !
+# Only full block devices allowed, no single partitions, since
+# the test suite itself needs to create partitions.
+# The disks should be at *least* 512 MB in size
+host_block_devices = (
+#  /dev/vdb
+)
diff --git a/lib/Sys/Virt/TCK.pm b/lib/Sys/Virt/TCK.pm
index f101937..d32b03d 100644
--- a/lib/Sys/Virt/TCK.pm
+++ b/lib/Sys/Virt/TCK.pm
@@ -805,4 +805,11 @@ sub get_host_pci_device {
     return ($domain, $bus, $slot, $function);
 }
 
+sub get_host_block_device {
+    my $self = shift;
+    my $devindex = @_ ? shift : 0;
+
+    return $self->config("host_block_devices/[$devindex]", undef);
+}
+
 1;
diff --git a/lib/Sys/Virt/TCK/StoragePoolBuilder.pm b/lib/Sys/Virt/TCK/StoragePoolBuilder.pm
index f92b21a..c9ef2dd 100644
--- a/lib/Sys/Virt/TCK/StoragePoolBuilder.pm
+++ b/lib/Sys/Virt/TCK/StoragePoolBuilder.pm
@@ -77,6 +77,14 @@ sub target {
     return $self;
 }
 
+sub format {
+    my $self = shift;
+
+    $self->{format} = shift;
+
+    return $self;
+}
+
 
 sub as_xml {
     my $self = shift;
@@ -98,7 +106,7 @@ sub as_xml {
     }
     if ($self->{source}->{device}) {
 	foreach my $dev (@{$self->{source}->{device}}) {
-	    $w->emptyTag("dev", path => $dev);
+	    $w->emptyTag("device", path => $dev);
 	}
     }
     if ($self->{source}->{adapter}) {
@@ -107,6 +115,9 @@ sub as_xml {
     if ($self->{source}->{name}) {
 	$w->dataElement("name", $self->{source}->{name});
     }
+    if ($self->{format}) {
+	$w->emptyTag("format", type => $self->{format});
+    }
     $w->endTag("source");
 
     $w->startTag("target");
diff --git a/scripts/storage/110-disk-pool.t b/scripts/storage/110-disk-pool.t
new file mode 100644
index 0000000..faa13c5
--- /dev/null
+++ b/scripts/storage/110-disk-pool.t
@@ -0,0 +1,127 @@
+# -*- perl -*-
+#
+# Copyright (C) 2009-2010 Red Hat
+# Copyright (C) 2009-2010 Daniel P. Berrange
+#
+# This program is free software; You can redistribute it and/or modify
+# it under the GNU General Public License as published by the Free
+# Software Foundation; either version 2, or (at your option) any
+# later version
+#
+# The file "LICENSE" distributed along with this file provides full
+# details of the terms and conditions
+#
+
+=pod
+
+=head1 NAME
+
+storage/110-disk-pool.t - test disk storage pools
+
+=head1 DESCRIPTION
+
+The test case validates that it is possible to use all core
+functions of the disk pool type.
+
+=cut
+
+use strict;
+use warnings;
+
+use Test::More tests => 20;
+
+use Sys::Virt::TCK;
+use Test::Exception;
+use File::stat;
+
+my $tck = Sys::Virt::TCK->new();
+my $conn = eval { $tck->setup(); };
+BAIL_OUT "failed to setup test harness: $@" if $@;
+END {
+    $tck->cleanup if $tck;
+}
+
+
+SKIP: {
+    my $dev = $tck->get_host_block_device();
+
+    skip "no host block device available", 20 unless defined $dev;
+
+    # Blow away partition table (if any)
+    open DEV, ">$dev" or die "cannot write to $dev: $!";
+    my $data = " "x 512;
+
+    print DEV $data;
+    close DEV or die "cannot save $dev: $!";
+
+    my $poolxml = $tck->generic_pool("disk", "tck")
+	->source_device($dev)
+	->format("dos")
+	->target("/dev/")
+	->as_xml;
+
+    diag "Defining persistent storage pool $poolxml";
+    my $pool;
+    ok_pool(sub { $pool = $conn->define_storage_pool($poolxml) }, "define persistent storage pool");
+
+    # Since we blew away the partition table we should not be able to
+    # start the pool yet
+    ok_error(sub { $pool->create }, "unable to start un-built storage pool");
+
+    lives_ok(sub { $pool->build(0) }, "built storage pool");
+
+    # We should get an error if trying to build a pool which already
+    # has a partition table written.
+    ok_error(sub { $pool->build(0) }, "prevent rebuilding existing storage pool");
+
+    lives_ok(sub { $pool->create }, "started storage pool");
+
+    my @vols = $pool->list_volumes();
+
+    is($#vols, -1, "no storage volumes in new pool");
+
+    my $poolinfo = $pool->get_info();
+
+    ok($poolinfo->{available} > 1000, "there is some space available in the pool");
+
+    my $volbase = $dev;
+    $volbase =~ s,/dev/,,;
+
+    my $vol1xml = $tck->generic_volume($volbase . "1", undef, 1024*1024*256)->as_xml;
+    my $vol2xml = $tck->generic_volume($volbase . "2", undef, 1024*1024*64)->as_xml;
+
+    diag "Vol $vol1xml $vol2xml";
+    my $vol1;
+    my $vol2;
+    ok_volume(sub { $vol1 = $pool->create_volume($vol1xml) }, "create disk partition");
+    ok_volume(sub { $vol2 = $pool->create_volume($vol2xml) }, "create disk partition");
+
+    for my $vol (($vol1, $vol2)) {
+	my $path = xpath($vol, "string(/volume/target/path)");
+	my $st = stat($path);
+
+	ok($st, "path $path exists");
+    }
+
+    @vols = $pool->list_volumes();
+    is($#vols, 1, "two storage volumes in pool");
+
+    lives_ok(sub { $vol1->delete(0) }, "deleted volume");
+
+    @vols = $pool->list_volumes();
+    is($#vols, 0, "one storage volume in pool");
+
+    lives_ok(sub { $vol2->delete(0) }, "deleted volume");
+
+    @vols = $pool->list_volumes();
+    is($#vols, -1, "zero storage volume in pool");
+
+    lives_ok(sub { $pool->destroy() }, "destroyed pool");
+    lives_ok(sub { $pool->delete(0) }, "deleted pool");
+
+    # Since we blew away the partition table we should not be able to
+    # start the pool anymore
+    ok_error(sub { $pool->create }, "unable to start un-built storage pool");
+
+    lives_ok(sub { $pool->undefine() }, "undefined pool");
+}
-- 
1.6.5.2