File Coverage

blib/lib/Sys/Export/Linux.pm

Criterion	Covered	Total	%
statement	37	98	37.7
branch	3	50	6.0
condition	3	29	10.3
subroutine	8	10	80.0
pod	2	2	100.0
total	53	189	28.0

package Sys::Export::Linux;

# ABSTRACT: Export subsets of a Linux system
our $VERSION = '0.005'; # VERSION


use v5.26;
use warnings;
use experimental qw( signatures );
use parent 'Sys::Export::Unix';
use Cwd 'abs_path';
use Carp;

sub _build__trace_deps {
   my $self= shift;
   if ($self->_can_run_in_src) {
      # Are we going to attempt chrooting?
      if ($self->src_abs ne '/') {
         $self->{cmd_path_chroot} //= do {
            chomp(my $chroot= `which chroot`);
            -x $chroot or croak "chroot command not available or not executable";
            $self->{_log_trace}->("chroot binary at $chroot") if $self->{_log_trace};
            $chroot;
         };
      }
      $self->{cmd_path_strace} //= do {
         chomp(my $strace= `which strace`);
         -x $strace or croak "strace command not available or not executable";
         $self->{_log_trace}->("strace binary at $strace") if $self->{_log_trace};
         $strace;
      };
      return $self->can('_trace_deps_linux_strace');
   }
   $self->next::method(@_);
}

sub _trace_deps_linux_strace($self, @argv) {
   # Are we going to attempt chrooting?
   unshift @argv, $self->{cmd_path_chroot}, $self->src_abs
      unless $self->src_abs eq '/';
   # Tell strace to write to a pipe, while redirecting command output to /dev/null
   open my $devnull, '+<', '/dev/null' or croak "open(/dev/null): $!";
   pipe(my $r, my $w) // croak "pipe: $!";
   pipe(my $err_r, my $err_w) // croak "pipe: $!";
   my $pid= fork // croak "fork: $!";
   if (!$pid) {
      close $r;
      close $err_r;
      eval {
         chdir $self->src_abs or die "chdir: $!";
         POSIX::dup2(fileno $devnull, 0) or die "dup2(->0): $!";
         POSIX::dup2(fileno $devnull, 1) or die "dup2(->1): $!";
         POSIX::dup2(fileno $devnull, 2) or die "dup2(->2): $!";
         POSIX::dup2(fileno $w, 3) or die "dup2(->3): $!";
         $^F= 3;
         unshift @argv, $self->{cmd_path_strace}, -o => "/proc/self/fd/3", -e => 'trace=open,openat';
         exec @argv
            or die "exec(@argv): $!";
      };
      $err_w->print($@);
      $err_w->close;
      POSIX::_exit(2); # forcibly exit rather than bubble up the stack
   }
   else {
      close $w;
      close $err_w;
      my %deps;
      my $err= do { local $/; <$err_r> };
      if (length $err) {
         waitpid($pid, 0);
         die $err;
      }
      $self->{_log_trace}->("Reading strace output") if $self->{_log_trace};
      while (<$r>) {
         $self->{_log_trace}->($_) if $self->{_log_trace};
         $deps{$1}= 1 if /^open(?:at)?\(.*?"(.*?)",.*?= [0-9]/;
      }
      $self->{_log_trace}->("Done reading strace") if $self->{_log_trace};
      waitpid($pid,0);
      my $wstat= $?;
      $self->{_log_trace}->("Command exited with $wstat") if $self->{_log_trace};
      croak "straced command failed: wstat = $wstat"
         if $wstat;
      return \%deps;
   }
}


sub add_passwd($self, %options) {
   # If the dst_userdb hasn't been created, create it by filtering the src_userdb by which
   # group and user ids have been seen during the export.
   my $db= $self->dst_userdb // Sys::Export::Unix::UserDB->new(
      auto_import => ($self->{src_userdb} //= $self->_build_src_userdb),
   );
   $db->group($_) for keys $self->dst_gid_used->%*;
   $db->user($_) for keys $self->dst_uid_used->%*;
   $db->save(\my %contents);
   my $etc_path= $options{etc_path} // 'etc';
   $self->add([ dir755  => "$etc_path", { uid => 0, gid => 0 }]);
   $self->add([ file644 => "$etc_path/passwd", $contents{passwd}, { uid => 0, gid => 0 }]);
   $self->add([ file600 => "$etc_path/shadow", $contents{shadow}, { uid => 0, gid => 0 }]);
   $self->add([ file644 => "$etc_path/group",  $contents{group},  { uid => 0, gid => 0 }]);
   $self;
}


sub add_localtime($self, $tz_name) {
   if (exists $self->{dst_path_set}{"usr/share/zoneinfo/$tz_name"}
      || ($self->_dst->can('dst_abs') && -f $self->_dst->dst_abs . $tz_name)
   ) {
      # zoneinfo is exported, and includes this timezone, so symlink to it
      $self->add([ sym => "etc/localtime" => "../usr/share/zoneinfo/$tz_name" ]);
   }
   elsif (defined (my $src_path= $self->_src_abs_path("usr/share/zoneinfo/$tz_name"))) {
      $self->add([ file644 => 'etc/localtime', { data_path => $self->src_abs . $src_path } ]);
   }
   elsif (defined (my $path= abs_path("/usr/share/zoneinfo/$tz_name"))) {
      $self->add([ file644 => 'etc/localtime', { data_path => $path } ]);
   }
   else {
      croak "Can't find 'usr/share/zoneinfo/$tz_name' in destination, source, or host filesystem";
   }
}

# Avoiding dependency on namespace::clean
delete @{Sys::Export::Linux::}{qw( croak carp confess abs_path )};
1;

__END__