App-LXC-Container
view release on metacpan or search on metacpan
lib/App/LXC/Container/Run.pm view on Meta::CPAN
else
{ unshift @command, "'$cmd'"; }
debug(4, 'command is "exec', join(' ', @command), '"');
push @todo, join(' ', 'exec', @command);
# finally write startup script:
open my $f, '>', $self->{init}
or fatal 'can_t_open__1__2', $self->{init}, $!;
say $f $_ foreach @todo;
close $f;
# A failing chmod can only happen in very unlikely race conditions:
# uncoverable branch true
unless (chmod(0755, $self->{init}) == 1)
{
# uncoverable statement
fatal 'call_failed__1__2', 'chmod', $self->{init};
}
# TODO: We could optimise everything if we only have /bin/sh as single
# command (no script needed)!
}
#########################################################################
=head2 B<_write_xauthority> - write X11 authority file for container/user
$container_path = $self->_write_xauthority($display);
lib/App/LXC/Container/Setup.pm view on Meta::CPAN
$dir =~ s|(?<=[^/])/+$||;
my $root = $self->_init_fs_dialog(txt('select_root_directory'),
_DEFAULT_ROOT_DIR);
$root or exit 0;
$root =~ s|(?<=[^/])/+$||;
# create directory, link and basic environment:
local $_;
my $error = [];
-d $dir . '/conf'
or make_path($dir . '/conf', { chmod => 0755, error => \$error });
@$error and
fatal 'aborting_after_error__1', join("\n", map{values %$_} @$error);
( -l _ROOT_DIR_ and readlink(_ROOT_DIR_) eq $dir)
or symlink $dir, _ROOT_DIR_
or fatal 'can_t_link__1_to__2__3', _ROOT_DIR_, $dir, $!;
_write_to($dir . '/.networks.lst', initial_network_list());
_write_to($dir . '/.root_fs', $root);
# create default configuration files:
_create_or_compare('10-NET-default.conf', content_network_default());
lib/App/LXC/Container/Update.pm view on Meta::CPAN
my ($mode, $uid, $gid) = ($stat->mode, $stat->uid, $stat->gid);
if (-d)
{
$mode |= 0200; # prevent blocking ourselves later on
if (-l)
{
# links can be arbitrarily deep, so we use make_path on the
# absolute path and hope for no clashes:
$target = $root . abs_path($_);
my $errors = [];
make_path($target, {chmod => $mode, error => \$errors});
$errors = join(' ', map { (values(%$_)) } @$errors);
$errors eq ''
or error('can_t_create__1__2', $target, $errors);
}
else
{
mkdir $target or fatal('can_t_create__1__2', $target, $!);
}
# There are no standard files known to me meeting condition 2 or
# 4 (but not 1 and 3):
lib/App/LXC/Container/Update.pm view on Meta::CPAN
}
else
{
open my $f, '>', $target
or fatal('can_t_create__1__2', $target, $!);
close $f;
}
if (-W $target)
{
# ignoring errors as mounting overrules most problems anyway:
chmod $mode, $target;
chown $uid, $gid, $target;
}
}
}
#########################################################################
=head2 B<_parse_filter> - parse filter configuration file
$self->_parse_filter();
lib/App/LXC/Container/Update.pm view on Meta::CPAN
################################
# part 6 - create all empty files:
foreach (@{$self->{empty_files}})
{
$_ = $self->{root_fs} . '/' . $container . $_;
# As we just deleted the whole tree we can't create a test for a
# failed empty file here:
# uncoverable branch true
open my $empty, '>', $_ or fatal 'can_t_open__1__2', $_, $!;
close $empty;
chmod 0600, $_;
}
close $out;
}
#########################################################################
1;
#########################################################################
t/02-init.t view on Meta::CPAN
'^<1> \[ Quit \][^<]+'.
'^<2> \[ OK \][^<]+' .
'^<0> leave box\s+^----- enter number to choose next step: [^<]+';
#########################################################################
# identical parts of messages:
my $re_msg_tail = qr/ at $0 line \d{2,}\.?$/;
#########################################################################
# failing and aborted tests of _init_config_dir:
chmod 0555, FAIL_PATH or die "can't chmod 0555 ", FAIL_PATH;
$_ = fail_in_sub_perl(HOME_PATH, FAIL_PATH, '2 2 2 2', 1);
like($_,
qr{^aborting after the following error\(s\):\nPermission denied at }m,
'bad configuration directory should fail');
$_ = fail_in_sub_perl(HOME_PATH, FAIL_PATH, '2 1 2 2', 0);
like($_,
qr{$re_dialog_main$re_dialog_buttons}ms,
'aborting initialisation 1 looks correct');
ok(! -d HOME_PATH . '/conf', 'conf does not yet exist');
$_ = fail_in_sub_perl(HOME_PATH, FAIL_PATH, '2 2 2 1', 0);
t/02-init.t view on Meta::CPAN
qr{^bad call to App::LXC::Container::Setup->new.*$re_msg_tail},
'bad call of App::LXC::Container::Setup->new fails');
#########################################################################
# tests of _init_config_dir:
# on smokers (no STDIN from TTY) we only use mockup (except for 'ls' and 'ldd'):
-t STDIN and $ENV{PATH} = T_PATH . '/mockup:' . $ENV{PATH};
# We must find the real ldd, not the one in mockup for setup/data tests:
chmod 0644, T_PATH . '/mockup/ldd'
or die "can't chmod 0644 ", T_PATH . '/mockup/ldd';
my $re_dialog = join('',
$re_dialog_main,
$re_dialog_fs,
$re_dialog_value,
$re_dialog_fs,
$re_dialog_main,
$re_dialog_buttons,
$re_dialog_main,
$re_dialog_buttons
t/03-setup.t view on Meta::CPAN
my $abs_test_file = HOME_PATH . '/write.tst';
my $test_file = '/home/write.tst';
output_like
{ App::LXC::Container::Setup::_write_to($abs_test_file, '42'); }
qr{^$}, qr{^$},
'1st writing test did not fail';
output_like
{ App::LXC::Container::Setup::_write_to($abs_test_file, '47'); }
qr{^$}, qr{^$},
'2nd writing test did not fail';
_chmod(0444, $test_file);
output_like
{ App::LXC::Container::Setup::_write_to($abs_test_file, '0'); }
qr{^$}, qr{^using existing protected .*/t/tmp/home/write.tst$re_msg_tail},
'3rd writing test produced warning';
my $output = '';
if (-f $abs_test_file)
{
open my $in, '<', $abs_test_file
or die "can't open ", $abs_test_file, ': ', $!;
$output = join('', <$in>);
t/03-setup.t view on Meta::CPAN
qr/^INTERNAL ERROR [^:]+: uneven list in _modify_entry$re_msg_tail/,
'uneven parameter list for _modify_entry fails');
my $dummy_obj = {name => 'not-accessible'};
sub test_not_accessible($)
{
my ($file) = @_;
my $short_path = '/lxc/conf/' . $file;
_remove_file($short_path);
_setup_file($short_path);
_chmod(0, $short_path);
my $re = "can't open '" . LXC_LINK . '/conf/' . $file . "'" . ': .*'
. $re_msg_tail_eval;
(my $func = $file) =~ s/^.*\.//;
$func = 'App::LXC::Container::Setup::_parse_' . $func . '($dummy_obj);';
eval "$func";
like($@, qr/^$re$/,
'reading non-accessible configuration file ' . $file . ' fails');
}
test_not_accessible('ne-NOT-not-accessible.filter');
test_not_accessible('ne-CNF-not-accessible.master');
t/03-setup.t view on Meta::CPAN
App::LXC::Container::Setup::__add_library_packages_internal_code
($dummy_ui, @_);
}
stdout_like
{ test_ldd_dummy_object('/bin/ls'); }
qr{^ADD2UI\s+libc6(?::amd64|:i386)?$},
'test for existing library dependencies';
_setup_file('/usr/bin/3ls');
_setup_link(TMP_PATH . '/usr/libbad.so.0', '/usr/non-existing-dir/libbad.so');
chmod 0755, T_PATH . '/mockup/ldd'
or die "can't chmod 0755 ", T_PATH . '/mockup/ldd';
stdout_like
{ test_ldd_dummy_object(TMP_PATH . '/usr/bin/3ls'); }
qr{^$},
'ldd test with bad symbolic link';
stdout_like
{ test_ldd_dummy_object('/nowhere/to/be/found'); }
qr{^$},
'test for non-existing library dependencies';
_remove_link(TMP_PATH . '/usr/libbad.so.0');
chmod 0644, T_PATH . '/mockup/ldd'
or die "can't chmod 0644 ", T_PATH . '/mockup/ldd';
#########################################################################
# final statistics:
diag('big test statistic: ', $big_stat[0],
' inputs checked against a regular expression of size ', $big_stat[1]);
t/06-update.t view on Meta::CPAN
eval { App::LXC::Container::Update::new('wrong-call', 'dummy'); };
like($@,
qr{^bad call to App::LXC::Container::Update->new.*$re_msg_tail},
'bad call of App::LXC::Container::Update->new fails');
eval { App::LXC::Container::update('bad-name!'); };
like($@,
qr/^The name of the container may only contain word char.*!$re_msg_tail/,
'bad container name fails');
_chmod(0444, '/lxc/.networks.lst');
$_ = fail_in_sub_perl(2, 'good-name');
$re = "^can't open '" . LXC_LINK . '/\.networks\.lst' . "'"
. ': .* at -e line 4\.' . '$';
like($_, qr{$re}m,
'new network number fails for protected global network file');
_chmod(0644, '/lxc/.networks.lst');
$_ = App::LXC::Container::Update->new('bad-paths');
$_->{root_fs} = BAD_CONF;
eval { $_->_make_lxc_path('unused_dummy'); };
like($@,
qr{^can't create '/.[^']+/bad-paths': .*$re_msg_tail},
'inaccessible LXC root directory fails');
$_->{root_fs} = CONF_ROOT;
eval { $_->_make_lxc_path('/non-existing'); };
like($@,
qr{^/non-existing doesn't exist!$re_msg_tail},
'non-existing real directory fails');
_setup_dir('/lxc/bad-paths/var');
_chmod(0444, '/lxc/bad-paths/var');
eval { $_->_make_lxc_path('/var/tmp'); };
like($@,
qr{^can't create '/.[^']+/bad-paths/var/tmp': .*$re_msg_tail},
'protected LXC sub-directory fails for directory');
_setup_dir('/lxc/bad-paths/etc');
_chmod(0444, '/lxc/bad-paths/etc');
eval { $_->_make_lxc_path('/etc/profile'); };
like($@,
qr{^can't create '/.[^']+/bad-paths/etc/profile': .*$re_msg_tail},
'protected LXC sub-directory fails for file');
_remove_file('/lxc/bad-paths.conf');
_chmod(0555, '/lxc');
eval { $_->_write_lxc_configuration(); };
like($@,
qr{^can't open '/.[^']+/.lxc-configuration/bad-paths.conf': .*$re_msg_tail},
'writing LXC configuration file into protected directory fails');
_chmod(0755, '/lxc');
$_->{network} = 1;
foreach my $conf (qw(10-NET-default.conf 20-DEV-default.conf))
{
_chmod( 0, '/lxc/conf/' . $conf);
eval { $_->_write_lxc_configuration(); };
like($@,
qr{^can't open '/.[^']+/.lxc-configuration/conf/$conf': .*$re_msg_tail},
'writing LXC configuration file fails without access to ' . $conf);
_chmod(0644, '/lxc/conf/' . $conf);
}
eval { App::LXC::Container::update('no-network', 'other'); };
like($@,
qr/^special container no-network may not be mixed with others$re_msg_tail/,
'no-network with additional name fails');
_remove_file(LOCAL_ROOT_FS);
_setup_file(LOCAL_ROOT_FS, CONF_ROOT); # create tree below t/tmp/lxc
my $os = App::LXC::Container::Data::_singleton()->{OS};
SKIP:{
if (-l '/lib')
{
my $bad = App::LXC::Container::Update->new('bad-paths');
_setup_dir('/lxc/bad-paths/usr');
_chmod(0444, '/lxc/bad-paths/usr');
output_like
{ $bad->_make_lxc_path('/lib'); }
qr{^$},
qr{^can't create '/.[^']+/bad-paths/usr/lib': .*$re_msg_tail},
'protected LXC sub-directory fails for linked directory';
_remove_dir(TMP_PATH . '/lxc/bad-paths/usr');
}
else
{ skip "/lib not symbolic link on $os", 1; }
}
#########################################################################
# preparation for different distributions:
-f '/etc/debian_version'
or patch_config(CONF_PATH . '/40-MNT-default.mounts', 'd' => -1);
#########################################################################
# tests breaking internals:
# some of the next tests need a restricted "others" access to the path:
_chmod(0750, '/');
_setup_file('/lxc/conf/un-CNF-update-test-broken.master');
_setup_file('/lxc/conf/un-NOT-update-test-broken.filter');
_setup_file('/lxc/conf/un-MNT-update-test-broken.mounts');
_setup_file('/lxc/conf/un-PKG-update-test-broken.packages');
_setup_file('/lxc/conf/un-SPC-update-test-broken.special');
_chmod(0, '/lxc/conf/un-SPC-update-test-broken.special');
my $broken = App::LXC::Container::Update->new('update-test-broken');
$broken->_parse_master();
$broken->_parse_packages();
$broken->{packages} = [ grep { ! m{^dash$} } @{$broken->{packages}}];
$broken->_parse_mounts();
$broken->_parse_filter();
$broken->{filter}{'/var/log'} = 'copy';
stderr_like
{ eval '$broken->_write_lxc_configuration();'; }
qr{\A(?:.*may be inaccessible for LXC container's root account$re_eval\n)*\Z},
t/06-update.t view on Meta::CPAN
my $re_err5 = "cp:.*\ncan't copy '/home/some.file': 256" . $re_msg_tail . "\n";
my $re_err_o1 = "(.*/lib/ld-linux.so.2 doesn't exist!" . $re_msg_tail . "\n)?";
$ENV{ALC_DEBUG} = 0; # cover branch in App::LXC::Container::update
output_like
{ App::LXC::Container::update('update-test-bad'); }
qr{^$},
qr{\A($re_err1){4}($re_err2)?($re_err3$re_err5|$re_err5$re_err3)}m,
'reading bad configuration files update-test-bad print errors';
_setup_file('/lxc/update-test-bad/home/some.file');
_chmod(0555, '/lxc/update-test-bad/home', '/lxc/update-test-bad', '/lxc');
my $re_err6 =
"can't remove '/.*/tmp/lxc/update-test-bad': .*" . $re_msg_tail . "\n";
$ENV{ALC_DEBUG} = 'x';
output_like
{ App::LXC::Container::update('update-test-bad'); }
qr{^$},
qr{\A($re_err1){4}($re_err2)?$re_err6$re_err3\Z}m,
'protected LXC directory prints error';
_chmod(0755, '/lxc', '/lxc/update-test-bad', '/lxc/update-test-bad/home');
delete $ENV{ALC_DEBUG};
_remove_file('/lxc/conf/ud-NOT-update-test-bad.filter');
$re = "^can't open '" . CONF_PATH . '/ud-NOT-update-test-bad.filter' . "'"
. ': .* at -e line 3\.' . "\n\\Z";
$_ = fail_in_sub_perl(1, 'update-test-bad');
like($_, qr{$re}m, 'missing filter configuration fails');
_remove_file('/lxc/conf/ud-MNT-update-test-bad.mounts');
$re = "^can't open '" . CONF_PATH . '/ud-MNT-update-test-bad.mounts' . "'"
'empty master configuration fails');
_remove_file('/lxc/run-test-broken.conf');
_setup_file('/lxc/run-test-broken.conf',
'#MASTER:L42,-,-',
'lxc.rootfs.path=' . CONF_ROOT . '/run-test-broken',
'lxc.net.0.ipv4.address = 10.0.3.42/24');
$ENV{ALC_DEBUG} = 0; # cover branch in App::LXC::Container::run
_setup_file('/lxc-ls', '#!/bin/sh', 'exit 0'); # lxc-ls runs before nft!
_chmod(0755, '/lxc-ls');
$ENV{PATH} = TMP_PATH . ':/bin:/usr/bin'; # open will fail
stderr_like
{ eval "App::LXC::Container::run('run-test-broken');"; }
qr{^.*"nft": [^:]+App/LXC/Container/Run\.pm line \d+\.$},
'1st (mocked) nft list for local network fails with correct output';
like($@,
qr{^error running 'nft list ruleset inet' [^:]+: 0$re_eval},
'1st (mocked) nft list for local network fails with correct message');
$ENV{ALC_DEBUG} = 'x';
$ENV{PATH} = $test_path; # close will fail
_remove_file('/lxc/run-test-1/etc/passwd');
_remove_file('/lxc/run-test-1/etc/shadow');
_remove_dir(TMP_PATH . '/lxc/run-test-1/etc');
eval '$_->_prepare_user();';
like($@,
qr{^can't open .+/run-test-1/etc/group': No such file or directory$re_eval},
'non-existing target /etc has correct output (for /etc/group)');
_setup_dir('/lxc/run-test-1/etc');
_setup_file('/lxc/run-test-1/etc/gshadow'); # for successful unlink of it
_chmod(0, '/etc/shadow');
eval '$_->_prepare_user();';
like($@,
qr{can't open .+tmp/etc/shadow': Permission denied$re_eval},
'failing read-access to mocked /etc/shadow has correct output');
_chmod(0644, '/etc/shadow');
_chmod(0555, '/lxc/run-test-1/etc');
eval '$_->_prepare_user();';
like($@,
qr{can't remove .+tmp/lxc/run-test-1/etc/group': Permission denied$re_eval},
'failing write-access to target /etc has correct output');
_chmod(0755, '/lxc/run-test-1/etc');
$_->{mounts}{'/etc'} = 1;
output_like
{ $_->_prepare_user(); }
qr{^$}, qr{^$},
'_prepare_user for mapped /etc looks correct';
delete $_->{mounts}{'/etc'};
$_->{mounts}{'/etc/group'} = 1;
$_->{mounts}{'/etc/gshadow'} = 1;
output_like
{ $_->_prepare_user(); }
qr{^$}, qr{^$},
'_prepare_user for all 4 mapped account files looks correct';
#########################################################################
# check writing of startup script for 1st configuration:
_remove_file('/lxc/run-test-1/lxc-run.sh');
_setup_file('/lxc/run-test-1/lxc-run.sh');
_chmod(0444, '/lxc/run-test-1/lxc-run.sh');
eval '$_->_write_init_sh();';
like($@,
qr{can't open .+tmp/lxc/run-test-1/lxc-run.sh': Permission denied$re_eval},
'failing write-access to startup script lxc-run.sh has correct output');
_remove_file('/lxc/run-test-1/lxc-run.sh');
$_->{running} = 0;
eval '$_->_write_init_sh();';
is($@, '', 'creating minimal startup script run without problems');
check_config_file(TMP_PATH . '/lxc/run-test-1/lxc-run.sh',
$_ = _sub_perl('use App::LXC::Container;
$_ = App::LXC::Container::Run->new
("run-test-1", "root", "/", "command");
$_->{running} = 1;
$_->_run();');
like($_, qr{^using 'PoorTerm' as UI$},
'_run in 2nd mockup test (lxc-attach) seems correct');
_setup_dir('/lxc/run-test-1/.xauth-dir');
_setup_file('/lxc/run-test-1/.xauth-dir/.Xauthority', 42);
_chmod(0555, '/lxc/run-test-1/.xauth-dir');
$_ = _sub_perl('use App::LXC::Container;
$_ = App::LXC::Container::Run->new
("run-test-1", "root", "/", "command");
$_->_run();');
$re_output =
"using 'PoorTerm' as UI\n" .
"can't remove .+tmp/lxc/run-test-1/.xauth-dir/.Xauthority': " .
'Permission denied at -e line \d\.';
like($_, qr{^$re_output$},
'_run in 3rd mockup test (lxc-execute protected .Xauthority) fails correct');
_chmod(0755, '/lxc/run-test-1/.xauth-dir');
_remove_file('/lxc/run-test-1/.xauth-dir/.Xauthority');
_remove_dir('/lxc/run-test-1/.xauth-dir');
#########################################################################
# tests with 2nd valid configuration:
_setup_dir('/lxc/run-test-2');
_remove_file('/lxc/run-test-2.conf');
_setup_file('/lxc/run-test-2.conf',
'#MASTER:G42,X,A',
'lxc.rootfs.path=' . CONF_ROOT . '/run-test-2',
[user => 'root'],
[x11 => 'X']]);
#########################################################################
# check writing of startup script for 2nd configuration:
_remove_file('/lxc/run-test-2/lxc-run.sh');
_remove_file('/home/.Xauthority');
_setup_file('/home/.Xauthority');
_chmod(0600, '/home/.Xauthority');
system('cp', '-a',
T_PATH . '/mockup-files/.Xauthority',
HOME_PATH . '/.Xauthority') == 0
or die "can't cp mockup '.Xauthority: $!\n";
$ENV{DISPLAY} = ':0';
$ENV{XAUTHORITY} = HOME_PATH . '/.Xauthority';
_remove_file('/lxc/run-test-2/.xauth-root/.Xauthority');
_remove_dir(TMP_PATH . '/lxc/run-test-2/.xauth-root');
_chmod(0555, '/lxc/run-test-2');
eval '$_->_write_init_sh();'; # 1 - creating .xauth directory fails
like($@,
qr{^can't create .+/lxc/run-test-2/.xauth-root': Permission denied$re_eval},
'failing write-access for .xauth directory has correct output');
_chmod(0755, '/lxc/run-test-2');
eval '$_->_write_init_sh();'; # 2 - "empty original" .Xauthority fails
like($@,
qr{^call to 'xauth list' failed: no :0$re_eval},
'missing .Xauthority entry fails correctly');
eval '$_->_write_init_sh();'; # 3 - writing .Xauthority fails
like($@,
qr{^call to 'xauth -b -f [^']+/\.Xauthority add [^']+' failed: \d+$re_eval},
'failing write-access for .Xauthority has correct output');
t/08-data.t view on Meta::CPAN
qr{^Can't determine OS \(distribution\)! .+$re__e});
my $re1a = qr{aborting after the following error\(s\):\n};
my $re1b = qr{Can't locate App/LXC/Container/Data/Nonexistingdistribution.+\n};
my $re1c = qr{$re__e\n};
my $re2 = qr{unknown OS: Non-existing-distribution - .+$re__e};
check_singleton('os-release-unknown', qr{^$re1a$re1b$re1c$re2$});
$ENV{PATH} = T_PATH . '/mockup:' . $ENV{PATH};
# libraries_used:
chmod 0755, T_PATH . '/mockup/ldd'
or die "can't chmod 0755 ", T_PATH . '/mockup/ldd';
eval { App::LXC::Container::Data::libraries_used('/'); };
like($@,
qr{^INTERNAL ERROR .*: not a file: /$re_data_tail},
'libraries_used on / fails');
_setup_file('/home/no-executable');
stderr_like
{
eval {
t/08-data.t view on Meta::CPAN
my @libs = ();
eval {
@libs =
App::LXC::Container::Data::libraries_used(TMP_PATH . '/home/fake-lib');
};
like(join(' - ', $@, @libs), qr{^$},
'libraries_used on fake library runs as excepted');
_remove_file('/home/fake-lib');
# switch back to real ldd:
chmod 0644, T_PATH . '/mockup/ldd'
or die "can't chmod 0644 ", T_PATH . '/mockup/ldd';
#########################################################################
# All tests here trigger code paths in Data/Debian.pm not triggered by the
# other tests:
reset_dpkg_status(T_PATH . '/mockup-files/dpkg.status');
my $singleton = App::LXC::Container::Data::_singleton;
defined $singleton->{STATUS} and die '$singleton->{STATUS} already set';
my @list =
App::LXC::Container::Data::depends_on('non-existing-package', 0);
t/functions/files_directories.pl view on Meta::CPAN
#!/bin/false
# not to be used stand-alone
#
# helper function to setup test-files and -directories:
sub _chmod($$)
{
my $mode = shift;
while (local $_ = shift)
{
$_ = TMP_PATH . $_;
chmod $mode, $_ or die "can't chmod $mode $_: $!";
}
}
sub _remove_dir($)
{
my $dir = shift;
if (-e $dir)
{ rmdir $dir or die "can't rmdir $dir: $!"; }
}
( run in 0.478 second using v1.01-cache-2.11-cpan-496ff517765 )