view release on metacpan or  search on metacpan

t/06-update.t  view on Meta::CPAN

    print $fh @content;
    close $fh;
}

#########################################################################
# identical parts of messages:
my $re_msg_tail = qr/ at $0 line \d{2,}\.?$/m;
my $re_eval = qr{ at \(eval \d+\)(\[t/\d+-[a-z]+\.t:\d+\])? line 1\.$}m;

#########################################################################
# failing tests:

_remove_link(LXC_LINK);
$_ = fail_in_sub_perl(1, 'no-network');
like($_,
     qr{\$HOME/.lxc-configuration link is missing at -e line \d\.$}m,
     'missing configuration link should fail');
_setup_dir('/home/.lxc-configuration');
$_ = fail_in_sub_perl(1, 'no-network');
like($_,
     qr{t/tmp/home/.lxc-configuration is not a symbolic link at -e line \d\.$}m,
     'bad configuration link should fail');
_remove_dir(LXC_LINK);

_setup_link(LXC_LINK, HOME_PATH);
my $re = "^can't open '" . LXC_LINK . '/.networks.lst' . "'"
    . ': .* at -e line 3\.' . "\n\\Z";
$_ = fail_in_sub_perl(1, 'no-network');
like($_, qr{$re}m, 'missing network configuration should fail');

_remove_file(LOCAL_ROOT_FS);
_setup_file('/home/.networks.lst', 'x');
$_ = fail_in_sub_perl(1, 'no-network');
$re = "^ignoring unknown configuration item in '" . LXC_LINK . '/\.networks.lst'
    . "'" . ', line 1 at -e line 3\.$';
like($_, qr{$re}m, 'bad network configuration should print error');
$re = "^can't open '" . LXC_LINK . '/.root_fs' . "'"
    . ': .* at -e line 3\.' . "\n\\Z";
like($_, qr{$re}m, 'missing configuration of root file-system should fail');

_setup_file(LOCAL_ROOT_FS, 'x');
$_ = fail_in_sub_perl(1, 'no-network');
$re = "^ignoring unknown configuration item in '" . LXC_LINK . '/\.root_fs'
    . "'" . ', line 1 at -e line 3\.$';
like($_, qr{$re}m, 'bad configuration of root file-system should print error');
_remove_file('/home/.networks.lst');

_remove_link(LXC_LINK);
_setup_link(LXC_LINK, CONF_ROOT);

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},
    'invalid copy directory filter causes correct error message';
like($@,
     qr{^INTERNAL ERROR .+: /var/log is directory in COPY$re_eval},
     'invalid copy directory filter fails');
$broken->{filter}{'/var/opt'} = 'invalid_value';
eval {   $broken->_write_lxc_configuration();   };
like($@,
     qr{^INTERNAL ERROR .+: bad filter value: invalid_value.*$re_msg_tail},
    'invalid internal value for filter fails');
eval {   $broken->_parse_specials();   };
like($@,
     qr{^can't open '/.[^']+/un-SPC-update-test-broken.special': .*$re_msg_tail},
    'inaccessible special configuration fails');

#########################################################################
# basic tests for minimal container:
$_ = App::LXC::Container::Update->new('no-network');
is(ref($_), 'App::LXC::Container::Update',
   'App::LXC::Container::Update->new returned correct object');
is($_->{networks}{'local-network'}, 2,
   'local-network container has network ID 2');
is($_->{networks}{network}, 3, 'network container has network ID 3');
ok($_->{next_network} > 3, 'next network > 3');
is(@{$_->{containers}}, 1, 'test used 1 container configuration');
is($_->{containers}[0], 'no-network', 'test used "no-network" configuration');
$_->{name} = 'network';
$_ = $_->network_number();
is($_, 3, 'network number of "network" configuration is correct');

#########################################################################
# test for bad configuration files:
_setup_file('/lxc/conf/ud-CNF-update-test-bad.master', 'invalid entry');
_setup_file('/lxc/conf/ud-NOT-update-test-bad.filter',
	    'invalid entry', '/home/some.file copy');
_setup_file('/lxc/conf/ud-MNT-update-test-bad.mounts', 'invalid entry');
_setup_file('/lxc/conf/ud-PKG-update-test-bad.packages', 'invalid entry');
_setup_dir('/lxc/update-test-bad');
_setup_file('/lxc/update-test-bad/dummy', 'dummy');

my $re_err1 =
    "^ignoring unknown configuration item in '" . CONF_PATH . '/ud-' .
    '(CNF|MNT|NOT|PKG)-update-test-bad\.(filter|master|mounts|packages)' .
    "', line 1" . $re_msg_tail . "\n";
my $re_err2 = "/.*/usr/bin/missing doesn't exist!" . $re_msg_tail . "\n";
my $re_err3 =
    "(/.* may be inaccessible for LXC container's root account" .
    $re_msg_tail . "\n){0,2}";
my $re_err4 = "/.*/lib/somelink doesn't exist!" . $re_msg_tail . "\n";
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' . "'"
    . ': .* at -e line 3\.' . "\n\\Z";
$_ = fail_in_sub_perl(1, 'update-test-bad');
like($_, qr{$re}m, 'missing mounts configuration fails');

_remove_file('/lxc/conf/ud-PKG-update-test-bad.packages');
$re = "^can't open '" . CONF_PATH . '/ud-PKG-update-test-bad.packages' . "'"
    . ': .* at -e line 3\.' . "\n\\Z";
$_ = fail_in_sub_perl(1, 'update-test-bad');
like($_, qr{$re}m, 'missing packages configuration fails');

_remove_file('/lxc/conf/ud-CNF-update-test-bad.master');
$re = "^can't open '" . CONF_PATH . '/ud-CNF-update-test-bad.master' . "'"
    . ': .* at -e line 3\.' . "\n\\Z";
$_ = fail_in_sub_perl(1, 'update-test-bad');
like($_, qr{$re}m, 'missing master configuration fails');

#########################################################################
# test for master files:
_setup_file('/lxc/conf/u0-CNF-update-test-0.master',
	    '# minimal', 'network=0', 'x11=0', 'audio=0', 'users=');
_setup_file('/lxc/conf/u1-CNF-update-test-1.master',
	    'network=1', 'x11=0', 'audio=1', 'users=1001:u1,1002:u2');
_setup_file('/lxc/conf/u2-CNF-update-test-2.master',
	    'network=2', 'x11=1', 'audio=0', 'users=1002:u2,1003:u3');
_setup_file('/lxc/conf/u3-CNF-update-test-3.master',
	    'network=0', 'x11=1', 'audio=1', 'users=1003:u3,1004:u4');
_setup_file('/lxc/conf/u4-CNF-update-test-4.master',
	    '# minimal', 'network=0', 'x11=0', 'audio=0', 'users=0:root');

$_ = App::LXC::Container::Update->new('update-test-0');
$_->_parse_master();
is($_->{audio}, 0, 'master test 1 audio is correct');
is($_->{network}, 0, 'master test 1 network is correct');
is_deeply([sort keys %{$_->{users}}], [], 'master test 1 users are correct');
is_deeply($_->{users_from}, [], 'master test 1 users have correct origin');
is($_->{x11}, 0, 'master test 1 X11 is correct');

$_ = App::LXC::Container::Update->new('update-test-1');
$_->_parse_master();
is($_->{audio}, 1, 'master test 2 audio is correct');
is($_->{network}, 1, 'master test 2 network is correct');
is($_->{network_from}, 'update-test-1',
   'master test 2 network has correct origin');
is_deeply([sort keys %{$_->{users}}], [1001, 1002],
	  'master test 2 user ids are correct');
is_deeply([sort values %{$_->{users}}], ['u1', 'u2'],
	  'master test 2 users are correct');
is_deeply($_->{users_from}, ['update-test-1'],
	  'master test 2 users have correct origin');
is($_->{x11}, 0, 'master test 2 X11 is correct');