line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# (c) Jan Gehring |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Rex::Virtualization::LibVirt::blklist; |
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
15
|
use v5.12.5; |
|
1
|
|
|
|
|
4
|
|
8
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
54
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '1.14.2.3'; # TRIAL VERSION |
11
|
|
|
|
|
|
|
|
12
|
1
|
|
|
1
|
|
8
|
use Rex::Logger; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
5
|
|
13
|
1
|
|
|
1
|
|
30
|
use Rex::Helper::Run; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
57
|
|
14
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
7
|
use Data::Dumper; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
495
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub execute { |
18
|
0
|
|
|
0
|
0
|
|
shift; |
19
|
0
|
|
|
|
|
|
my $vmname = shift; |
20
|
0
|
|
|
|
|
|
my %options = @_; |
21
|
0
|
|
|
|
|
|
my $virt_settings = Rex::Config->get("virtualization"); |
22
|
|
|
|
|
|
|
chomp( my $uri = |
23
|
0
|
0
|
|
|
|
|
ref($virt_settings) ? $virt_settings->{connect} : i_run "virsh uri" ); |
24
|
|
|
|
|
|
|
|
25
|
0
|
0
|
|
|
|
|
unless ($vmname) { |
26
|
0
|
|
|
|
|
|
die("You have to define the vm name!"); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
Rex::Logger::debug("Getting block list of domain: $vmname"); |
30
|
|
|
|
|
|
|
|
31
|
0
|
|
|
|
|
|
my @blklist = i_run "virsh -c $uri domblklist '$vmname' --details", |
32
|
|
|
|
|
|
|
fail_ok => 1; |
33
|
|
|
|
|
|
|
|
34
|
0
|
0
|
|
|
|
|
if ( $? != 0 ) { |
35
|
0
|
|
|
|
|
|
die("Error running virsh domblklist '$vmname'"); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
0
|
|
|
|
|
|
my %ret = (); |
39
|
0
|
|
|
|
|
|
my ( $k, $v ); |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
|
shift @blklist; |
42
|
0
|
|
|
|
|
|
shift @blklist; |
43
|
0
|
|
|
|
|
|
for my $line (@blklist) { |
44
|
0
|
|
|
|
|
|
my ( $type, $device, $target, $source ) = split( /\s+/, $line ); |
45
|
0
|
|
|
|
|
|
$ret{$target} = { |
46
|
|
|
|
|
|
|
type => $type, |
47
|
|
|
|
|
|
|
device => $device, |
48
|
|
|
|
|
|
|
source => $source |
49
|
|
|
|
|
|
|
}; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
0
|
0
|
|
|
|
|
if (%options) { |
53
|
0
|
0
|
|
|
|
|
if ( $options{details} ) { |
54
|
0
|
|
0
|
|
|
|
my $unit = $options{unit} || 1; |
55
|
0
|
|
|
|
|
|
for my $target ( keys %ret ) { |
56
|
0
|
|
|
|
|
|
my @infos = |
57
|
|
|
|
|
|
|
i_run "virsh -c $uri domblkinfo '$vmname' '$target' 2>/dev/null", |
58
|
|
|
|
|
|
|
fail_ok => 1; |
59
|
0
|
0
|
|
|
|
|
if ( $? == 0 ) { |
60
|
0
|
|
|
|
|
|
for my $line (@infos) { |
61
|
0
|
|
|
|
|
|
my ( $k, $v ) = split( /:\s+/, $line ); |
62
|
0
|
|
|
|
|
|
$ret{$target}->{$k} = $v / $unit; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
return \%ret; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
1; |