File Coverage

blib/lib/Sys/Export.pm

Criterion	Covered	Total	%
statement	77	86	89.5
branch	38	52	73.0
condition	13	21	61.9
subroutine	23	29	79.3
pod	18	20	90.0
total	169	208	81.2

package Sys::Export;

our $VERSION = '0.003'; # VERSION
# ABSTRACT: Export a subset of an OS file tree, for chroot/initrd

use v5.26;
use warnings;
use experimental qw( signatures );
use Carp;
use Scalar::Util qw( blessed looks_like_number );
use Exporter ();
BEGIN {
   # Fcntl happily exports macros that don't exist, then fails at runtime.
   # Replace non-existent test macros with 'false', and nonexistent modes with 0.
   require Fcntl;
   eval { Fcntl->can($_)->($_ =~ /_IS/? (0) : ()); 1 }? Fcntl->import($_) : eval "sub $_ { 0 }"
      for qw( S_ISREG S_ISDIR S_ISLNK S_ISBLK S_ISCHR S_ISFIFO S_ISSOCK S_ISWHT
              S_IFREG S_IFDIR S_IFLNK S_IFBLK S_IFCHR S_IFIFO  S_IFSOCK S_IFWHT S_IFMT );
}
our @EXPORT_OK= qw(
   isa_exporter isa_export_dst isa_userdb isa_user isa_group exporter isa_hash isa_array isa_int
   add skip find finish rewrite_path rewrite_user rewrite_group expand_stat_shorthand
   S_ISREG S_ISDIR S_ISLNK S_ISBLK S_ISCHR S_ISFIFO S_ISSOCK S_ISWHT
   S_IFREG S_IFDIR S_IFLNK S_IFBLK S_IFCHR S_IFIFO  S_IFSOCK S_IFWHT S_IFMT
);
our %EXPORT_TAGS= (
   basic_methods => [qw( exporter add skip find finish rewrite_path rewrite_user rewrite_group )],
   isa => [qw( isa_exporter isa_export_dst isa_userdb isa_user isa_group isa_hash isa_array isa_int )],
   stat_modes => [qw( S_IFREG S_IFDIR S_IFLNK S_IFBLK S_IFCHR S_IFIFO  S_IFSOCK S_IFWHT S_IFMT )],
   stat_tests => [qw( S_ISREG S_ISDIR S_ISLNK S_ISBLK S_ISCHR S_ISFIFO S_ISSOCK S_ISWHT )],
);
my ($is_module_name, $require_module);

# optional dependency on Module::Runtime.  This way if there's any bug in my cheap
# substitute, the fix is to just install the official module.
if (eval { require Module::Runtime; }) {
   $is_module_name= \&Module::Runtime::is_module_name;
   $require_module= \&Module::Runtime::require_module;
} else {
   $is_module_name= sub { $_[0] =~ /^[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*\z/ };
   $require_module= sub { require( ($_[0] =~ s{::}{/}gr).'.pm' ) };
}


sub import {
   my $class= $_[0];
   my $caller= caller;
   my %ctor_opts;
   for (my $i= 1; $i < $#_; ++$i) {
      if (ref $_[$i] eq 'HASH') {
         %ctor_opts= ( %ctor_opts, %{ splice(@_, $i--, 1) } );
      }
      elsif ($_[$i] =~ /^-(type|src|dst|tmp|src_userdb|dst_userdb|rewrite_path|rewrite_user|rewrite_group)\z/) {
         $ctor_opts{$1}= (splice @_, $i--, 2)[1];
      }
   }
   if (keys %ctor_opts) {
      init_global_exporter(%ctor_opts);
      # caller requested the global exporter instance, so also include the standard methods
      # unless it looks like they were more selective about what to import.
      push @_, 'exporter', ':basic_methods'
         unless grep /^(add|:.*methods)\z/, @_;
   }
   goto \&Exporter::import;
}

our $exporter;
sub exporter { $exporter }

our %osname_to_class= (
   linux => 'Linux',
);

sub init_global_exporter(%config) {
   my $type= delete $config{type} // $^O;
   # remap known OS names
   my $class= $osname_to_class{$type} // $type;
   # prefix bare names with namespace
   $class= "Sys::Export::$class" unless $class =~ /::/;
   $is_module_name->($class) or croak "Invalid module name '$class'";
   # if it fails, die with 'croak'
   eval { $require_module->($class) } or croak "$@";
   # now construct one
   $exporter= $class->new(%config);
}


sub add           { $exporter->add(@_) }
sub skip          { $exporter->skip(@_) }
sub find          { $exporter->src_find(@_) }
sub finish        { $exporter->finish(@_) }
sub rewrite_path  { $exporter->rewrite_path(@_) }
sub rewrite_user  { $exporter->rewrite_user(@_) }
sub rewrite_group { $exporter->rewrite_group(@_) }


sub isa_hash       :prototype($) { ref $_[0] eq 'HASH' }
sub isa_array      :prototype($) { ref $_[0] eq 'ARRAY' }
sub isa_int        :prototype($) { looks_like_number($_[0]) && int($_[0]) == $_[0] }
sub isa_exporter   :prototype($) { blessed($_[0]) && $_[0]->isa('Sys::Export::Exporter') }
sub isa_export_dst :prototype($) { blessed($_[0]) && $_[0]->can('add') && $_[0]->can('finish') }
sub isa_userdb     :prototype($) { blessed($_[0]) && $_[0]->can('user') && $_[0]->can('group') }
sub isa_user       :prototype($) { blessed($_[0]) && $_[0]->isa('Sys::Export::Unix::UserDB::User') }
sub isa_group      :prototype($) { blessed($_[0]) && $_[0]->isa('Sys::Export::Unix::UserDB::Group') }


sub _parse_major_minor_data($attrs, $data) {
   @{$attrs}{'rdev_major','rdev_minor'}= isa_array $data? @$data : split(/[,:]/, $data);
}
our %_mode_alias= (
   file => [ S_IFREG,  sub { 0666 & ~umask } ],
   dir  => [ S_IFDIR,  sub { 0777 & ~umask } ],
   sym  => [ S_IFLNK,  sub { 0777 } ],
   blk  => [ S_IFBLK,  sub { 0666 & ~umask }, \&_parse_major_minor_data, ],
   chr  => [ S_IFCHR,  sub { 0666 & ~umask }, \&_parse_major_minor_data, ],
   fifo => [ S_IFIFO,  sub { 0666 & ~umask } ],
   sock => [ S_IFSOCK, sub { 0666 & ~umask } ],
);
our @_mode_by_int;
$_mode_by_int[$_->[0]]= $_ for values %_mode_alias;
$_mode_by_int[0]= undef; # don't map 0 to any mode

sub expand_stat_shorthand {
   @_= @{$_[0]} if @_ == 1 && isa_array $_[0];
   my %attrs= @_ > 2 && isa_hash $_[-1]? %{ pop @_ } : ();
   my ($mode, $name, $data)= @_;
   my $mode_desc;
   if (isa_int $mode) {
      $mode_desc= $_mode_by_int[$mode & S_IFMT]
         or carp sprintf("Numeric mode %x doesn't match any known node types", $mode);
   }
   else {
      $mode =~ /^([a-z]+)([0-7]+)?\z/
         or croak "Invalid mode '$mode': expected number, or prefix file/dir/sym/blk/chr/fifo/sock followed by octal permissions";
      $mode_desc= $_mode_alias{$1}
         or croak "Unknown mode alias '$1'";
      $mode= $mode_desc->[0] | (defined $2? oct($2) : $mode_desc->[1]->());
   }
   $attrs{mode}= $mode;
   length $name or croak "Name must be nonzero length";
   $attrs{name}= $name;
   if (defined $data) {
      if ($mode_desc && $mode_desc->[2]) {
         $mode_desc->[2]->(\%attrs, $data);
      } else {
         $attrs{data}= $data;
      }
   }
   return %attrs;
}

1;

__END__