view release on metacpan or  search on metacpan

t/03-setup.t  view on Meta::CPAN

my @big_stat = (scalar(@input), length($re_output));

#########################################################################
# now check configuration created by above monster-test:
check_config_against_regexp
    ('tt-CNF-test.master', '3rd',
     qr{^network=1\nx11=1\naudio=1\nusers=$re_user$}m);
check_config_against_regexp
    ('tt-MNT-test.mounts', '3rd',
     qr{\A\#\ mounts\ for\ container\ test$
	.*/t/tmp/usr/bin/2something$
	.*/t/tmp/usr/bin/2something\s+create=file,rw\s+tmpfs$
	.*/t/tmp/usr/bin/2something\s+create=file,rw,bind$}msx);
check_config_against_regexp
    ('tt-NOT-test.filter', '3rd',
     qr{^/var/log\s+empty\n
	.*/t/tmp/usr/bin/2something\s+copy\n
	.*/t/tmp/usr/bin/2something\s+nomerge\n
	.*/t/tmp/usr/bin/2something\s+ignore\n}mx);
check_config_against_regexp
    ('tt-PKG-test.packages', '3rd',
     qr{\A# package list for container test\n.*^chromium\n\Z}ms);

#########################################################################
# 4th round: read modified configuration again:

@input = qw(1 7);
$re_output =
    $re_main_window .
    $re_main_box .
    '$';
output_like
{   _call_with_stdin(\@input, sub { App::LXC::Container::setup("test"); });   }
    qr{$re_output}ms,
    qr{$re_error_to_small},
    'reading modified configuration again did not cause any errors';

#########################################################################
# simulate invalid configuration entries and other fatal errors:
eval {   App::LXC::Container::Setup::_mark2filter('XX /bad-entry');   };
like($@,
     qr/^INTERNAL ERROR [^:]+: bad mark 'XX' in _mark2filter$re_msg_tail/,
     'bad filter entry fails');

eval {   App::LXC::Container::Setup::_mark2mount('YY /bad-entry');   };
like($@,
     qr/^INTERNAL ERROR [^:]+: bad mark 'YY' in _mark2mount$re_msg_tail/,
     'bad mount entry fails');

eval {   App::LXC::Container::Setup::_modify_entry(1,2,3, 1,2);   };
like($@,
     qr/^INTERNAL ERROR [^:]+: uneven list in _modify_entry$re_msg_tail/,
     'short parameter list for _modify_entry fails');
eval {   App::LXC::Container::Setup::_modify_entry(1,2,3, 1,2,3,4,5);   };
like($@,
     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');
test_not_accessible('ne-MNT-not-accessible.mounts');
test_not_accessible('ne-PKG-not-accessible.packages');

$dummy_obj = {name => 'bad'};
sub test_bad_config($@)
{
    my $file = shift;
    my $short_path = '/lxc/conf/' . $file;
    _remove_file($short_path);
    _setup_file($short_path, @_);
    my $re = "ignoring unknown configuration item in '" . LXC_LINK .
	'/conf/' . $file . "'" . ', line 1' . $re_msg_tail_eval;
    (my $func = $file) =~ s/^.*\.//;
    $func = 'App::LXC::Container::Setup::_parse_' . $func . '($dummy_obj);';
    output_like
    {	eval "$func";   }
    qr{^$}, qr/^$re$/,
    'reading bad configuration file ' . $file . ' fails';
}
test_bad_config('bd-NOT-bad.filter', 'bad entry');
test_bad_config('bd-CNF-bad.master', 'bad entry');
test_bad_config('bd-MNT-bad.mounts', 'bad-entry ');
test_bad_config('bd-PKG-bad.packages', 'bad entry');

#########################################################################
# simulate some more valid configuration entries:
like(App::LXC::Container::Setup::_mark2mount('RW /dev/disk'),
     qr{^/dev/disk\s+create=dir,rw,bind,optional$},
     'valid optional device directory');
like(App::LXC::Container::Setup::_mark2mount('RW /dev/somedevice'),
     qr{^/dev/somedevice\s+create=file,rw,bind,optional$},
     'valid optional device file');
like(App::LXC::Container::Setup::_mark2mount('OV /'),
     qr{^/\s+create=dir,rw\s+tmpfs$},
     'valid temporary directory');

#########################################################################
# run tests with other maximum screen sizes:
sub test_other_screen_size($$)
{
    my ($w, $h) = @_;
    my %dummy_obj = (MAIN_UI => UI::Various::Main->new(),
		     name => 'x', packages => [], mounts => [], filter => [],
		     network => 0, x11 => 0, audio => 0, users => []);
    # Unfortunately we need to access UI::Various internal structure here to
    # modify the maximum size of the virtual screen:
    $dummy_obj{MAIN_UI}{max_width} = $w;
    $dummy_obj{MAIN_UI}{max_height} = $h;
    return bless \%dummy_obj, 'App::LXC::Container::Setup';
};
output_like
{
    my $dummy_obj = test_other_screen_size(12, 99);
    App::LXC::Container::Setup::_create_main_window($dummy_obj);
}
    qr{^$}, qr{^$re_error_to_small},
    'narrow window causes error';
output_like
{
    my $dummy_obj = test_other_screen_size(99, 24);
    App::LXC::Container::Setup::_create_main_window($dummy_obj);
}