File Coverage

blib/lib/Container/Buildah/Stage.pm
Criterion Covered Total %
statement 24 265 9.0
branch 0 122 0.0
condition 0 20 0.0
subroutine 8 32 25.0
pod 10 20 50.0
total 42 459 9.1


line stmt bran cond sub pod time code
1             # Container::Buildah::Stage
2             # ABSTRACT: object used by Container::Buildah to track a stage of a multi-stage container build
3             # by Ian Kluft
4              
5             ## no critic (Modules::RequireExplicitPackage)
6             # 'use strict' and 'use warnings' included here
7 1     1   1474 use Modern::Perl qw(2015); # require 5.20.0
  1         2  
  1         8  
8             ## use critic (Modules::RequireExplicitPackage)
9              
10             package Container::Buildah::Stage;
11             $Container::Buildah::Stage::VERSION = '0.3.1';
12 1     1   188 use autodie;
  1         2  
  1         7  
13 1     1   4486 use Carp qw(croak confess);
  1         1  
  1         82  
14 1     1   6 use Cwd;
  1         2  
  1         92  
15 1     1   7 use Readonly;
  1         3  
  1         35  
16 1     1   593 use File::stat;
  1         5989  
  1         5  
17 1     1   606 use FindBin;
  1         911  
  1         1005  
18              
19             # import from Container::Buildah::Subcommand after BEGIN phase (where 'use' takes place), to avoid conflicts
20             require Container::Buildah;
21             require Container::Buildah::Subcommand;
22             Container::Buildah::Subcommand->import(qw(process_params prog));
23              
24             Readonly::Scalar my $mnt_env_name => "BUILDAHUTIL_MOUNT";
25             Readonly::Array my @auto_accessors => qw(commit consumes depends from func_deps func_exec mnt name produces
26             user user_home);
27             my $accessors_created = 0;
28              
29             # instantiate an object
30             # this should only be called by Container::Buildah
31             # these objects will be passed to each stage's stage->func_*()
32             # private class method
33             sub new {
34 0     0 1   my ($class, @in_args) = @_;
35              
36 0           my $self = { @in_args };
37 0           bless $self, $class;
38              
39             # enforce that only Container::Buildah module can call this method
40 0           my ($package) = caller;
41 0 0         if ($package ne "Container::Buildah") {
42 0           croak __PACKAGE__."->new() can only be called from Container::Buildah";
43             }
44              
45             # initialize accessor methods if not done on a prior call to new()
46 0           generate_read_accessors();
47              
48             # check for required name parameter
49 0 0         if (not exists $self->{name}) {
50 0           croak __PACKAGE__.": cannot instantiate without a name parameter";
51             }
52              
53             # get container mount point, if in the user namespace
54 0 0         if (exists $ENV{$mnt_env_name}) {
55 0           $self->{mnt} = $ENV{$mnt_env_name};
56             }
57              
58             # get ref to stage configuation
59 0           my $config = Container::Buildah->get_config("stages", $self->{name});
60 0 0 0       if ((not defined $config) or (ref $config ne "HASH")) {
61 0           croak __PACKAGE__.": no configuration for stage ".$self->{name};
62             }
63 0           foreach my $key (keys %$config) {
64 0           $self->{$key} = $config->{$key};
65             }
66              
67             # check for missing stage config settings
68 0           my @missing;
69 0           foreach my $key (qw(from func_exec)) {
70 0 0         if (not exists $self->{$key}) {
71 0           push @missing, $key;
72             }
73             }
74              
75             # fail if any required parameters are missing
76 0 0         if (@missing) {
77 0           croak __PACKAGE__.": required parameters missing in stage ".$self->{name}.": ".join(" ", @missing);
78             }
79              
80 0           return $self;
81             }
82              
83             # return entry from stage configuration subset of Container::Buildah configuation
84             # Note: this reads the stage configuration data, not to be confused with buildah's config subcommand
85             # public instance method
86             sub stage_config
87             {
88 0     0 1   my ($self, $key) = @_;
89 0 0         if (exists $self->{$key}) {
90 0 0 0       if (ref $self->{$key} and ref $self->{$key} ne "ARRAY") {
91 0           return $self->{$key};
92             }
93              
94             # if the value is a scalar, perform variable expansion
95 0           return Container::Buildah::expand($self->{$key});
96             }
97 0           return;
98             }
99              
100             # status method forward to Container::Buildah::status()
101             # public instance method
102             sub status
103             {
104 0     0 1   my ($self, @in_args) = @_;
105 0           my $cb = Container::Buildah->instance();
106 0           my @label;
107 0           @label = ('['.$self->container_name().']');
108 0           $cb->status(@label, @in_args);
109 0           return;
110             }
111              
112             # debug method forward to Container::Buildah::debug()
113             # public instance method
114             sub debug
115             {
116 0     0 1   my ($self, @in_args) = @_;
117 0           my $cb = Container::Buildah->instance();
118              
119             # collect debug parameters
120 0           my %params;
121 0 0         if (ref $in_args[0] eq "HASH") {
122 0           my $params_ref = shift @in_args;
123 0           %params = %$params_ref;
124             }
125 0           $params{wrapper} = 1; # tell Container::Buidlah::debug() to skip the stack frame for this wrapper
126              
127             # insert label parameter with container name, if we're in a state where it's defined
128 0 0         if (exists $self->{config}{container_name}) {
129 0           $params{label} = $self->{config}{container_name};
130             }
131              
132             # call the debug method in Container::Buildah
133 0           $cb->debug(\%params, @in_args);
134 0           return;
135             }
136              
137             # accessors - commented out but retained to show why we needed to generate accessor functions
138             #sub get_commit { my $self = shift; return $self->stage_config("commit"); }
139             #sub get_consumes { my $self = shift; return $self->stage_config("consumes"); }
140             #sub get_from { my $self = shift; return $self->stage_config("from"); }
141             #sub get_func_deps { my $self = shift; return $self->stage_config("func_deps"); }
142             #sub get_func_exec { my $self = shift; return $self->stage_config("func_exec"); }
143             #sub get_mnt { my $self = shift; return $self->stage_config("mnt"); }
144             #sub get_name { my $self = shift; return $self->stage_config("name"); }
145             #sub get_produces { my $self = shift; return $self->stage_config("produces"); }
146             #sub get_user_home { my $self = shift; return $self->stage_config("user_home"); }
147             #sub get_user { my $self = shift; return $self->stage_config("user"); }
148              
149             # generate read accessor methods
150             # note: these parameters are set only in new() - there are no write accessors so none are generated
151             # private class function
152             sub generate_read_accessors
153             {
154             # check if accessors have been created
155 0 0   0 0   if ($accessors_created) {
156             # skip if already done
157 0           return;
158             }
159              
160             # create accessor methods
161 0           foreach my $field_name (@auto_accessors) {
162             # for read accessor name, prepend get_ to field name
163 0           my $method_name = "get_".$field_name;
164            
165             # generate accessor method to handle this field
166             my $method_sub = sub {
167 0     0     my $self = shift;
168 0 0         $self->isa(__PACKAGE__)
    0          
    0          
169             or confess "$method_name method (from generate_read_accessors) expects ".__PACKAGE__." object, got "
170             .((defined $self)?((ref $self)?ref $self:"scalar"):"(undef)");
171 0           my $value = $self->stage_config($field_name);
172 0 0         $self->debug({level => 3, name => __PACKAGE__."::".$method_name},
173             (defined $value)?"value=$value":"(undef)");
174 0           return $value;
175 0           };
176              
177             # install and call the newly-generated method
178 1     1   8 no strict 'refs'; ## no critic (ProhibitNoStrict)
  1         2  
  1         3028  
179 0           *{ $method_name } = $method_sub; # install generated method in class symbol table
  0            
180             }
181 0           $accessors_created = 1; # do this only once
182 0           return;
183             }
184              
185             # get container name
186             # generate it the first time
187             # public instance method
188             sub container_name
189             {
190 0     0 1   my $self = shift;
191              
192             # derive container name
193 0 0         if (not exists $self->{container_name}) {
194 0           $self->{container_name} = Container::Buildah->get_config("basename")."_".$self->get_name;
195             }
196 0           return $self->{container_name};
197             }
198              
199             #
200             # buildah subcommand front-end functions
201             # Within Container::Buildah::Stage the object has methods for subcommands which take a container name.
202             # Each method gets container_name from the object. So it is not passed as a separate parameter.
203             #
204             # Other more general subcommands are in Container::Buildah class.
205             #
206              
207             # front-end to "buildah add" subcommand
208             # usage: $self->add( [{[dest => value]. [chown => mode]},] src, [src, ...] )
209             # public instance method
210             sub add
211             {
212 0     0 1   my ($self, @in_args) = @_;
213 0           $self->debug({level => 2}, @in_args);
214 0           my $params = {};
215 0 0         if (ref $in_args[0] eq "HASH") {
216 0           $params = shift @in_args;
217             }
218              
219             # process parameters
220 0           my ($extract, @args) = process_params({name => 'add',
221             extract => [qw(dest)],
222             arg_flag => [qw(add-history quiet)],
223             arg_str => [qw(chown)]
224             }, $params);
225              
226             # insert --add-history if corresponding global option set
227             # (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
228 0 0 0       if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
229 0           unshift @args, "--add-history";
230             }
231              
232             # get special parameter dest if it exists
233 0           my $dest = $extract->{dest};
234              
235             # run command
236 0           my $cb = Container::Buildah->instance();
237 0 0         $cb->buildah("add", @args, $self->container_name, @in_args, ($dest ? ($dest) : ()));
238 0           return;
239             }
240              
241             # front-end to "buildah commit" subcommand
242             # usage: $self->commit( [{param => value, ...}], image-name )
243             # public instance method
244             sub commit
245             {
246 0     0 1   my ($self, @in_args) = @_;
247 0           $self->debug({level => 2}, @in_args);
248 0           my $params = {};
249 0 0         if (ref $in_args[0] eq "HASH") {
250 0           $params = shift @in_args;
251             }
252 0           my $image_name = shift @in_args;
253              
254             # process parameters
255 0           my ($extract, @args) = process_params({name => 'commit',
256             arg_flag => [qw(disable-compression omit-timestamp quiet rm squash tls-verify)],
257             arg_int => [qw(timestamp)],
258             arg_str => [qw(authfile blob-cache cert-dir creds encryption-key format iidfile
259             reference-time sign-by signature-policy tls-verify omit-timestamp)],
260             arg_array => [qw(encrypt-layer)],
261             }, $params);
262              
263             # do commit
264 0           my $cb = Container::Buildah->instance();
265 0   0       $cb->buildah("commit", @args, $self->container_name, ($image_name // ()));
266 0           return;
267             }
268              
269              
270             # front-end to "buildah config" subcommand
271             # usage: $self->config({ param => value, ...})
272             # Note: this is for the container's configuration, not to be confused with configuration data of this module
273             # public instance method
274             sub config
275             {
276 0     0 1   my ($self, @in_args) = @_;
277 0           $self->debug({level => 2}, @in_args);
278 0           my $params = {};
279 0 0         if (ref $in_args[0] eq "HASH") {
280 0           $params = shift @in_args;
281             }
282              
283             # process parameters
284 0           my ($extract, @args) = process_params({name => 'config',
285             arg_flag => [qw(add-history)],
286             arg_str => [qw(arch author cmd comment created-by domainname healthcheck healthcheck-interval
287             healthcheck-retries healthcheck-start-period healthcheck-timeout history-comment hostname
288             os shell stop-signal user workingdir)],
289             arg_array => [qw(annotation env label onbuild port volume)],
290             arg_list => [qw(entrypoint)],
291             }, $params);
292              
293             # insert --add-history if corresponding global option set
294             # (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
295 0 0 0       if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
296 0           unshift @args, "--add-history";
297             }
298              
299             # run command
300 0           my $cb = Container::Buildah->instance();
301 0           $cb->buildah("config", @args, $self->container_name);
302 0           return;
303             }
304              
305             # front-end to "buildah copy" subcommand
306             # usage: $self->copy( [{dest => value},] src, [src, ...] )
307             # public instance method
308             sub copy
309             {
310 0     0 1   my ($self, @in_args) = @_;
311 0           $self->debug({level => 2}, @in_args);
312 0           my $params = {};
313 0 0         if (ref $in_args[0] eq "HASH") {
314 0           $params = shift @in_args;
315             }
316              
317             # process parameters
318 0           my ($extract, @args) = process_params({name => 'copy',
319             extract => [qw(dest)],
320             arg_flag => [qw(add-history quiet)],
321             arg_str => [qw(chown)]
322             }, $params);
323              
324             # insert --add-history if corresponding global option set
325             # (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
326 0 0 0       if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
327 0           unshift @args, "--add-history";
328             }
329              
330             # get special parameter dest if it exists
331 0           my $dest = $extract->{dest};
332              
333             # run command
334 0           my $cb = Container::Buildah->instance();
335 0 0         $cb->buildah("copy", @args, $self->container_name, @in_args, ($dest ? ($dest) : ()));
336 0           return;
337             }
338              
339             # front-end to "buildah run" subcommand
340             # usage: $self->run( [{param => value, ...}], [command], ... )
341             # Command parameter can be an array of strings for one command, or array of arrays of strings for multiple commands.
342             # This applies the same command-line arguments (from %params) to each command. To change parameters for a command,
343             # make a separate call to the function.
344             # public instance method
345             sub run
346             {
347 0     0 1   my ($self, @in_args) = @_;
348 0           $self->debug({level => 2}, @in_args);
349 0           my $params = {};
350 0 0         if (ref $in_args[0] eq "HASH") {
351 0           $params = shift @in_args;
352             }
353              
354             # process parameters
355 0           my ($extract, @args) = process_params({name => 'run',
356             arg_flag => [qw(add-history no-pivot terminal)],
357             arg_str => [qw(cni-config-dir cni-plugin-path hostname ipc isolation network pid runtime
358             user uts)],
359             arg_array => [qw(cap-add cap-drop mount runtime-flag security-opt volume)],
360             }, $params);
361              
362             # insert --add-history if corresponding global option set
363             # (buildah also does this by $ENV{BUILDAH_HISTORY}='true')
364 0 0 0       if (Container::Buildah->get_config(qw(opts add-history)) // 0) {
365 0           unshift @args, "--add-history";
366             }
367              
368             # loop through provided commands
369             # build outer array if only one command was provided
370 0 0         my @commands = ref $in_args[0] ? @in_args : [@in_args];
371 0           foreach my $command (@commands) {
372             # if any entries are not arrays, temporarily make them into one
373 0 0         if (not ref $command) {
    0          
374 0           $command = [$command];
375             } elsif (ref $command ne "ARRAY") {
376 0           confess "run: command must be a scalar or array, got ".ref $command;
377             }
378              
379             # run command
380 0           my $cb = Container::Buildah->instance();
381 0           $cb->buildah("run", @args, $self->container_name, '--', @$command);
382             }
383 0           return;
384             }
385              
386             #
387             # private methods - container-stage processing utilities
388             #
389              
390             # remove a container by name if it already exists - we need the name
391             # private instance method
392             sub rmcontainer
393             {
394 0     0 0   my $self = shift;
395 0           my $cb = Container::Buildah->instance();
396              
397             $cb->inspect({
398             suppress_error => 1,
399       0     nonzero => sub {},
400 0     0     zero => sub {$cb->rm($self->container_name);}},
401 0           $self->container_name);
402 0           return;
403             }
404              
405             # get path to the executing script
406             # used for file dependency checks and re-running the script in a container namespace
407             # private class function
408             sub progpath
409             {
410 0     0 0   state $progpath = "$FindBin::Bin/$FindBin::Script";
411 0           return $progpath;
412             }
413              
414             # derive tarball name for stage which produces it
415             # defaults to the current stage
416             # private instance method
417             sub tarball
418             {
419 0     0 0   my $self = shift;
420 0   0       my $stage_name = shift // $self->get_name;
421 0           return Container::Buildah->get_config("basename")."_".$stage_name.".tar.bz2";
422             }
423              
424             # get file modification timestamp
425             # private class function
426             sub ftime
427             {
428 0     0 0   my $file = shift;
429              
430             # follow symlinks, limit to 10 levels in case of loop
431 0           my $count=10;
432 0           my $f_file = $file;
433 0           while ($count > 0) {
434 0 0         if (-l $f_file) {
435 0           $f_file = readlink $f_file;
436             } else {
437 0           last;
438             }
439 0           $count--;
440             }
441 0 0         if ($count <= 0) {
442 0           croak "ftime: apparent symlink loop or more than 10 levels at $file";
443             }
444              
445             # skip if the path doesn't point to a file
446 0 0         if (not -f $f_file ) {
447 0           croak "ftime: not a regular file at $file";
448             }
449              
450             # return the modification time of the file
451 0           my $fstat = stat $f_file;
452 0           return $fstat->mtime;
453             }
454              
455             # check if this script or configuration is newer than a deliverable file, or if the deliverable doesn't exist
456             # private class function
457             sub check_deliverable
458             {
459 0     0 0   my $depfile = shift;
460              
461             # if the deliverable doesn't exist, then it must be built
462 0 0         if (not -e $depfile) {
463 0           return "does not exist";
464             }
465 0 0         if (not -f $depfile) {
466 0           croak "not a file: $depfile";
467             }
468              
469             # if the program has been modified more recently than the deliverable, the deliverable must be rebuilt
470 0 0         if (ftime(progpath()) > ftime($depfile)) {
471 0           return "program modified";
472             }
473              
474             # if the configuration has been modified more recently than the deliverable, the deliverable must be rebuilt
475 0           my $cb = Container::Buildah->instance();
476 0           my $config_files = $cb->get_config('_config_files');
477 0           foreach my $file (@$config_files) {
478 0 0         if (ftime($file) > ftime($depfile)) {
479 0           return "config file modified";
480             }
481             }
482              
483 0           return;
484             }
485              
486             # generic external wrapper function for all stages
487             # mount the container namespace and enter it to run the custom stage build function
488             # private instance method
489             sub launch_namespace
490             {
491 0     0 0   my $self = shift;
492              
493             # check if this stage produces a deliverable to another stage
494 0           my $produces = $self->get_produces;
495 0 0         if (defined $produces) {
496             # generate deliverable file name
497 0           my $tarball_out = $self->tarball;
498              
499             # check if deliverable tarball file already exists
500 0           my $tarball_result = check_deliverable($tarball_out);
501 0 0         if (not $tarball_result) {
502             # skip this stage because the deliverable already exists and is up-to-date
503 0           $self->status("build tarball skipped - deliverable up-to-date $tarball_out");
504 0           return;
505             }
506              
507             # continue with this build stage if tarball missing or program updated more recently than tarball
508 0           $self->status("build tarball ($tarball_result): $tarball_out");
509             }
510              
511             #
512             # run container for this stage
513             # commit it if configured (usually that's only for the final stage)
514             # otherwise a stage is discarded except for its product tarball
515             #
516              
517             # if the container exists, remove it
518 0           $self->rmcontainer;
519              
520             # get the base image
521 0           my $cb = Container::Buildah->instance();
522 0           $cb->from({name => $self->container_name}, $self->get_from);
523              
524             # get copy of @ARGV saved by main() for use here re-launching in namespace
525 0           my $argv_ref = Container::Buildah->get_config("argv");
526 0 0         if (ref $argv_ref ne "ARRAY") {
527 0           confess "wrong type for argv - expected ARRAY ref, got ".(ref $argv_ref);
528             }
529              
530             # run the builder script in the container
531 0           $cb->unshare({container => $self->container_name,
532             envname => $mnt_env_name},
533             progpath(),
534             "--internal=".$self->get_name,
535             @$argv_ref,
536             );
537              
538             # commit the container if configured
539 0           my $commit = $self->get_commit;
540 0           my @tags;
541 0 0         if (defined $commit) {
542 0 0         if (not ref $commit) {
    0          
543 0           @tags = ($commit);
544             } elsif (ref $commit eq "ARRAY") {
545 0           @tags = @$commit;
546             } else {
547 0           confess "reference to ".(ref $commit)." not supported in commit - use scalar or array";
548             }
549             }
550 0           my $image_name = shift @tags;
551 0           $self->commit($image_name);
552 0 0         if (@tags) {
553 0           $cb->tag({image => $image_name}, @tags);
554             }
555 0           return;
556             }
557              
558             # import tarball(s) from other container stages if configured
559             # private instance method
560             sub consume
561             {
562 0     0 0   my $self = shift;
563              
564             # create groups and users before import
565 0           my $user = $self->get_user;
566 0 0         if (defined $self->get_user) {
567 0           my $user_name = $user;
568 0           my ($uid, $group_name, $gid);
569 0 0         if ($user =~ /:/x) {
570 0           ($user_name, $group_name) = split /:/x, $user;
571 0 0         if ($user_name =~ /=/x) {
572 0           ($user_name, $uid) = split /=/x, $user_name;
573             }
574 0 0         if ($group_name =~ /=/x) {
575 0           ($group_name, $gid) = split /=/x, $group_name;
576             }
577             }
578             # TODO: find distro-independent approach instead of assuming Linux Fileystem Standard /usr/sbin paths
579 0 0         if (defined $group_name) {
580 0 0         $self->run(["/usr/sbin/groupadd", ((defined $gid) ? ("--gid=$gid") : ()), $group_name]);
581             }
582 0           my $user_home = $self->get_user_home;
583 0 0         $self->run(
    0          
    0          
584             ["/usr/sbin/useradd", ((defined $uid) ? ("--uid=$uid") : ()),
585             ((defined $group_name) ? ("--gid=$group_name") : ()),
586             ((defined $user_home) ? ("--home-dir=$user_home") : ()), $user_name],
587             );
588             }
589              
590             # import tarballs from each stage we depend upon
591 0           my $consumes = $self->get_consumes;
592 0 0         if (defined $consumes) {
593 0 0         if (ref $consumes eq "ARRAY") {
594 0           my @in_stages = @$consumes;
595 0           my $cwd = getcwd();
596 0           foreach my $in_stage (@in_stages) {
597 0           my $tarball_in = $self->tarball($in_stage);
598 0           $self->debug("in ".$self->get_name." stage before untar; pid=$$ cwd=$cwd tarball=$tarball_in");
599 0 0         (-f $tarball_in) or croak "consume(".join(" ", @in_stages)."): ".$tarball_in." not found";
600 0           $self->add({dest => "/"}, $tarball_in);
601             }
602             } else {
603 0           croak "consume stage->consumes was set but not an array ref";
604             }
605             }
606 0           return;
607             }
608              
609             # drop leading slash from a path
610             # private class function
611             sub dropslash
612             {
613 0     0 0   my $str = shift;
614 0 0         if (substr($str,0,1) eq '/') {
615 0           substr($str,0,1,'');
616             }
617 0           return $str;
618             }
619              
620             # export tarball for availability to other container stages if configured
621             # private instance method
622             sub produce
623             {
624 0     0 0   my $self = shift;
625              
626             # export directories to tarball for product of this stage
627 0           my $produces = $self->get_produces;
628 0 0         if (defined $produces) {
629 0 0         if (ref $produces eq "ARRAY") {
630 0           my $tarball_out = $self->tarball;
631 0           my $cb = Container::Buildah->instance();
632 0           my @product_dirs;
633 0           foreach my $product (@$produces) {
634 0           push @product_dirs, dropslash($product);
635             }
636              
637             # move any existing tarball to backup
638 0 0         if ( -f $tarball_out ) {
639 0           rename $tarball_out, $tarball_out.".bak";
640             }
641              
642             # create the tarball
643 0           my $cwd = getcwd();
644 0           $self->debug("in ".$self->get_name." stage before tar; pid=$$ cwd=$cwd product_dirs="
645             .join(" ", @product_dirs));
646             # ignore tar exit code 1 - appears to be unavoidable and meaningless when building on an overlayfs
647 0 0   0     my $nonzero = sub { my $ret=shift; if ($ret>1) {croak "tar exited with code $ret";}};
  0            
  0            
  0            
648 0           $cb->cmd({name => "tar", nonzero => $nonzero}, "/usr/bin/tar", "--create", "--bzip2",
649             "--preserve-permissions", "--sparse", "--file=".$tarball_out, "--directory=".$self->get_mnt, @product_dirs);
650             } else {
651 0           croak "product: stage->consumes was set but not an array ref";
652             }
653             }
654 0           return;
655             }
656              
657             1;
658              
659             __END__