File Coverage

blib/lib/Metabrik/System/Libvirt.pm
Criterion Covered Total %
statement 9 82 10.9
branch 0 40 0.0
condition 0 27 0.0
subroutine 3 14 21.4
pod 1 11 9.0
total 13 174 7.4


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # system::libvirt Brik
5             #
6             package Metabrik::System::Libvirt;
7 1     1   837 use strict;
  1         3  
  1         62  
8 1     1   7 use warnings;
  1         2  
  1         29  
9              
10 1     1   6 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         2  
  1         1174  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable virtualisation) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             driver => [ qw(qemu|vbox) ],
21             capture_mode => [ qw(0|1) ],
22             },
23             attributes_default => {
24             driver => 'qemu',
25             capture_mode => 1,
26             },
27             commands => {
28             install => [ ], # Inherited
29             is_kvm_supported => [ ],
30             command => [ qw(command driver|OPTIONAL) ],
31             list => [ qw(driver|OPTIONAL) ],
32             reboot => [ qw(name driver|OPTIONAL) ],
33             restart => [ qw(name driver|OPTIONAL) ], # Alias for reboot
34             start => [ qw(name driver|OPTIONAL) ],
35             shutdown => [ qw(name driver|OPTIONAL) ],
36             stop => [ qw(name driver|OPTIONAL) ], # Alias for shutdown
37             save => [ qw(name file driver|OPTIONAL) ],
38             restore => [ qw(name file driver|OPTIONAL) ],
39             },
40             require_binaries => {
41             virsh => [ ],
42             'kvm-ok' => [ ],
43             },
44             need_packages => {
45             ubuntu => [ qw(qemu-kvm libvirt-bin virtinst) ],
46             debian => [ qw(qemu-kvm libvirt-bin virtinst) ],
47             kali => [ qw(qemu-kvm libvirt-bin virtinst) ],
48             },
49             };
50             }
51              
52             #
53             # https://help.ubuntu.com/lts/serverguide/libvirt.html
54             #
55              
56             sub is_kvm_supported {
57 0     0 0   my $self = shift;
58              
59 0           my $lines = $self->capture('kvm-ok');
60              
61 0           my $ok = 0;
62 0           for my $line (@$lines) {
63 0 0         if ($line =~ /can be used/) {
64 0           $ok = 1;
65 0           last;
66             }
67             }
68              
69 0           return $ok;
70             }
71              
72             sub command {
73 0     0 0   my $self = shift;
74 0           my ($command, $driver) = @_;
75              
76 0   0       $driver ||= $self->driver;
77 0 0         $self->brik_help_run_undef_arg('command', $command) or return;
78 0 0         $self->brik_help_run_undef_arg('command', $driver) or return;
79              
80 0           my $uri = $driver.':///system';
81 0 0         if ($driver eq 'vbox') {
82 0           $uri = $driver.':///session';
83             }
84              
85 0           my $cmd = "virsh -c $uri $command";
86              
87 0           return $self->execute($cmd);
88             }
89              
90             sub list {
91 0     0 0   my $self = shift;
92 0           my ($driver) = @_;
93              
94 0   0       $driver ||= $self->driver;
95 0 0         $self->brik_help_run_undef_arg('list', $driver) or return;
96              
97 0           my %list = ();
98              
99 0 0         my $lines = $self->command('list', $driver) or return;
100 0           for my $line (@$lines) {
101 0           $line =~ s/^\s*//;
102 0           $line =~ s/\s*$//;
103 0           my @toks = split(/\s+/, $line);
104              
105 0 0         if ($toks[0] =~ /^\d+$/) { # We have a valid line
106 0           my $id = shift @toks;
107 0           my $state = pop @toks;
108 0           my $name = join(' ', @toks);
109 0 0 0       if (defined($id) && defined($state) && defined($name)) {
      0        
110 0           $list{$id} = { id => $id, state => $state, name => $name };
111             }
112             else {
113 0           $self->log->warning("list: error occured while parsing line [$line]");
114             }
115             }
116             }
117              
118 0           return \%list;
119             }
120              
121             sub reboot {
122 0     0 0   my $self = shift;
123 0           my ($name, $driver) = @_;
124              
125 0   0       $driver ||= $self->driver;
126 0 0         $self->brik_help_run_undef_arg('reboot', $name) or return;
127 0 0         $self->brik_help_run_undef_arg('reboot', $driver) or return;
128              
129 0           return $self->command("reboot \"$name\"", $driver);
130             }
131              
132             sub restart {
133 0     0 0   my $self = shift;
134              
135 0           return $self->reboot(@_);
136             }
137              
138             sub start {
139 0     0 0   my $self = shift;
140 0           my ($name, $driver) = @_;
141              
142 0   0       $driver ||= $self->driver;
143 0 0         $self->brik_help_run_undef_arg('start', $name) or return;
144 0 0         $self->brik_help_run_undef_arg('start', $driver) or return;
145              
146 0           return $self->command("start \"$name\"", $driver);
147             }
148              
149             sub shutdown {
150 0     0 0   my $self = shift;
151 0           my ($name, $driver) = @_;
152              
153 0   0       $driver ||= $self->driver;
154 0 0         $self->brik_help_run_undef_arg('shutdown', $name) or return;
155 0 0         $self->brik_help_run_undef_arg('shutdown', $driver) or return;
156              
157 0           return $self->command("shutdown \"$name\"", $driver);
158             }
159              
160             sub stop {
161 0     0 0   my $self = shift;
162              
163 0           return $self->shutdown(@_);
164             }
165              
166             sub save {
167 0     0 0   my $self = shift;
168 0           my ($name, $file, $driver) = @_;
169              
170 0   0       $driver ||= $self->driver;
171 0 0         $self->brik_help_run_undef_arg('save', $name) or return;
172 0 0         $self->brik_help_run_undef_arg('save', $file) or return;
173 0 0         $self->brik_help_run_undef_arg('save', $driver) or return;
174              
175 0           return $self->command("save \"$name\" $file", $driver);
176             }
177              
178             sub restore {
179 0     0 0   my $self = shift;
180 0           my ($name, $file, $driver) = @_;
181              
182 0   0       $driver ||= $self->driver;
183 0 0         $self->brik_help_run_undef_arg('restore', $name) or return;
184 0 0         $self->brik_help_run_undef_arg('restore', $file) or return;
185 0 0         $self->brik_help_run_undef_arg('restore', $driver) or return;
186              
187 0           return $self->command("restore \"$name\" $file", $driver);
188             }
189              
190             1;
191              
192             __END__