File Coverage

blib/lib/Metabrik/System/Freebsd/Iocage.pm
Criterion Covered Total %
statement 9 179 5.0
branch 0 84 0.0
condition 0 12 0.0
subroutine 3 31 9.6
pod 1 28 3.5
total 13 334 3.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # system::freebsd::iocage Brik
5             #
6             package Metabrik::System::Freebsd::Iocage;
7 1     1   805 use strict;
  1         2  
  1         49  
8 1     1   7 use warnings;
  1         1  
  1         31  
9              
10 1     1   6 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         2  
  1         2399  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             release => [ qw(version) ],
20             },
21             attributes_default => {
22             release => '10.2-RELEASE',
23             },
24             commands => {
25             install => [ ], # Inherited
26             list => [ ],
27             list_template => [ ],
28             show => [ ],
29             fetch => [ ],
30             update => [ ], # Alias to fetch
31             create => [ qw(tag interface|OPTIONAL ipv4_address|OPTIONAL ipv6_address|OPTIONAL) ],
32             start => [ qw(tag) ],
33             stop => [ qw(tag) ],
34             restart => [ qw(tag) ],
35             destroy => [ qw(tag) ],
36             delete => [ qw(tag) ], # Alias to destroy
37             execute => [ qw(tag command) ],
38             console => [ qw(tag) ],
39             set_template => [ qw(tag) ],
40             unset_template => [ qw(tag) ],
41             clone => [ qw(template tag interface ipv4_address ipv6_address|OPTIONAL) ],
42             get_all_properties => [ qw(tag) ],
43             get_property => [ qw(tag property) ],
44             set_property => [ qw(tag property value) ],
45             backup => [ qw(tag|$tag_list) ],
46             restore => [ qw(tag) ],
47             tag_to_uuid => [ qw(tag) ],
48             get_snapshots => [ qw(tag|OPTIONAL) ],
49             snaplist => [ qw(tag|OPTIONAL) ], # alias
50             delete_snapshot => [ qw(tag snapshot) ],
51             snapremove => [ qw(tag snapshot) ], # alias
52             },
53             require_binaries => {
54             iocage => [ ],
55             },
56             need_packages => {
57             freebsd => [ qw(iocage) ],
58             },
59             };
60             }
61              
62             #
63             # https://iocage.readthedocs.org/en/latest/basic-use.html
64             #
65             sub install {
66 0     0 0   my $self = shift;
67              
68 0           my $release = $self->release;
69              
70             # We have to run it as root the first time, so it is initiated correctly
71 0           my $cmd = "iocage fetch release=$release";
72              
73 0 0         $self->sudo_system($cmd) or return;
74              
75 0           return $self->SUPER::install(@_);
76             }
77              
78             sub list {
79 0     0 0   my $self = shift;
80 0           my ($arg) = @_;
81              
82 0   0       $arg ||= '';
83 0           my $cmd = "iocage list $arg";
84 0 0         my $lines = $self->capture($cmd) or return;
85              
86 0           my $header = 0;
87 0           my @jails = ();
88 0           for (@$lines) {
89 0 0         if (! $header) {
90 0           $header++;
91 0           next;
92             }
93              
94 0 0         if (/non iocage jails currently active/) {
95 0           last;
96             }
97              
98 0           my @toks = split(/\s+/, $_);
99 0           my ($ip, $interface) = split(/,/, $toks[5]);
100 0   0       $ip ||= '';
101 0   0       $interface ||= '';
102 0           push @jails, {
103             jid => $toks[0],
104             uuid => $toks[1],
105             boot => $toks[2],
106             state => $toks[3],
107             tag => $toks[4],
108             ip => $ip,
109             interface => $interface,
110             };
111             }
112              
113 0           return \@jails;
114             }
115              
116             sub list_template {
117 0     0 0   my $self = shift;
118              
119 0           return $self->list('-t');
120             }
121              
122             sub show {
123 0     0 0   my $self = shift;
124              
125 0           my $cmd = "iocage list";
126              
127 0           return $self->system($cmd);
128             }
129              
130             sub fetch {
131 0     0 0   my $self = shift;
132              
133 0           my $cmd = "iocage fetch";
134              
135 0           return $self->sudo_system($cmd);
136             }
137              
138             sub update {
139 0     0 0   my $self = shift;
140              
141 0           return $self->fetch(@_);
142             }
143              
144             sub create {
145 0     0 0   my $self = shift;
146 0           my ($tag, $interface, $ipv4_address, $ipv6_address) = @_;
147              
148 0 0         $self->brik_help_run_undef_arg('create', $tag) or return;
149              
150 0           my $cmd = "iocage create tag=$tag";
151              
152 0 0 0       if (defined($interface) && defined($ipv4_address)) {
153 0           $cmd .= " ip4_addr=\"$interface|$ipv4_address\"";
154             }
155              
156 0 0 0       if (defined($interface) && defined($ipv6_address)) {
157 0           $cmd .= " ip6_addr=\"$interface|$ipv6_address\"";
158             }
159              
160 0           return $self->sudo_system($cmd);
161             }
162              
163             sub start {
164 0     0 0   my $self = shift;
165 0           my ($tag) = @_;
166              
167 0 0         $self->brik_help_run_undef_arg('start', $tag) or return;
168              
169 0           my $cmd = "iocage start $tag";
170              
171 0           return $self->sudo_system($cmd);
172             }
173              
174             sub stop {
175 0     0 0   my $self = shift;
176 0           my ($tag) = @_;
177              
178 0 0         $self->brik_help_run_undef_arg('stop', $tag) or return;
179              
180 0           my $cmd = "iocage stop $tag";
181              
182 0           return $self->sudo_system($cmd);
183             }
184              
185             sub restart {
186 0     0 0   my $self = shift;
187 0           my ($tag) = @_;
188              
189 0 0         $self->brik_help_run_undef_arg('restart', $tag) or return;
190              
191 0           my $cmd = "iocage restart $tag";
192              
193 0           return $self->sudo_system($cmd);
194             }
195              
196             sub destroy {
197 0     0 0   my $self = shift;
198 0           my ($tag) = @_;
199              
200 0 0         $self->brik_help_run_undef_arg('destroy', $tag) or return;
201              
202 0           my $cmd = "iocage destroy $tag";
203              
204 0           return $self->sudo_system($cmd);
205             }
206              
207             sub delete {
208 0     0 0   my $self = shift;
209              
210 0           return $self->destroy(@_);
211             }
212              
213             sub execute {
214 0     0 0   my $self = shift;
215 0           my ($tag, $command) = @_;
216              
217 0 0         $self->brik_help_run_undef_arg('execute', $tag) or return;
218 0 0         $self->brik_help_run_undef_arg('execute', $command) or return;
219              
220 0           my $cmd = "iocage exec $tag $command";
221              
222 0           return $self->sudo_execute($cmd);
223             }
224              
225             sub console {
226 0     0 0   my $self = shift;
227 0           my ($tag) = @_;
228              
229 0           return $self->execute($tag, "/bin/csh");
230             #my $cmd = "iocage chroot $tag /bin/csh";
231              
232             #return $self->sudo_system($cmd);
233             }
234              
235             #
236             # https://iocage.readthedocs.org/en/latest/templates.html
237             #
238             sub set_template {
239 0     0 0   my $self = shift;
240 0           my ($tag) = @_;
241              
242 0 0         $self->brik_help_run_undef_arg('set_template', $tag) or return;
243              
244 0           my $cmd = "iocage set template=yes $tag";
245              
246 0           return $self->sudo_system($cmd);
247             }
248              
249             sub unset_template {
250 0     0 0   my $self = shift;
251 0           my ($tag) = @_;
252              
253 0 0         $self->brik_help_run_undef_arg('unset_template', $tag) or return;
254              
255 0           my $cmd = "iocage set template=no $tag";
256              
257 0           return $self->sudo_system($cmd);
258             }
259              
260             sub clone {
261 0     0 0   my $self = shift;
262 0           my ($template, $tag, $interface, $ipv4_address, $ipv6_address) = @_;
263              
264 0 0         $self->brik_help_run_undef_arg('clone', $template) or return;
265 0 0         $self->brik_help_run_undef_arg('clone', $tag) or return;
266 0 0         $self->brik_help_run_undef_arg('clone', $interface) or return;
267 0 0         $self->brik_help_run_undef_arg('clone', $ipv4_address) or return;
268              
269 0           my $cmd = "iocage clone $template tag=$tag ip4_addr=\"$interface|$ipv4_address\"";
270              
271 0 0         if (defined($ipv6_address)) {
272 0           $cmd .= " ip6_addr=\"$interface|$ipv6_address\"";
273             }
274              
275 0           return $self->sudo_system($cmd);
276             }
277              
278             sub get_all_properties {
279 0     0 0   my $self = shift;
280 0           my ($tag) = @_;
281              
282 0 0         $self->brik_help_run_undef_arg('get_all_properties', $tag) or return;
283              
284 0           my $cmd = "iocage get all $tag";
285 0 0         my $r = $self->sudo_capture($cmd) or return;
286              
287 0           return $r;
288             }
289              
290             sub get_property {
291 0     0 0   my $self = shift;
292 0           my ($tag, $property) = @_;
293              
294 0 0         $self->brik_help_run_undef_arg('get_property', $tag) or return;
295 0 0         $self->brik_help_run_undef_arg('get_property', $property) or return;
296              
297 0           my $cmd = "iocage get $property $tag";
298 0 0         my $r = $self->sudo_capture($cmd) or return;
299 0           chomp($r);
300              
301 0           return $r;
302             }
303              
304             sub set_property {
305 0     0 0   my $self = shift;
306 0           my ($tag, $property, $value) = @_;
307              
308 0 0         $self->brik_help_run_undef_arg('set_property', $tag) or return;
309 0 0         $self->brik_help_run_undef_arg('set_property', $property) or return;
310 0 0         $self->brik_help_run_undef_arg('set_property', $value) or return;
311              
312 0           my $cmd = "iocage set $property=\"$value\" $tag";
313              
314 0           return $self->sudo_system($cmd);
315             }
316              
317             sub backup {
318 0     0 0   my $self = shift;
319 0           my ($tag) = @_;
320              
321 0 0         $self->brik_help_run_undef_arg('backup', $tag) or return;
322 0 0         my $ref = $self->brik_help_run_invalid_arg('backup', $tag, 'ARRAY', 'SCALAR')
323             or return;
324              
325 0 0         if ($ref eq 'ARRAY') {
326 0           for my $tag (@$tag) {
327 0           my $cmd = "iocage snapshot \"$tag\"";
328 0           $self->sudo_system($cmd);
329             }
330 0           return 1;
331             }
332              
333 0           my $cmd = "iocage snapshot \"$tag\"";
334              
335 0           return $self->sudo_system($cmd);
336             }
337              
338             sub restore {
339 0     0 0   my $self = shift;
340 0           my ($tag) = @_;
341              
342 0 0         $self->brik_help_run_undef_arg('restore', $tag) or return;
343              
344 0           my $cmd = "iocage rollback \"$tag\"";
345              
346 0           return $self->sudo_system($cmd);
347             }
348              
349             sub tag_to_uuid {
350 0     0 0   my $self = shift;
351 0           my ($tag) = @_;
352              
353 0 0         $self->brik_help_run_undef_arg('tag_to_uuid', $tag) or return;
354              
355 0 0         my $list = $self->list or return;
356 0           for my $this (@$list) {
357 0 0         if ($this->{tag} eq $tag) {
358 0           return $this->{uuid};
359             }
360             }
361              
362 0           return 'undef';
363             }
364              
365             sub get_snapshots {
366 0     0 0   my $self = shift;
367 0           my ($tag) = @_;
368              
369             # If no tag is given, we will do it for all running iocages
370 0           my @tags;
371 0 0         if (! defined($tag)) {
372 0 0         my $list = $self->list or return;
373 0           for my $this (@$list) {
374 0           push @tags, $this->{tag};
375             }
376             }
377             else {
378 0           push @tags, $tag;
379             }
380              
381 0           my @snapshots = ();
382 0           for my $tag (@tags) {
383 0           my $cmd = "iocage snaplist $tag";
384 0 0         my $lines = $self->sudo_capture($cmd) or return;
385              
386             # NAME CREATED RSIZE USED
387             # ioc-2016-12-06_16:22:47 Tue Dec 6 16:22 2016 96K 8K
388              
389 0           my $header = 0;
390 0           for (@$lines) {
391 0 0         if (! $header) { # Skip first line, it is a header
392 0           $header++;
393 0           next;
394             }
395              
396 0 0         if (/^(ioc\-\S+)\s+(\S+\s+\S+\s+\S+\s+\S+\s+\S+)\s+(\S+)\s+(\S+)$/) {
397 0           push @snapshots, {
398             tag => $tag,
399             name => $1,
400             created => $2,
401             rsize => $3,
402             used => $4,
403             };
404             }
405             }
406             }
407              
408 0           return \@snapshots;
409             }
410              
411             # alias
412             sub snaplist {
413 0     0 0   my $self = shift;
414              
415 0           return $self->get_snapshots(@_);
416             }
417              
418             sub delete_snapshot {
419 0     0 0   my $self = shift;
420 0           my ($tag, $snapshot) = @_;
421              
422 0 0         $self->brik_help_run_undef_arg('delete_snapshot', $tag) or return;
423 0 0         $self->brik_help_run_undef_arg('delete_snapshot', $snapshot) or return;
424              
425 0           my $cmd = "iocage snapremove $tag\@$snapshot";
426 0           return $self->sudo_system($cmd);
427             }
428              
429             # alias
430             sub snapremove {
431 0     0 0   my $self = shift;
432              
433 0           return $self->snapremove(@_);
434             }
435              
436             1;
437              
438             __END__