File Coverage

blib/lib/Container/Buildah/Subcommand.pm
Criterion Covered Total %
statement 185 425 43.5
branch 90 230 39.1
condition 15 27 55.5
subroutine 19 42 45.2
pod 15 35 42.8
total 324 759 42.6


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