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__ |