updated patches attached.. adopted 'Slurp' in function 'compare_log'
instead of using "$/". :-)
and add 'Slurp' requirement in 'Build.pl'
- Osier
----- "Osier" <jyang@xxxxxxxxxx> wrote:
> ----- "Daniel P. Berrange" <berrange@xxxxxxxxxx> wrote:
>
> > On Mon, Oct 18, 2010 at 07:18:08AM +0800, Osier Yang wrote:
> > > To test daemon, qemu, lxc hook.
> > >
> > > * lib/Sys/Virt/TCK/Hooks.pm
> > > ---
> > > lib/Sys/Virt/TCK/Hooks.pm | 262
> > +++++++++++++++++++++++++++++++++++++++++++++
> > > 1 files changed, 262 insertions(+), 0 deletions(-)
> > > create mode 100644 lib/Sys/Virt/TCK/Hooks.pm
> > >
> > > diff --git a/lib/Sys/Virt/TCK/Hooks.pm
> b/lib/Sys/Virt/TCK/Hooks.pm
> >
> > > +sub libvirtd_status {
> > > + my $self = shift;
> > > + my $status = `service libvirtd status`;
> > > + my $_ = $status;
> > > +
> > > + if (/running/) {
> > > + $self->{libvirtd_status} = 'running';
> > > + } elsif (/stopped/) {
> > > + $self->{libvirtd_status} = 'stopped';
> > > + }
> > > +
> > > + return $self;
> > > +}
> >
> > > +sub service_libvirtd {
> > > + my $self = shift;
> > > + my $action = $self->{action};
> > > +
> > > + truncate $self->{log_name}, 0 if -f $self->{log_name};
> > > +
> > > + die "failed on $action daemon" if system "service libvirtd
> > $action";
> > > +
> > > + $self->libvirtd_status;
> > > +}
> >
> > Is there any way we can avoid having to start/stop libvirtd
> > for this testing ? The general goal of the TCK is that it
> > is testing an existing deployment, so it should be expecting
> > that libvirtd is already up & running in a desired configuration.
> >
> > If we have to stop/start libvirtd, then the test script using
> > these APIs will need to be protected to make sure it only
> > runs when used with 'qemu:///system' or 'lxc://'. ie is skipped
> > with qemu:///session or vmware, or virtualbox, etc
> >
>
> For daemon hook testing, It's neccessary to start/stop/restart the
> libvirtd. Otherwise we can't see if the hook script is invoked or
> not.
> It doesn't relate to which hypervisor driver is used..
>
> > > +
> > > +sub compare_log {
> > > + my $self = shift;
> > > +
> > > + my $expect_log = $self->{expect_log};
> > > + my $log_name = $self->{log_name};
> > > +
> > > + open LOG, "< $log_name" or die "failed on opening $log_name:
> > $!";
> > > +
> > > + my @lines = <LOG>;
> > > +
> > > + return 0 unless @lines;
> > > +
> > > + chomp foreach @lines;
> > > + my $actual_log = join "\n", @lines;
> > > +
> > > + close LOG;
> >
> > Little perl black magic tip for you....
> >
> > If you want to read the entire file contents into a single
> > string, then you can do
> >
> > open LOG, "<$log_name";
> > local $/ = undef;
> > my $actual_log = <LOG>;
> > close LOG;
> >
> > '$/' is the line separator. By setting it to 'undef' we tell
> > Perl that there is no line separator, so it will immediately
> > read until end of file :-) BTW see 'man perlvar' for this
> > particular example
> >
>
> cool trick.. will update it.. thanks.. :-)
>
> >
> > Daniel
> > --
> > |: Red Hat, Engineering, London -o-
> > http://people.redhat.com/berrange/ :|
> > |: http://libvirt.org -o- http://virt-manager.org -o-
> > http://deltacloud.org :|
> > |: http://autobuild.org -o-
> > http://search.cpan.org/~danberr/ :|
> > |: GnuPG: 7D3B9505 -o- F3C9 553F A1DA 4AC2 5648 23C1 B3DF F742
> 7D3B
> > 9505 :|
>
> --
> libvir-list mailing list
> libvir-list@xxxxxxxxxx
> https://www.redhat.com/mailman/listinfo/libvir-list
>From ebab27920ed2bc1984a8b93c354c31947b58f942 Mon Sep 17 00:00:00 2001
From: Osier Yang <jyang@xxxxxxxxxx>
Date: Tue, 19 Oct 2010 15:31:12 +0800
Subject: [libvirt-tck 3/4] Add module for hooks testing
To validate daemon, qemu, and lxc hook is invoked correctly
---
lib/Sys/Virt/TCK/Hooks.pm | 257 +++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 257 insertions(+), 0 deletions(-)
create mode 100644 lib/Sys/Virt/TCK/Hooks.pm
diff --git a/lib/Sys/Virt/TCK/Hooks.pm b/lib/Sys/Virt/TCK/Hooks.pm
new file mode 100644
index 0000000..7d20fa4
--- /dev/null
+++ b/lib/Sys/Virt/TCK/Hooks.pm
@@ -0,0 +1,257 @@
+#
+# Copyright (C) 2010 Red Hat, Inc.
+# Copyright (C) 2010 Osier Yang <jyang@xxxxxxxxxx>
+#
+# 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
+#
+
+package Sys::Virt::TCK::Hooks;
+
+use strict;
+use warnings;
+
+use Fcntl ':mode';
+use POSIX qw(strftime);
+use Slurp;
+
+my $HOOKS_CONF_DIR="/etc/libvirt/hooks";
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my %params = @_;
+ my $self = {};
+
+ my $type = $params{type} ? $params{type} : die "type parameter is required";
+
+ $self = {
+ type => $type,
+ conf_dir => $params{conf_dir} ? $params{conf_dir} : $HOOKS_CONF_DIR,
+ name => $params{conf_dir}.'/'.$params{type},
+ expect_result => $params{expect_result} ? $params{expect_result} : 0,
+ log_name => $params{log_name} ? $params{log_name} : "/tmp/$self->{type}.log",
+ libvirtd_status => undef,
+ domain_name => undef,
+ domain_state => undef,
+ expect_log => undef,
+ action => undef,
+ };
+
+ bless $self, $class;
+
+ return $self;
+}
+
+sub log_name {
+ my $self = shift;
+ my $log_name = shift;
+
+ die "log_name parameter is required" unless $log_name;
+
+ $self->{log_name} = $log_name;
+}
+
+sub expect_result {
+ my $self = shift;
+ my $expect_result = shift;
+
+ die "expect_result parameter is required" unless $expect_result;
+
+ $self->{expect_result} = $expect_result;
+
+ return $self;
+}
+
+sub libvirtd_status {
+ my $self = shift;
+ my $status = `service libvirtd status`;
+ my $_ = $status;
+
+ if (/running/) {
+ $self->{libvirtd_status} = 'running';
+ } elsif (/stopped/) {
+ $self->{libvirtd_status} = 'stopped';
+ }
+
+ return $self;
+}
+
+sub domain_name {
+ my $self = shift;
+ my $domain_name = shift;
+
+ die "domain_name parameter is required" unless $domain_name;
+
+ $self->{domain_name} = $domain_name;
+
+ return $self;
+}
+
+sub domain_state {
+ my $self = shift;
+ my $domain_state = shift;
+
+ die "domain_state parameter is required" unless $domain_state;
+
+ $self->{domain_state} = $domain_state;
+
+ return $self;
+}
+
+sub action {
+ my $self = shift;
+ my $action = shift;
+
+ die "action parameter is required" unless $action;
+
+ $self->{action} = $action;
+
+ return $self;
+}
+
+sub expect_log {
+ my $self = shift;
+ my $expect_log = undef;
+
+ my $hook = $self->{name};
+ my $action = $self->{action};
+ my $domain_name = $self->{domain_name};
+ my $domain_state = $self->{domain_state};
+ my $libvirtd_status = $self->{libvirtd_status};
+
+ if ($self->{type} eq 'daemon') {
+ if ($libvirtd_status eq 'running') {
+ if ($action eq 'stop') {
+ $expect_log = "$hook - shutdown - shutdown";
+ } elsif ($action eq 'restart') {
+ $expect_log = "$hook - shutdown - shutdown\n$hook - start - start";
+ } elsif ($action eq 'reload') {
+ $expect_log = "$hook - reload begin SIGHUP";
+ } else {
+ die "hooks testing doesn't support $action running libvirtd";
+ }
+ } else {
+ if ($action eq 'start') {
+ $expect_log = "$hook - start - start";
+ } else {
+ die "hooks testing doesn't support $action stopped libvirtd";
+ }
+ }
+ } elsif ($self->{type} eq 'qemu' or $self->{type} eq 'lxc') {
+ if ($domain_state eq 'running') {
+ if ($action eq 'stop') {
+ $expect_log = "$hook $domain_name stopped end -";
+ } else {
+ die "hooks testing doesn't support $action running domain";
+ }
+ } elsif ($domain_state eq 'shut off') {
+ if ($action eq 'start') {
+ $expect_log = "$hook $domain_name start begin -";
+ } else {
+ die "hooks testing doesn't support $action shutoff domain";
+ }
+
+ } else {
+ die "hooks testing doesn't support to test a domain in $domain_state state";
+ }
+ } else {
+ die "hooks only support 'qemu' and 'lxc' currently";
+ }
+
+ $self->{expect_log} = $expect_log;
+
+ return $self;
+}
+
+sub create_hooks_dir {
+ my $self = shift;
+
+ unless (-d $self->{conf_dir}) {
+ mkdir $self->{conf_dir} or die "failed to create $self->{conf_dir}: $!";
+ }
+}
+
+sub backup_hook {
+ my $self = shift;
+ my $date = undef;
+
+ $date = strftime "%Y-%m-%d-%H:%M:%S", localtime;
+ my $orig = $self->{name};
+ my $dest = $orig."-$date";
+
+ rename $orig, $dest;
+}
+
+sub create_hook {
+ my $self = shift;
+ my $hook = $self->{name};
+
+ $self->backup_hook;
+
+ open HOOK, "> $hook" or die "failed on opening $hook: $!";
+
+ my $str = <<EOF;
+#! /bin/bash
+echo "\$0" "\$@" >>$self->{log_name}
+exit $self->{expect_result}
+EOF
+
+ print HOOK $str;
+ close HOOK;
+
+ my $mode = (stat($hook))[2];
+ chmod($mode | S_IXUSR, $hook) unless -x $hook;
+}
+
+sub prepare {
+ my $self = shift;
+
+ $self->create_hooks_dir;
+ $self->backup_hook;
+ $self->create_hook;
+
+ unlink $self->{log_name} if -f $self->{log_name};
+
+ return $self;
+}
+
+sub cleanup {
+ my $self = shift;
+ my $name = $self->{name};
+
+ unlink $name;
+ unlink $self->{log_name} if -f $self->{log_name};
+}
+
+sub service_libvirtd {
+ my $self = shift;
+ my $action = $self->{action};
+
+ truncate $self->{log_name}, 0 if -f $self->{log_name};
+
+ die "failed on $action daemon" if system "service libvirtd $action";
+
+ $self->libvirtd_status;
+}
+
+sub compare_log {
+ my $self = shift;
+
+ my $expect_log = $self->{expect_log};
+ my $log_name = $self->{log_name};
+
+ my $actual_log = slurp($log_name);
+ chomp $actual_log;
+
+ return 0 unless defined($actual_log);
+
+ ($expect_log eq $actual_log) ? 1 : 0;
+}
+
+1;
--
1.7.1
>From 84d147a86dd245d61c7cbb748ed1667d3b650049 Mon Sep 17 00:00:00 2001
From: Osier Yang <jyang@xxxxxxxxxx>
Date: Tue, 19 Oct 2010 15:30:33 +0800
Subject: [libvirt-tck 2/4] Add Slurp requirement
Add Slurp module requirement in 'Build.pl'
---
Build.PL | 1 +
1 files changed, 1 insertions(+), 0 deletions(-)
diff --git a/Build.PL b/Build.PL
index fc44af2..36dc74a 100644
--- a/Build.PL
+++ b/Build.PL
@@ -89,6 +89,7 @@ my $b = $class->new(
'XML::Twig' => 0,
'XML::Writer' => 0,
'XML::XPath' => 0,
+ 'Slurp' => 0,
},
build_requires => {
'Test::Pod' => '0',
--
1.7.1
--
libvir-list mailing list
libvir-list@xxxxxxxxxx
https://www.redhat.com/mailman/listinfo/libvir-list