1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
use Sys::Virt::TCK qw(xpath);
use strict;
use utf8;
sub get_first_macaddress {
my $dom = shift;
my $mac = xpath($dom, "string(/domain/devices/interface[1]/mac/\@address)");
utf8::encode($mac);
return $mac;
}
sub get_ip_from_leases{
my $mac = shift;
my $tmp = `grep $mac /var/lib/dnsmasq/dnsmasq.leases`;
my @fields = split(/ /, $tmp);
my $ip = $fields[2];
return $ip;
}
sub build_cdrom_ks_image {
my $tck = shift;
my $ks = $tck->config("ks");
# Where we put the source files for the ISO
my $bucket1 = "nwfilter-install-ks";
# Where we put the ISO itself
my $bucket2 = "nwfilter-install-iso";
my $isoimage = catfile($tck->bucket_dir($bucket2), "boot.iso");
unless (-e $isoimage) {
my $isofiledir = $tck->bucket_dir($bucket1);
my $ksfile = $tck->get_scratch_resource($ks, $bucket1, "ks.cfg");
`mkisofs -o "$isoimage" $isofiledir`;
}
return ($isoimage, "cdrom:/ks.cfg");
}
sub build_domain{
my $tck = shift;
my $domain_name = shift;
my $mode = @_ ? shift : "bridge";
my $guest;
my $mac = "52:54:00:11:11:11";
my $model = "virtio";
#my $filterref = "no-spoofing";
my $filterref = "clean-traffic";
my $network = "network";
my $source = "default";
my $dev = "eth2";
my $virtualport;
my ($cdrom, $ksurl) = build_cdrom_ks_image($tck);
my $guest = $tck->generic_domain($domain_name);
# change the type of network connection for 802.1Qbg tests
if ($mode eq "vepa") {
$network ="direct";
$virtualport = "802.1Qbg";
}
# We want a bigger disk than normal
$guest->rmdisk();
my $diskpath = $tck->create_sparse_disk("nwfilter", "main.img", 2048);
$guest->disk(src => $diskpath,
dst => "vda",
type=> "file");
my $diskalloc = (stat $diskpath)[12];
# No few blocks are allocated, then it likely hasn't been installed yet
my $install = 0;
if ($diskalloc < 10) {
$install = 1;
diag "Add cdrom";
$guest->disk(src => $cdrom, dst=>"hdc",
type=> "file", device => "cdrom");
my $cmdline = "ip=dhcp gateway=192.168.122.1 ks=$ksurl";
$guest->boot_cmdline($cmdline);
$guest->interface(type => $network,
source => $source,
model => $model,
mac => $mac);
} else {
diag "Do normal boot";
$guest->clear_kernel_initrd_cmdline();
if ($mode eq "vepa") {
$guest->interface(type => $network,
source => $source,
model => $model,
mac => $mac,
dev => $dev,
mode => $mode,
virtualport => $virtualport);
} else {
$guest->interface(type => $network,
source => $source,
model => $model,
mac => $mac,
filterref => $filterref);
}
}
# common configuration
$guest->maxmem("524288");
$guest->memory("524288");
$guest->graphics(type => "vnc",
port => "-1",
autoport => "yes",
listen => "127.0.0.1");
return ($guest, $install);
}
sub shutdown_vm_gracefully{
my $dom = shift;
$dom->shutdown;
while($dom->is_active()) {
sleep(1);
diag ".. waiting for virtual machine to shutdown.. ";
}
sleep(1);
diag ".. shutdown complete.. ";
}
sub prepare_test_disk_and_vm{
my $tck = shift;
my $conn = shift;
my $domain_name = shift;
my $mode = @_ ? shift : "bridge";
my ($guest, $need_install) = build_domain($tck, $domain_name, $mode);
if ($need_install) {
my $dom = $conn->define_domain($guest->as_xml);
diag "Starting installation domain";
$dom->create;
diag "wait for installation to finish .. ";
while($dom->is_active()) {
sleep(10);
diag ".. to view progress connect to virtual machine ${domain_name} .. ";
}
# cleanup install domain
$dom->undefine;
$dom = undef;
sleep (10);
diag " .. done";
}
($guest, $need_install) = build_domain($tck, $domain_name, $mode);
if ($need_install) {
die "guest install appears to have failed";
}
# now the disk is installed and we can boot it
my $dom = $conn->define_domain($guest->as_xml);
return $dom;
}
1;
|
