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


line stmt bran cond sub pod time code
1             package Sys::Linux::Namespace;
2             # ABSTRACT: Sets up linux kernel namespaces
3              
4 1     1   38640 use strict;
  1         3  
  1         25  
5 1     1   4 use warnings;
  1         2  
  1         24  
6              
7 1     1   283 use Sys::Linux::Mount qw/:all/;
  1         5  
  1         149  
8             #use Sys::Linux::Unshare qw/:all/;
9 1     1   385 use Linux::Clone;
  1         259  
  1         24  
10 1     1   410 use POSIX qw/_exit/;
  1         4218  
  1         4  
11 1     1   1485 use Time::HiRes qw/sleep/;
  1         932  
  1         4  
12              
13 1     1   531 use Moo;
  1         9311  
  1         4  
14 1     1   1079 use Carp qw/croak/;
  1         2  
  1         696  
15              
16             has no_proc => (is => 'rw');
17             has term_child => (is => 'rw', default => 1);
18              
19             our $debug = 0;
20             sub debug {
21 1 50   1 0 70 print STDERR @_ if $debug;
22             }
23              
24             our $VERSION = v0.013;
25             my @signames = keys %SIG; # capture before anyone has probably localized it.
26              
27             for my $p (qw/tmp mount pid net ipc user uts sysvsem/) {
28             my $pp = "private_$p";
29             has $pp => (is => 'rw');
30             }
31              
32             sub _uflags {
33 1     1   3 my $self = shift;
34 1         2 my $uflags = 0;
35              
36 1 0 33     7 $uflags |= Linux::Clone::NEWNS if ($self->private_tmp || $self->private_mount || ($self->private_pid && !$self->no_proc));
      0        
      33        
37 1 50       5 $uflags |= Linux::Clone::NEWPID if ($self->private_pid);
38 1 50       4 $uflags |= Linux::Clone::NEWNET if ($self->private_net);
39 1 50       5 $uflags |= Linux::Clone::NEWIPC if ($self->private_ipc);
40 1 50       4 $uflags |= Linux::Clone::NEWUSER if ($self->private_user);
41 1 50       4 $uflags |= Linux::Clone::NEWUTS if ($self->private_uts);
42 1 50       4 $uflags |= Linux::Clone::SYSVSEM if ($self->private_sysvsem);
43              
44 1         979 return $uflags;
45             }
46              
47             sub _subprocess {
48 1     1   4 my ($self, $code, %args) = @_;
49 1 50       4 croak "_subprocess requires a CODE ref" unless ref $code eq 'CODE';
50              
51 1         4 debug "Forking\n";
52             my $pid = Linux::Clone::clone (sub {
53 0     0   0 local $$ = POSIX::getpid(); # try to fix up $$ if we can.
54 0         0 local %SIG = map {$_ => sub {debug "Got signal in $$, exiting"; _exit(0)}} @signames;
  0         0  
  0         0  
  0         0  
55 0         0 debug "Inside Child $$\n";
56            
57 0         0 $code->(%args);
58 0         0 _exit(0); # always exit with 0
59 1         10 }, 0, POSIX::SIGCHLD | $self->_uflags);
60              
61 1 50       255 croak "Failed to fork: $!" if ($pid < 0);
62              
63             my $sighandler =
64 0 0       0 local %SIG = map {my $q=$_; $q => sub {
  0         0  
65 0     0   0 debug "got signal $q in $$\n";
66 0         0 kill 'TERM', $pid;
67 0         0 sleep(0.2);
68 0         0 kill 'KILL', $pid;
69 0         0 kill 'KILL', $pid;
70 0         0 }} ($self->term_child ? @signames : ());
71              
72 0         0 waitpid($pid, 0);
73 0         0 return $?
74             }
75              
76             sub pre_setup {
77 1     1 0 15 my ($self, %args) = @_;
78              
79 1 50       6 croak "Private net is not yet supported" if $self->private_net;
80 1 0 0     9 if ($self->private_pid && (ref $args{code} ne 'CODE' || !$args{_run})) {
      33        
81 0         0 croak "Private PID space requires a coderef to become the new PID 1";
82             }
83             }
84              
85             sub post_setup {
86 0     0 0 0 my ($self, %args) = @_;
87             # 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.
88 0 0 0     0 if ($self->private_tmp || $self->private_mount || ($self->private_pid && !$self->no_proc)) {
      0        
      0        
89 0         0 mount("/", "/", undef, MS_REC|MS_PRIVATE, undef);
90             }
91              
92 0 0       0 if ($self->private_tmp) {
93 0         0 my $data = undef;
94 0 0       0 $data = $self->private_tmp if (ref $self->private_tmp eq 'HASH');
95              
96 0         0 mount("none", "/tmp", "tmpfs", MS_MGC_VAL, undef);
97 0         0 mount("none", "/tmp", "tmpfs", MS_PRIVATE, $data);
98             }
99              
100 0 0 0     0 if ($self->private_pid && !$self->no_proc) {
101 0         0 mount("proc", "/proc", "proc", MS_MGC_VAL, undef);
102 0         0 mount("proc", "/proc", "proc", MS_PRIVATE|MS_REC, undef);
103             }
104             }
105              
106             sub setup {
107 0     0 1 0 my ($self, %args) = @_;
108              
109 0         0 my $uflags = $self->_uflags;
110 0         0 $self->pre_setup(%args);
111            
112 0         0 Linux::Clone::unshare($uflags);
113 0         0 $self->post_setup(%args);
114              
115 0         0 return 1;
116             }
117              
118             sub run {
119 1     1 1 3353 my ($self, %args) = @_;
120              
121 1         3 my $code = $args{code};
122 1         3 $args{_run} = 1;
123              
124 1 50       6 croak "Run must be given a codref to run" unless ref $code eq "CODE";
125              
126 1         7 $self->pre_setup(%args);
127             $self->_subprocess(sub {
128 0     0     $self->post_setup(%args);
129 0           $code->(%args);
130 1         8 }, %args);
131              
132 0           return 1;
133             }
134              
135             1;
136              
137             __END__