File Coverage

blib/lib/Container/Buildah/Subcommand.pm
Criterion Covered Total %
statement 203 447 45.4
branch 94 242 38.8
condition 15 30 50.0
subroutine 21 44 47.7
pod 17 36 47.2
total 350 799 43.8


line stmt bran cond sub pod time code
1             # Container::Buildah::Subcommand
2             # ABSTRACT: wrapper class for Container::Buildah to run subcommands of buildah
3             # by Ian Kluft
4              
5             ## no critic (Modules::RequireExplicitPackage)
6             # 'use strict' and 'use warnings' included here
7 6     6   42 use Modern::Perl qw(2015); # require 5.20.0
  6         11  
  6         65  
8             ## use critic (Modules::RequireExplicitPackage)
9              
10             package Container::Buildah::Subcommand;
11             $Container::Buildah::Subcommand::VERSION = '0.3.1';
12 6     6   1164 use autodie;
  6         11  
  6         37  
13 6     6   28455 use Carp qw(croak confess);
  6         84  
  6         563  
14 6     6   100 use POSIX qw(uname);
  6         14  
  6         53  
15 6     6   6143 use IPC::Run;
  6         135304  
  6         302  
16 6     6   53 use Data::Dumper;
  6         11  
  6         287  
17 6     6   37 use YAML::XS;
  6         12  
  6         310  
18             require Container::Buildah;
19              
20             # exports
21 6     6   47 use Exporter qw(import);
  6         21  
  6         41820  
22             our @EXPORT_OK = qw(process_params prog);
23              
24             #
25             # parameter processing functions used by process_params()
26             #
27              
28             # params_extract - set aside parameters which caller wants extracted for further processing that we can't generalize
29             # private class function
30             sub params_extract
31             {
32 29     29 0 58 my ($defs, $params, $extract_ref) = @_;
33              
34 29 100       77 if (exists $defs->{extract}) {
35 5 100       18 if (ref $defs->{extract} ne "ARRAY") {
36 1         240 confess "process_params parameter 'extract' must be an array, got ".(ref $defs->{extract});
37             }
38 4         7 foreach my $argname (@{$defs->{extract}}) {
  4         12  
39 8 100       22 if (exists $params->{$argname}) {
40 5         23 $extract_ref->{$argname} = $params->{$argname};
41 5         12 delete $params->{$argname};
42             }
43             }
44             }
45 28         50 return;
46             }
47              
48             # param_arg_init - initialize argument list
49             # private class function
50             sub param_arg_init
51             {
52 28     28 0 54 my ($defs, $arg_ref) = @_;
53              
54 28 100       62 if (exists $defs->{arg_init}) {
55 2 50       13 if (not ref $defs->{arg_init}) {
    100          
56 0         0 push @$arg_ref, $defs->{arg_init};
57             } elsif (ref $defs->{arg_init} eq "ARRAY") {
58 1         3 push @$arg_ref, @{$defs->{arg_init}};
  1         6  
59             } else {
60 1         142 confess "process_params parameter 'arg_init' must be scalar or array, got ".(ref $defs->{arg_init});
61             }
62             }
63 27         74 return;
64             }
65              
66             # param_exclusive - check for exclusive parameters - if any are present, it must be the only parameter
67             # private class function
68             sub param_exclusive
69             {
70 27     27 0 57 my ($name, $defs, $params, $extract_ref) = @_;
71              
72 27 100       73 if (exists $defs->{exclusive}) {
73 3 100       11 if (ref $defs->{exclusive} ne "ARRAY") {
74 1         124 confess "process_params parameter 'exclusive' must be an array, got ".(ref $defs->{exclusive});
75             }
76 2         4 foreach my $argname (@{$defs->{exclusive}}) {
  2         7  
77 2 50       7 if (exists $params->{$argname}) {
78             # if other flags exist with an exclusive flag, that's an error
79 2 100       8 if (scalar keys %$params > 1) {
80 1         175 croak "$name parameter '".$argname."' is exclusive - cannot be passed with other parameters";
81             }
82              
83             # exclusive flag saved in extracted fields so caller can detect it
84 1         5 $extract_ref->{$argname} = $params->{$argname};
85             }
86             }
87             }
88 25         46 return;
89             }
90              
91             # param_arg_flag - process arguments which are boolean flags, excluding those requiring true/false as a string
92             # private class function
93             sub param_arg_flag
94             {
95 25     25 0 52 my ($name, $defs, $params, $arg_ref) = @_;
96              
97 25 100       52 if (exists $defs->{arg_flag}) {
98 2 100       9 if (ref $defs->{arg_flag} ne "ARRAY") {
99 1         122 confess "process_params parameter 'arg_flag' must be an array, got ".(ref $defs->{arg_flag});
100             }
101 1         3 foreach my $argname (@{$defs->{arg_flag}}) {
  1         3  
102 1 50       4 if (exists $params->{$argname}) {
103 1 50       4 if (ref $params->{$argname}) {
104 0         0 confess "$name parameter '".$argname."' must be scalar, got ".(ref $params->{$argname});
105             }
106 1         4 push @$arg_ref, "--$argname";
107 1         4 delete $params->{$argname};
108             }
109             }
110             }
111 24         61 return;
112             }
113              
114             # param_arg_flag_str - process arguments which are boolean flags, requiring true/false as a string
115             # private class function
116             sub param_arg_flag_str
117             {
118 24     24 0 61 my ($name, $defs, $params, $arg_ref) = @_;
119              
120 24 100       53 if (exists $defs->{arg_flag_str}) {
121 4 100       15 if (ref $defs->{arg_flag_str} ne "ARRAY") {
122 1         124 confess "process_params parameter 'arg_flag_str' must be an array, got ".(ref $defs->{arg_flag_str});
123             }
124 3         5 foreach my $argname (@{$defs->{arg_flag_str}}) {
  3         9  
125 3 50       9 if (exists $params->{$argname}) {
126 3 50       9 if (ref $params->{$argname}) {
127 0         0 confess "$name parameter '".$argname."' must be scalar, got ".(ref $params->{$argname});
128             }
129 3 100 100     17 if ($params->{$argname} ne "true" and $params->{$argname} ne "false") {
130 1         97 croak "$name parameter '".$argname."' must be 'true' or 'false', got '".$params->{$argname}."'";
131             }
132 2         6 push @$arg_ref, "--$argname", $params->{$argname};
133 2         6 delete $params->{$argname};
134             }
135             }
136             }
137 22         35 return;
138             }
139              
140             # param_arg_str - process arguments which take a single string
141             # private class function
142             sub param_arg_str
143             {
144 22     22 0 54 my ($name, $defs, $params, $arg_ref) = @_;
145              
146 22 100       49 if (exists $defs->{arg_str}) {
147 4 100       15 if (ref $defs->{arg_str} ne "ARRAY") {
148 1         123 confess "process_params parameter 'arg_str' must be an array, got ".(ref $defs->{arg_str});
149             }
150 3         5 foreach my $argname (@{$defs->{arg_str}}) {
  3         11  
151 5 100       15 if (exists $params->{$argname}) {
152 4 100       11 if (ref $params->{$argname}) {
153 1         162 confess "$name parameter '".$argname."' must be scalar, got ".(ref $params->{$argname});
154             }
155 3         12 push @$arg_ref, "--$argname", $params->{$argname};
156 3         8 delete $params->{$argname};
157             }
158             }
159             }
160 20         55 return;
161             }
162              
163             # param_arg_array - process arguments which take an array (converted to multiple occurrences on command line)
164             # private class function
165             sub param_arg_array
166             {
167 20     20 0 63 my ($name, $defs, $params, $arg_ref) = @_;
168              
169 20 100       47 if (exists $defs->{arg_array}) {
170 4 100       14 if (ref $defs->{arg_array} ne "ARRAY") {
171 1         126 confess "process_params parameter 'arg_array' must be an array, got ".(ref $defs->{arg_array});
172             }
173 3         5 foreach my $argname (@{$defs->{arg_array}}) {
  3         8  
174 3 50       12 if (exists $params->{$argname}) {
175 3 100       13 if (not ref $params->{$argname}) {
    100          
176 1         4 push @$arg_ref, "--$argname", $params->{$argname};
177             } elsif (ref $params->{$argname} eq "ARRAY") {
178 1         2 foreach my $entry (@{$params->{$argname}}) {
  1         4  
179 2         6 push @$arg_ref, "--$argname", $entry;
180             }
181             } else {
182 1         131 confess "$name parameter '".$argname."' must be scalar or array, got ".(ref $params->{$argname});
183             }
184 2         7 delete $params->{$argname};
185             }
186             }
187             }
188 18         27 return;
189             }
190              
191             # param_arg_list - process arguments which are formatted as a list on the command-line
192             # This is only used by buildah-config's entrypoint parameter. This wrapper allows the parameter to be given as
193             # an array structure which will be provided to buildah formatted as a string parameter.
194             # private class function
195             sub param_arg_list
196             {
197 18     18 0 37 my ($name, $defs, $params, $arg_ref) = @_;
198              
199 18 100       39 if (exists $defs->{arg_list}) {
200 4 100       13 if (ref $defs->{arg_list} ne "ARRAY") {
201 1         122 confess "process_params parameter 'arg_list' must be an array, got ".(ref $defs->{arg_list});
202             }
203 3         6 foreach my $argname (@{$defs->{arg_list}}) {
  3         9  
204 3 50       11 if (exists $params->{$argname}) {
205 3 100       16 if (not ref $params->{$argname}) {
    100          
206 1         4 push @$arg_ref, "--$argname", $params->{$argname};
207             } elsif (ref $params->{$argname} eq "ARRAY") {
208 1         4 push @$arg_ref, "--$argname", '[ "'.join('", "', @{$params->{$argname}}).'" ]';
  1         6  
209             } else {
210 1         130 confess "$name parameter '$argname' must be scalar or array, got ".(ref $params->{$argname});
211             }
212 2         7 delete $params->{$argname};
213             }
214             }
215             }
216 16         26 return;
217             }
218              
219             # parameter processing for buildah subcommand wrapper functions
220             # private class function - used only by Container::Buildah and Container::Buildah::Stage
221             #
222             # usage: ($extract, @args) = process_params({name => str, deflist => [ ... ], ... }, \%params);
223             # deflist can be any of: extract exclusive arg_init arg_flag arg_flag_str arg_str arg_array arg_list
224             #
225             # All the buildah subcommand wrapper functions use similar logic to process parameters, which is centralized here.
226             # This builds an argument list to be used by a buildah subcommand.
227             # Parameters are the same names as command-line arguments of buildah subcommands.
228             sub process_params
229             {
230 29     29 0 28214 my $defs = shift; # defintions of parameters to process
231 29         56 my $params = shift; # received parameters
232              
233             # results to build and return
234 29         57 my @args; # argument list result to pass back
235             my %extracted; # parameters extracted by name
236              
237             # get wrapper function name to use in error reporting
238             # use caller function name if not provided
239 29   33     319 my $name = $defs->{name} // (caller(1))[3];
240              
241             # set aside parameters which caller wants extracted for further processing that we can't generalize here
242 29         125 params_extract($defs, $params, \%extracted);
243              
244             # initialize argument list
245 28         74 param_arg_init($defs, \@args);
246              
247             # check for exclusive parameters - if any are present, it must be the only parameter
248 27         78 param_exclusive($name, $defs, $params, \%extracted);
249              
250             # process arguments which are boolean flags, excluding those requiring true/false as a string
251 25         62 param_arg_flag($name, $defs, $params, \@args);
252              
253             # process arguments which are boolean flags, requiring true/false as a string
254 24         75 param_arg_flag_str($name, $defs, $params, \@args);
255              
256             # process arguments which take a single string
257 22         60 param_arg_str($name, $defs, $params, \@args);
258              
259             # process arguments which take an array (converted to multiple occurrences on command line)
260 20         56 param_arg_array($name, $defs, $params, \@args);
261              
262             # process arguments which are formatted as a list on the command-line
263             # (this is only used by buildah-config's entrypoint parameter)
264 18         44 param_arg_list($name, $defs, $params, \@args);
265              
266             # error out if any unexpected parameters remain
267 16 100       39 if (%$params) {
268 1         137 confess "$name received undefined parameters: ".(join(" ", keys %$params));
269             }
270              
271             # return processed argument list
272 15         60 return (\%extracted, @args);
273             }
274              
275             #
276             # system access utility functions
277             #
278              
279             # generate name of environment variable for where to find a command
280             # this is broken out as a separate function for tests to use it
281             # private class function
282             sub envprog
283             {
284 21     21 0 11246 my $progname = shift;
285 21         49 my $envprog = (uc $progname)."_PROG";
286 21         62 $envprog =~ s/[\W-]+/_/xg; # collapse any sequences of non-alphanumeric/non-underscore to a single underscore
287 21         40 return $envprog;
288             }
289              
290             # look up program in standard Linux/POSIX path, not using PATH environment variable for security
291             # private class function
292             sub prog
293             {
294 18     18 1 5895 my $progname = shift;
295 18         63 my $cb = Container::Buildah->instance();
296              
297 18 100       142 if (!exists $cb->{prog}) {
298 2         7 $cb->{prog} = {};
299             }
300 18         30 my $prog = $cb->{prog};
301              
302             # call with undef to initialize cache (needed for testing because normal use will auto-create it)
303 18 100       34 if (!defined $progname) {
304 1         3 return;
305             }
306              
307             # return value from cache if found
308 17 100       38 if (exists $prog->{$progname}) {
309 5         46 return $prog->{$progname};
310             }
311              
312             # if we didn't have the location of the program, look for it and cache the result
313 12         25 my $envprog = envprog($progname);
314 12 100 66     56 if (exists $ENV{$envprog} and -x $ENV{$envprog}) {
315 1         8 $prog->{$progname} = $ENV{$envprog};
316 1         6 return $prog->{$progname};
317             }
318              
319             # search paths in order emphasizing recent Linux Filesystem that prefers /usr/bin, then Unix PATH order
320 11         16 my $found;
321 11         22 for my $path ("/usr/bin", "/sbin", "/usr/sbin", "/bin") {
322 44 100       630 if (-x "$path/$progname") {
323 10         47 $prog->{$progname} = "$path/$progname";
324 10         16 $found = $prog->{$progname};
325 10         20 last;
326             }
327             }
328              
329             # return path, or error if we didn't find a known secure location for the program
330 11 100       20 if (not defined $found) {
331 1         170 croak "unknown secure location for $progname - install it or set $envprog to point to it";
332             }
333 10         51 return $found
334             }
335              
336             #
337             # external command functions
338             #
339              
340             # run a command and report errors
341             # private class method
342             sub cmd
343             {
344 10     10 1 22007 my ($class_or_obj, $opts, @in_args) = @_;
345 10 50       60 my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
346 10 50       36 my $name = (exists $opts->{name}) ? $opts->{name} : "cmd";
347              
348             # exception-handling wrapper
349 10         35 my $outstr;
350             eval {
351             # disallow undef in in_args
352 10         105 Container::Buildah::disallow_undef(\@in_args);
353              
354             # use IPC::Run to capture or suppress output as requested
355 9         96 $cb->debug({level => 4}, "cmd $name ".join(" ", @in_args));
356 9         26 my $outdest = \*STDOUT;
357 9         15 my $errdest = \*STDERR;
358 9 100 100     95 if ($opts->{capture_output} // 0) {
    50 50        
359 2         11 $outdest = \$outstr;
360             } elsif ($opts->{suppress_output} // 0) {
361 0         0 $outdest = "/dev/null";
362             }
363 9 50 50     56 if ($opts->{suppress_error} // 0) {
364 0         0 $errdest = "/dev/null";
365             }
366 9         65 IPC::Run::run(\@in_args, '<', \undef, '>', $outdest, '2>', $errdest);
367              
368             # process result codes
369 8 50       75007 if ($? == -1) {
370 0         0 confess "failed to execute command (".join(" ", @in_args)."): $!";
371             }
372 8 50       69 if ($? & 127) {
373 0 0       0 confess sprintf "command (".join(" ", @in_args)." child died with signal %d, %s coredump\n",
374             ($? & 127), ($? & 128) ? 'with' : 'without';
375             }
376 8         40 my $retcode = $? >> 8;
377 8 50 33     119 if (exists $opts->{save_retcode} and ref $opts->{save_retcode} eq "SCALAR") {
378 8         40 ${$opts->{save_retcode}} = $retcode; # save return code via a scalar ref for testing
  8         27  
379             }
380 8 100 66     56 if ($retcode != 0) {
    100          
381             # invoke callback for nonzero result, and pass it the result code
382             # this may be used to prevent exceptions for commands that return specific unharmful nonzero results
383 4 100 66     43 if (exists $opts->{nonzero} and ref $opts->{nonzero} eq "CODE") {
384 2         12 &{$opts->{nonzero}}($retcode);
  2         25  
385             } else {
386 2         824 confess "non-zero status ($retcode) from cmd ".join(" ", @in_args);
387             }
388             } elsif (exists $opts->{zero} and ref $opts->{zero} eq "CODE") {
389             # invoke callback for zero result
390 1         9 &{$opts->{zero}}();
  1         15  
391             }
392 6         48 1;
393 10 100       17 } or do {
394 4 50       2024 if ($@) {
395 4         364 confess "$name: ".$@;
396             }
397             };
398 6         134 return $outstr;
399             }
400              
401             # check that the OS kernel is capable of running containers
402             # returns true/false, caches result in config data
403             # used by buildah() method and unit tests
404             # public class method
405             sub container_compat_check
406             {
407 1     1 0 124 my ($class_or_obj, @in_args) = @_;
408 1 50       7 my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
409              
410             # check if kernel has already been tested
411 1         4 my $config_key = "container_compat";
412 1         6 my $test_result = $cb->get_config($config_key);
413 1 50       3 if (defined $test_result) {
414 0         0 $cb->debug({level => 4}, "container_compat_check: cached result $test_result");
415 0         0 return $test_result;
416             }
417              
418             # call POSIX::uname() to get kernel name and release
419 1         3 $test_result = 0; # reset value and assume false
420 1         15 my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
421 1         10 my ($kmajor, $kminor) = ($release =~ /^([0-9]+)\.([0-9]+)\./x);
422              
423             # currently only Linux 2.8 kernels and above support containers
424             # adjust as necessary if others (i.e. BSD variants) add container compatibility in the future
425 1 50       4 if ($sysname eq "Linux") {
426 1 50 0     3 if ($kmajor >= 3) {
    0          
427 1         3 $test_result = 1;
428             } elsif ($kmajor == 2 and $kminor >= 8) {
429 0         0 $test_result = 1;
430             }
431             }
432              
433             # cache the result in the config data and return it
434 1         4 my $config = $cb->get_config();
435 1         3 $config->{$config_key} = $test_result;
436 1         7 $cb->debug({level => 4}, "container_compat_check: test result $test_result");
437 1         5 return $test_result
438             }
439              
440             # run buildah command with parameters
441             # public class method
442             sub buildah
443             {
444 0     0 1   my ($class_or_obj, @in_args) = @_;
445 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
446              
447             # verify kernel compatibility
448 0 0         $cb->container_compat_check() or croak "buildah(): kernel is not container-compatible";
449              
450             # collect options to pass along to cmd() method
451 0           my $opts = {};
452 0 0         if (ref $in_args[0] eq "HASH") {
453 0           $opts = shift @in_args;
454             }
455 0           $opts->{name} = "buildah";
456              
457 0           Container::Buildah::disallow_undef(\@in_args);
458 0           $cb->debug({level => 3}, "buildah: args = ".join(" ", @in_args));
459 0           return $cb->cmd($opts, prog("buildah"), @in_args);
460             }
461              
462             #
463             # buildah subcommand wrapper methods
464             # for subcommands which do not have a container name parameter (those are in Container::Buildah::Stage)
465             #
466              
467             # front end to "buildah bud" (build under dockerfile) subcommand
468             # usage: $cb->bud({name => value, ...}, context)
469             # public class method
470             sub bud
471             {
472 0     0 1   my ($class_or_obj, @in_args) = @_;
473 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
474 0           my $params = {};
475 0 0         if (ref $in_args[0] eq "HASH") {
476 0           $params = shift @in_args;
477             }
478              
479             # process parameters
480 0           my ($extract, @args) = process_params({name => 'bud',
481             extract => [qw(suppress_output suppress_error nonzero zero)],
482             arg_flag => [qw(compress disable-content-trust http-proxy log-rusage no-cache pull pull-always pull-never
483             quiet rm squash tls-verify)],
484             arg_flag_str => [qw(disable-compression force-rm layers)],
485             arg_str => [qw(arch authfile blob-cache cache-from cert-dir cgroup-parent cni-config-dir cni-plugin-path
486             cpu-period cpu-quota cpu-shares cpuset-cpus cpuset-mems creds decryption-key file format http-proxy
487             iidfile ipc isolation jobs logfile loglevel memory memory-swap network os override-arch override-os
488             platform runtime shm-size sign-by signature-policy tag target timestamp userns userns-uid-map
489             userns-gid-map userns-uid-map-user userns-gid-map-group uts)],
490             arg_array => [qw(add-host annotation build-arg cap-add cap-drop device dns dns-option dns-search
491             label runtime-flag security-opt ulimit volume)],
492             }, $params);
493              
494             # run buildah-tag
495 0           $cb->buildah($extract, "bud", @args, @in_args);
496 0           return;
497             }
498              
499             # front end to "buildah containers" subcommand
500             # usage: $str = $cb->containers({name => value, ...})
501             # public class method
502             sub containers
503             {
504 0     0 1   my ($class_or_obj, @in_args) = @_;
505 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
506 0           my $params = {};
507 0 0         if (ref $in_args[0] eq "HASH") {
508 0           $params = shift @in_args;
509             }
510              
511             # process parameters
512 0           my ($extract, @args) = process_params({name => 'containers',
513             extract => [qw(suppress_error nonzero zero)],
514             arg_flag => [qw(all json noheading notruncate quiet)],
515             arg_str => [qw(filter format)],
516             }, $params);
517              
518             # run command and return output
519 0           return $cb->buildah({capture_output => 1, %$extract}, "containers", @args);
520             }
521              
522             # front-end to "buildah from" subcommand
523             # usage: $cb->from( [{[key => value], ...},] image )
524             # public instance method
525             sub from
526             {
527 0     0 1   my ($class_or_obj, @in_args) = @_;
528 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
529 0           my $params = {};
530 0 0         if (ref $in_args[0] eq "HASH") {
531 0           $params = shift @in_args;
532             }
533              
534             # process parameters
535 0           my ($extract, @args) = process_params({name => 'from',
536             extract => [qw(suppress_output suppress_error nonzero zero)],
537             arg_flag => [qw(pull-always pull-never tls-verify quiet)],
538             arg_flag_str => [qw(http-proxy pull)],
539             arg_str => [qw(authfile blob-cache cert-dir cgroup-parent cidfile cni-config-dir cni-plugin-path cpu-period
540             cpu-quota cpu-shares cpuset-cpus cpuset-mems creds device format ipc isolation memory memory-swap name
541             network override-arch override-os pid shm-size ulimit userns userns-uid-map userns-gid-map
542             userns-uid-map-user userns-gid-map-group uts)],
543             arg_array => [qw(add-host cap-add cap-drop decryption-key device dns dns-option dns-search security-opt
544             ulimit volume)],
545             }, $params);
546              
547             # get image parameter
548 0           my $image = shift @in_args;
549 0 0         if (not defined $image) {
550 0           croak "image parameter missing in call to 'from' method";
551             }
552              
553             # run command
554 0           $cb->buildah($extract, "from", @args, $image);
555 0           return;
556             }
557              
558             # front end to "buildah images" subcommand
559             # usage: $str = $cb->images({name => value, ...})
560             # public class method
561             sub images
562             {
563 0     0 1   my ($class_or_obj, @in_args) = @_;
564 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
565 0           my $params = {};
566 0 0         if (ref $in_args[0] eq "HASH") {
567 0           $params = shift @in_args;
568             }
569              
570             # process parameters
571 0           my ($extract, @args) = process_params({name => 'images',
572             extract => [qw(suppress_error nonzero zero)],
573             arg_flag => [qw(all digests json history noheading no-trunc notruncate quiet)],
574             arg_str => [qw(filter format)],
575             }, $params);
576              
577             # run command and return output
578 0           return $cb->buildah({capture_output => 1, %$extract}, "images", @args);
579             }
580              
581             # front end to "buildah info" subcommand
582             # usage: $str = $cb->info([{debug => 1, format => format}])
583             # this uses YAML::XS with the assumption that buildah-info's JSON output is a proper subset of YAML
584             # public class method
585             sub info
586             {
587 0     0 1   my ($class_or_obj, @in_args) = @_;
588 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
589 0           my $params = {};
590 0 0         if (ref $in_args[0] eq "HASH") {
591 0           $params = shift @in_args;
592             }
593              
594             # process parameters
595 0           my ($extract, @args) = process_params({name => 'info',
596             extract => [qw(suppress_error nonzero zero)],
597             arg_flag => [qw(debug)],
598             arg_str => [qw(format)],
599             }, $params);
600              
601             # run command and return output
602 0           my $yaml = $cb->buildah({capture_output => 1, %$extract}, "info", @args);
603 0           my $info = YAML::XS::Load($yaml);
604 0           return $info;
605             }
606              
607             # front end to "buildah inspect" subcommand
608             # usage: $str = $cb->inspect([{option => value, ...}], object_id)
609             # this uses YAML::XS with the assumption that buildah-inspect's JSON output is a proper subset of YAML
610             # public class method
611             sub inspect
612             {
613 0     0 1   my ($class_or_obj, @in_args) = @_;
614 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
615 0           my $params = {};
616 0 0         if (ref $in_args[0] eq "HASH") {
617 0           $params = shift @in_args;
618             }
619              
620             # process parameters
621 0           my $object_id = $in_args[0];
622 0 0         if (not defined $object_id) {
623 0           croak "object id parameter missing in call to 'inspect' method";
624             }
625 0           my ($extract, @args) = process_params({name => 'inspect',
626             extract => [qw(suppress_error nonzero zero)],
627             arg_str => [qw(format type)],
628             }, $params);
629              
630             # run command and return output
631 0           my $yaml = $cb->buildah({capture_output => 1, %$extract}, "inspect", @args, $object_id);
632 0           my $inspect = YAML::XS::Load($yaml);
633 0           return $inspect;
634             }
635              
636             # front end to "buildah manifest_add" subcommand
637             # usage: $str = $cb->manifest_add([{option => value, ...}], list-or-index, image)
638             # public class method
639             sub manifest_add
640             {
641 0     0 0   my ($class_or_obj, @in_args) = @_;
642 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
643 0           my $params = {};
644 0 0         if (ref $in_args[0] eq "HASH") {
645 0           $params = shift @in_args;
646             }
647              
648             # process parameters
649 0           my $list_or_index = $in_args[0];
650 0 0         if (not defined $list_or_index) {
651 0           croak "list/index parameter missing in call to 'manifest_add' method";
652             }
653 0           my $image = $in_args[1];
654 0 0         if (not defined $image) {
655 0           croak "object id parameter missing in call to 'manifest_add' method";
656             }
657 0           my ($extract, @args) = process_params({name => 'manifest_add',
658             extract => [qw(suppress_error nonzero zero)],
659             arg_flag => [qw(all tls-verify)],
660             arg_str => [qw(arch authfile cert-dir creds os os-version override-arch override-os variant)],
661             arg_array => [qw(annotation features os-features)],
662             }, $params);
663              
664             # run command and return output
665 0           my $manifest_add = $cb->buildah({capture_output => 1, %$extract}, "manifest_add", @args, $list_or_index, $image);
666 0           return $manifest_add;
667             }
668              
669             # front end to "buildah manifest_annotate" subcommand
670             # usage: $str = $cb->manifest_annotate([{option => value, ...}], list-or-index, digest)
671             # public class method
672             sub manifest_annotate
673             {
674 0     0 0   my ($class_or_obj, @in_args) = @_;
675 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
676 0           my $params = {};
677 0 0         if (ref $in_args[0] eq "HASH") {
678 0           $params = shift @in_args;
679             }
680              
681             # process parameters
682 0           my $list_or_index = $in_args[0];
683 0 0         if (not defined $list_or_index) {
684 0           croak "list/index parameter missing in call to 'manifest_annotate' method";
685             }
686 0           my $digest = $in_args[1];
687 0 0         if (not defined $digest) {
688 0           croak "image manifest digest parameter missing in call to 'manifest_annotate' method";
689             }
690 0           my ($extract, @args) = process_params({name => 'manifest_annotate',
691             extract => [qw(suppress_error nonzero zero)],
692             arg_str => [qw(arch os os-version variant)],
693             arg_array => [qw(annotation features os-features)],
694             }, $params);
695              
696             # run command and return output
697 0           my $manifest_annotate = $cb->buildah({capture_output => 1, %$extract}, "manifest_annotate", @args, $list_or_index,
698             $digest);
699 0           return $manifest_annotate;
700             }
701              
702             # front end to "buildah manifest_create" subcommand
703             # usage: $str = $cb->manifest_create([{option => value, ...}], list-or-index, image)
704             # public class method
705             sub manifest_create
706             {
707 0     0 0   my ($class_or_obj, @in_args) = @_;
708 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
709 0           my $params = {};
710 0 0         if (ref $in_args[0] eq "HASH") {
711 0           $params = shift @in_args;
712             }
713              
714             # process parameters
715 0           my $list_or_index = $in_args[0];
716 0 0         if (not defined $list_or_index) {
717 0           croak "list/index parameter missing in call to 'manifest_create' method";
718             }
719 0           my $image = $in_args[1];
720 0           my ($extract, @args) = process_params({name => 'manifest_create',
721             extract => [qw(suppress_error nonzero zero)],
722             arg_flag => [qw(all)],
723             arg_str => [qw(override-arch override-os)],
724             arg_array => [qw()],
725             }, $params);
726              
727             # run command and return output
728 0   0       my $manifest_create = $cb->buildah({capture_output => 1, %$extract}, "manifest_create", @args, $list_or_index,
729             ($image // ()));
730 0           return $manifest_create;
731             }
732              
733             # front end to "buildah manifest_inspect" subcommand
734             # usage: $str = $cb->manifest_inspect([{option => value, ...}], list-or-index)
735             # public class method
736             sub manifest_inspect
737             {
738 0     0 0   my ($class_or_obj, @in_args) = @_;
739 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
740 0           my $params = {};
741 0 0         if (ref $in_args[0] eq "HASH") {
742 0           $params = shift @in_args;
743             }
744              
745             # process parameters
746 0           my $list_or_index = $in_args[0];
747 0 0         if (not defined $list_or_index) {
748 0           croak "list/index parameter missing in call to 'manifest_inspect' method";
749             }
750 0           my ($extract, @args) = process_params({name => 'manifest_inspect',
751             extract => [qw(suppress_error nonzero zero)],
752             }, $params);
753              
754             # run command and return output
755 0           my $manifest_inspect = $cb->buildah({capture_output => 1, %$extract}, "manifest_inspect", $list_or_index);
756 0           return $manifest_inspect;
757             }
758              
759             # front end to "buildah manifest_push" subcommand
760             # usage: $str = $cb->manifest_push([{option => value, ...}], list-or-index, registry)
761             # public class method
762             sub manifest_push
763             {
764 0     0 0   my ($class_or_obj, @in_args) = @_;
765 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
766 0           my $params = {};
767 0 0         if (ref $in_args[0] eq "HASH") {
768 0           $params = shift @in_args;
769             }
770              
771             # process parameters
772 0           my $list_or_index = $in_args[0];
773 0 0         if (not defined $list_or_index) {
774 0           croak "list/index parameter missing in call to 'manifest_push' method";
775             }
776 0           my $registry = $in_args[1];
777 0           my ($extract, @args) = process_params({name => 'manifest_push',
778             extract => [qw(suppress_error nonzero zero)],
779             arg_flag => [qw(all purge quiet remove-signatures tls-verify)],
780             arg_str => [qw(authfile cert-dir creds digestfile format sign-by signature-policy)],
781             arg_array => [qw()],
782             }, $params);
783              
784             # run command and return output
785 0           my $manifest_push = $cb->buildah({capture_output => 1, %$extract}, "manifest_push", @args, $list_or_index,
786             $registry);
787 0           return $manifest_push;
788             }
789              
790             # front end to "buildah manifest_remove" subcommand
791             # usage: $str = $cb->manifest_remove([{option => value, ...}], list-or-index, image-manifest-digest)
792             # public class method
793             sub manifest_remove
794             {
795 0     0 0   my ($class_or_obj, @in_args) = @_;
796 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
797 0           my $params = {};
798 0 0         if (ref $in_args[0] eq "HASH") {
799 0           $params = shift @in_args;
800             }
801              
802             # process parameters
803 0           my $list_or_index = $in_args[0];
804 0 0         if (not defined $list_or_index) {
805 0           croak "list/index parameter missing in call to 'manifest_remove' method";
806             }
807 0           my $image_manifest_digest = $in_args[0];
808 0 0         if (not defined $image_manifest_digest) {
809 0           croak "image manifest digest parameter missing in call to 'manifest_remove' method";
810             }
811 0           my ($extract, @args) = process_params({name => 'manifest_remove',
812             extract => [qw(suppress_error nonzero zero)],
813             }, $params);
814              
815             # run command and return output
816 0           my $manifest_remove = $cb->buildah({capture_output => 1, %$extract}, "manifest_remove", $list_or_index,
817             $image_manifest_digest);
818 0           return $manifest_remove;
819             }
820              
821             # front-end to "buildah mount" subcommand
822             # usage: $mounts = $cb->mount({[notruncate => 1]}, container, ...)
823             # public class method
824             sub mount
825             {
826 0     0 1   my ($class_or_obj, @in_args) = @_;
827 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
828 0           my $params = {};
829 0 0         if (ref $in_args[0] eq "HASH") {
830 0           $params = shift @in_args;
831             }
832              
833             # process parameters
834 0           my ($extract, @args) = process_params({name => 'mount',
835             extract => [qw(suppress_error nonzero zero)],
836             arg_flag => [qw(notruncate)]
837             }, $params);
838              
839             # run buildah-tag
840 0           my $output = $cb->buildah({capture_output => 1, %$extract}, "mount", @args, @in_args);
841 0           my %mounts = split(/\s+/sx, $output);
842 0           return \%mounts;
843             }
844              
845             # front end to "buildah pull" subcommand
846             # usage: $str = $cb->pull([{option => value, ...}], image)
847             # public class method
848             sub pull
849             {
850 0     0 1   my ($class_or_obj, @in_args) = @_;
851 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
852 0           my $params = {};
853 0 0         if (ref $in_args[0] eq "HASH") {
854 0           $params = shift @in_args;
855             }
856              
857             # process parameters
858 0           my $image = $in_args[0];
859 0 0         if (not defined $image) {
860 0           croak "object id parameter missing in call to 'pull' method";
861             }
862 0           my ($extract, @args) = process_params({name => 'pull',
863             extract => [qw(suppress_error nonzero zero)],
864             arg_flag => [qw(all-tags remove-signatures quiet tls-verify)],
865             arg_str => [qw(authfile blob-cache cert-dir creds override-os override-arch signature-policy)],
866             arg_array => [qw(decryption-key)],
867             }, $params);
868              
869             # run command and return output
870 0           my $pull = $cb->buildah({capture_output => 1, %$extract}, "pull", @args, $image);
871 0           return $pull;
872             }
873              
874             # front end to "buildah push" subcommand
875             # named push_image() to de-conflict with Perl builtin push, but Container::Buildah links push() as an alias
876             # usage: $str = $cb->push_image([{option => value, ...}], image, [destination])
877             # or: $str = $cb->push([{option => value, ...}], image, [destination])
878             # public class method
879             sub push_image
880             {
881 0     0 0   my ($class_or_obj, @in_args) = @_;
882 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
883 0           my $params = {};
884 0 0         if (ref $in_args[0] eq "HASH") {
885 0           $params = shift @in_args;
886             }
887              
888             # process parameters
889 0           my ($extract, @args) = process_params({name => 'push_image',
890             extract => [qw(suppress_output suppress_error nonzero zero)],
891             arg_flag => [qw(disable-compression quiet remove-signatures tls-verify)],
892             arg_str => [qw(authfile blob-cache cert-dir creds digestfile format sign-by signature-policy)],
893             arg_array => [qw(encryption-key encrypt-layer)],
894             }, $params);
895              
896             # run command and return output
897 0           $cb->buildah({%$extract}, "push_image", @args, @in_args);
898 0           return;
899             }
900              
901             # front end to "buildah rename" subcommand
902             # named rename_image() to de-conflict with Perl builtin rename, but Container::Buildah links rename() as an alias
903             # usage: $str = $cb->rename_image(image, new-name)
904             # or: $str = $cb->rename(image, new-name)
905             # public class method
906             sub rename_image
907             {
908 0     0 0   my ($class_or_obj, @in_args) = @_;
909 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
910 0           my $params = {};
911 0 0         if (ref $in_args[0] eq "HASH") {
912 0           $params = shift @in_args;
913             }
914              
915             # process parameters
916 0           my ($extract, @args) = process_params({name => 'rename_image',
917             extract => [qw(suppress_output suppress_error nonzero zero)],
918             }, $params);
919              
920             # run command and return output
921 0           $cb->buildah({%$extract}, "rename_image", @in_args);
922 0           return;
923             }
924              
925              
926             # front end to "buildah tag" subcommand
927             # usage: $cb->tag({image => "image_name"}, new_name, ...)
928             # public class method
929             sub tag
930             {
931 0     0 1   my ($class_or_obj, @in_args) = @_;
932 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
933 0           my $params = {};
934 0 0         if (ref $in_args[0] eq "HASH") {
935 0           $params = shift @in_args;
936             }
937              
938             # process parameters
939 0           my ($extract, @args) = process_params({name => 'tag',
940             extract => [qw(image suppress_output suppress_error nonzero zero)],
941             }, $params);
942             my $image = $extract->{image}
943 0 0         or croak "tag: image parameter required";
944 0           delete $extract->{image};
945              
946             # run buildah-tag
947 0           $cb->buildah($extract, "tag", $image, @in_args);
948 0           return;
949             }
950              
951             # front end to "buildah rm" (remove container) subcommand
952             # usage: $cb->rm(container, [...])
953             # or: $cb->rm({all => 1})
954             # public class method
955             sub rm
956             {
957 0     0 1   my ($class_or_obj, @in_args) = @_;
958 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
959 0           my $params = {};
960 0 0         if (ref $in_args[0] eq "HASH") {
961 0           $params = shift @in_args;
962             }
963              
964             # process parameters
965 0           my ($extract, @args) = process_params({name => 'rm',
966             extract => [qw(suppress_output suppress_error nonzero zero)],
967             arg_flag => [qw(all)],
968             exclusive => [qw(all)]
969             }, $params);
970              
971             # remove containers listed in arguments
972             # buildah will error out if --all is provided with container names/ids
973 0           $cb->buildah($extract, "rm", @args, @in_args);
974 0           return;
975             }
976              
977             # front end to "buildah rmi" (remove image) subcommand
978             # usage: $cb->rmi([{force => 1},] image, [...])
979             # or: $cb->rmi({prune => 1})
980             # or: $cb->rmi({all => 1})
981             # public class method
982             sub rmi
983             {
984 0     0 1   my ($class_or_obj, @in_args) = @_;
985 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
986 0           my $params = {};
987 0 0         if (ref $in_args[0] eq "HASH") {
988 0           $params = shift @in_args;
989             }
990              
991             # process parameters
992 0           my ($extract, @args) = process_params({name => 'rmi',
993             extract => [qw(suppress_output suppress_error nonzero zero)],
994             arg_flag => [qw(all prune force)],
995             exclusive => [qw(all prune)],
996             }, $params);
997              
998             # remove images listed in arguments
999             # buildah will error out if --all or --prune are provided with image names/ids
1000 0           $cb->buildah($extract, "rmi", @args, @in_args);
1001 0           return;
1002             }
1003              
1004             # front-end to "buildah umount" subcommand
1005             # usage: $cb->umount({[notruncate => 1]}, container, ...)
1006             # public class method
1007             sub umount
1008             {
1009 0     0 1   my ($class_or_obj, @in_args) = @_;
1010 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
1011 0           my $params = {};
1012 0 0         if (ref $in_args[0] eq "HASH") {
1013 0           $params = shift @in_args;
1014             }
1015              
1016             # process parameters
1017 0           my ($extract, @args) = process_params({name => 'umount',
1018             extract => [qw(suppress_output suppress_error nonzero zero)],
1019             arg_flag => [qw(all)],
1020             exclusive => [qw(all)],
1021             }, $params);
1022              
1023             # run buildah-tag
1024 0           $cb->buildah($extract, "umount", @args, @in_args);
1025 0           return;
1026             }
1027              
1028              
1029             # front end to "buildah unshare" (user namespace share) subcommand
1030             # usage: $cb->unshare({container => "name_or_id", [envname => "env_var_name"]}, "cmd", "args", ... )
1031             # public class method
1032             sub unshare
1033             {
1034 0     0 1   my ($class_or_obj, @in_args) = @_;
1035 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
1036 0           my $params = {};
1037 0 0         if (ref $in_args[0] eq "HASH") {
1038 0           $params = shift @in_args;
1039             }
1040              
1041             # process parameters
1042 0           my ($extract, @args) = process_params({name => 'unshare',
1043             extract => [qw(container envname suppress_output suppress_error nonzero zero)],
1044             arg_str => [qw(mount)],
1045             }, $params);
1046              
1047             # construct arguments for buildah-unshare command
1048             # note: --mount may be specified directly or constructed from container/envname - use only one way, not both
1049 0 0         if (exists $extract->{container}) {
1050 0 0         if (exists $extract->{envname}) {
1051 0           CORE::push @args, "--mount", $extract->{envname}."=".$extract->{container};
1052 0           delete $extract->{envname};
1053             } else {
1054 0           CORE::push @args, "--mount", $extract->{container};
1055             }
1056 0           delete $extract->{container};
1057             }
1058              
1059             # run buildah-unshare command
1060 0           $cb->buildah($extract, "unshare", @args, "--", @in_args);
1061 0           return;
1062             }
1063              
1064             # front end to "buildah version" subcommand
1065             # usage: $str = $cb->version([{debug => 1, format => format}])
1066             # this uses YAML::XS with the assumption that buildah-version's JSON output is a proper subset of YAML
1067             # public class method
1068             sub version
1069             {
1070 0     0 1   my ($class_or_obj, @in_args) = @_;
1071 0 0         my $cb = (ref $class_or_obj) ? $class_or_obj : $class_or_obj->instance();
1072 0           my $params = {};
1073 0 0         if (ref $in_args[0] eq "HASH") {
1074 0           $params = shift @in_args;
1075             }
1076              
1077             # process parameters
1078 0           my ($extract, @args) = process_params({name => 'version',
1079             extract => [qw(suppress_error nonzero zero)],
1080             }, $params);
1081              
1082             # run command and return output
1083 0           my $yaml = $cb->buildah({capture_output => 1, %$extract}, "version", @args);
1084 0           my $version = YAML::XS::Load($yaml);
1085 0           return $version;
1086             }
1087              
1088             1;
1089              
1090             __END__