File Coverage

blib/lib/Sys/Linux/Namespace.pm

Criterion	Covered	Total	%
statement	49	88	55.6
branch	11	36	30.5
condition	3	27	11.1
subroutine	13	18	72.2
pod	2	5	40.0
total	78	174	44.8

package Sys::Linux::Namespace;
# ABSTRACT: Sets up linux kernel namespaces

use strict;
use warnings;

use Sys::Linux::Mount qw/:all/;
#use Sys::Linux::Unshare qw/:all/;
use Linux::Clone;
use POSIX qw/_exit/;
use Time::HiRes qw/sleep/;

use Moo;
use Carp qw/croak/;

has no_proc => (is => 'rw');
has term_child => (is => 'rw', default => 1);

our $debug = 0;
sub debug {
  print STDERR @_ if $debug;
}

our $VERSION = v0.013;
my @signames = keys %SIG; # capture before anyone has probably localized it.

for my $p (qw/tmp mount pid net ipc user uts sysvsem/) {
  my $pp = "private_$p";
  has $pp => (is => 'rw');
}

sub _uflags {
  my $self = shift;
  my $uflags = 0;

  $uflags |= Linux::Clone::NEWNS if ($self->private_tmp || $self->private_mount || ($self->private_pid && !$self->no_proc));
  $uflags |= Linux::Clone::NEWPID if ($self->private_pid);
  $uflags |= Linux::Clone::NEWNET if ($self->private_net);
  $uflags |= Linux::Clone::NEWIPC if ($self->private_ipc);
  $uflags |= Linux::Clone::NEWUSER if ($self->private_user);
  $uflags |= Linux::Clone::NEWUTS if ($self->private_uts);
  $uflags |= Linux::Clone::SYSVSEM if ($self->private_sysvsem);

  return $uflags;
}

sub _subprocess {
  my ($self, $code, %args) = @_;
  croak "_subprocess requires a CODE ref" unless ref $code eq 'CODE';

  debug "Forking\n";
  my $pid = Linux::Clone::clone (sub {
    local $$ = POSIX::getpid(); # try to fix up $$ if we can.
    local %SIG = map {$_ => sub {debug "Got signal in $$, exiting"; _exit(0)}} @signames;
    debug "Inside Child $$\n";

    $code->(%args);
    _exit(0); # always exit with 0
  }, 0, POSIX::SIGCHLD | $self->_uflags);

  croak "Failed to fork: $!" if ($pid < 0);

  my $sighandler =
  local %SIG = map {my $q=$_; $q => sub {
      debug "got signal $q in $$\n";
      kill 'TERM', $pid;
      sleep(0.2);
      kill 'KILL', $pid;
      kill 'KILL', $pid;
  }} ($self->term_child ? @signames : ());

  waitpid($pid, 0);
  return $?
}

sub pre_setup {
  my ($self, %args) = @_;

  croak "Private net is not yet supported" if $self->private_net;
  if ($self->private_pid && (ref $args{code} ne 'CODE' || !$args{_run})) {
    croak "Private PID space requires a coderef to become the new PID 1";
  }
}

sub post_setup {
  my ($self, %args) = @_;
  # If we want a private /tmp, or private mount we need to recursively make every mount private.  it CAN be done without that but this is more reliable.
  if ($self->private_tmp || $self->private_mount || ($self->private_pid && !$self->no_proc)) {
      mount("/", "/", undef, MS_REC|MS_PRIVATE, undef);
  }

  if ($self->private_tmp) {
    my $data = undef;
    $data = $self->private_tmp if (ref $self->private_tmp eq 'HASH');

    mount("none", "/tmp", "tmpfs", MS_MGC_VAL, undef);
    mount("none", "/tmp", "tmpfs", MS_PRIVATE, $data);
  }

  if ($self->private_pid && !$self->no_proc) {
    mount("proc", "/proc", "proc", MS_MGC_VAL, undef);
    mount("proc", "/proc", "proc", MS_PRIVATE|MS_REC, undef);
  }
}

sub setup {
  my ($self, %args) = @_;

  my $uflags = $self->_uflags;
  $self->pre_setup(%args);

  Linux::Clone::unshare($uflags);
  $self->post_setup(%args);

  return 1;
}

sub run {
  my ($self, %args) = @_;

  my $code = $args{code};
  $args{_run} = 1;

  croak "Run must be given a codref to run" unless ref $code eq "CODE";

  $self->pre_setup(%args);
  $self->_subprocess(sub {
    $self->post_setup(%args);
    $code->(%args);
  }, %args);

  return 1;
}

1;

__END__