App-LXC-Container
view release on metacpan or search on metacpan
lib/App/LXC/Container/Run.pm view on Meta::CPAN
#########################################################################
#
# internal constants and data:
use constant _ROOT_DIR_ => $ENV{HOME} . '/.lxc-configuration';
our @CARP_NOT = (substr(__PACKAGE__, 0, rindex(__PACKAGE__, "::")));
#########################################################################
#########################################################################
=head1 MAIN METHODS
The module defines the following main methods which are used by
L<App::LXC::Container>:
=cut
#########################################################################
=head2 B<new> - create configuration object for application container
$configuration =
App::LXC::Container::Run->new($container, $user, $dir, @command);
=head3 parameters:
$container name of the container to be run
$user name of the user running the command
$dir name of the start directory for the command
@command the command to be run itself
=head3 description:
This is the constructor for the object used to run the LXC application
container of the given name as the given user using the given command. It
reads and checks the configuration, but does not yet run any external
programs.
=head3 returns:
the configuration object for the application container
=cut
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub new($$$$@)
{
my $class = shift;
$class eq __PACKAGE__ or fatal 'bad_call_to__1', __PACKAGE__ . '->new';
debug(1, __PACKAGE__, '::new("', join('", "', @_), '")');
my $container = shift;
my $user = shift;
my $dir = shift;
my %configuration = (audio => '-',
command => [@_],
dir => $dir,
gateway => '',
gids => [],
init => '/initialisation/script/is/undefined',
ip => '',
mounts => {},
name => $container,
network => 0,
network_type => 'N',
rc => _ROOT_DIR_ . '/' . $container . '.conf',
root => 'root/of/container/not/found',
running => 0,
uids => [],
user => $user,
x11 => '-');
my $self = bless \%configuration, $class;
-e _ROOT_DIR_ or fatal 'link_to_root_missing';
-l _ROOT_DIR_ or fatal '_1_is_not_a_symbolic_link' , _ROOT_DIR_;
open my $in, '<', $self->{rc} or fatal 'can_t_open__1__2', $self->{rc}, $!;
my $found = 0;
while (<$in>)
{
if (m/^\s*#\s*MASTER\s*:\s*([GLN])(\d+)?\s*,\s*([-X])\s*,\s*([-A])\s*$/)
{
if ($1 ne 'N')
{
defined $2 or fatal 'bad_master__1', $1 . ',' . $3 . ',' . $4;
$2 > 1 or fatal 'bad_master__1', $1 . $2;
$self->{network_type} = $1;
$self->{network} = $2;
}
$self->{x11} = $3;
$self->{audio} = $4;
$found = 1;
}
elsif (m|^\s*lxc\.rootfs\.path\s*=\s*(/\S+)\s*$|)
{
$_ = $self->{root} = abs_path($1);
-d $_ or fatal 'missing_directory__1', $_;
m|^/\w+/| or fatal 'bad_directory__1', $_;
$self->{init} = $_ . '/lxc-run.sh';
}
elsif (m|^\s*lxc\.net\.0\.ipv4\.address\s*=\s*(\d[.0-9]+)/\d+\s*$|)
{
$self->{ip} = $1;
$_ = $self->{network};
$self->{ip} =~ m/\.$_$/
or fatal 'bad_master__1', $self->{ip} . ' (!~ ' . $_ . '$)';
$_ = $self->{ip};
s/\.\d+$/.1/;
$self->{gateway} = $_;
}
elsif (m|^\s*lxc\.idmap\s*=\s*u\s+(\d+)\s+\1\s+1$|)
{
push @{$self->{uids}}, $1 if $1 > 0;
}
elsif (m|^\s*lxc\.idmap\s*=\s*g\s+(\d+)\s+\1\s+1$|)
{
push @{$self->{gids}}, $1 if $1 > 0;
}
elsif (m|^\s*lxc\.mount\.entry\s*=\s*(/\S+)\s|)
{
$self->{mounts}{$1} = 1;
}
}
close $in;
$found == 1 or fatal 'bad_master__1', '???';
return $self;
}
#########################################################################
=head2 B<main> - run LXC application container
$configuration->main();
=head3 description:
This method runs the container or attaches to it, if it's already running.
In addition it creates the container's start-up script C</lxc-run.sh>, if
one is needed. It also sets up the C<L<nft>> packet filtering if a local
network is required.
=cut
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub main($)
{
my $self = shift;
debug(1, __PACKAGE__, '::main($self)');
$self->_check_running();
$self->{network_type} eq 'L' and $self->_local_net();
$self->_write_init_sh();
# TODO: Do we need account files when only using root?
# $self->{user} ne 'root' and
$self->_prepare_user();
$self->_run();
}
#########################################################################
#########################################################################
=head1 HELPER METHODS
The following methods should not be used outside of this module itself:
=cut
#########################################################################
=head2 B<_check_running> - check if container is already running
$self->_check_running();
=head3 description:
This method checks if the container is already running (and we just need to
lib/App/LXC/Container/Run.pm view on Meta::CPAN
debug(3, "adding jump to 'localfilter' in nftables");
system(NFT_JUMP) == 0
or fatal('nft_error__1__2', join(' ', NFT_JUMP), $?);
}
unless ($has_ip)
{
debug(3, 'adding IP address ', $self->{ip},
" to 'localfilter' in nftables");
system(NFT_IP, $self->{ip}, 'reject') == 0
or fatal('nft_error__1__2',
join(' ', NFT_IP, $self->{ip}, 'reject'), $?);
}
}
#########################################################################
=head2 B<_prepare_user> - prepare selected user
$self->_prepare_user();
=head3 description:
This method prepares the container to be able to switch to the selected user
by creating minimal C</etc/passwd> / C</etc/shadow> and C</etc/group> /
C</etc/gshadow> files for the user, unless the ones from the host are used.
=cut
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
our $_root_etc = '/etc/'; # variable for unit tests only
sub _prepare_user($)
{
my $self = shift;
debug(2, __PACKAGE__, '::_prepare_user($self)');
if ($self->{mounts}{'/etc'})
{ debug(3, 'using user/groups from host (/etc)'); }
else
{
use constant ACCOUNT_FILES => (qw(group gshadow passwd shadow));
use constant ACCOUNT_FILES_STR => join(' ', ACCOUNT_FILES);
local $_;
my $mapped = 0;
foreach (ACCOUNT_FILES)
{ $self->{mounts}{'/etc/'.$_} and $mapped++; }
if ($mapped == 4)
{ debug(3, 'using user/groups from host (/etc/<all 4 files>)'); }
elsif ($mapped > 0)
{ error('broken_user_mapping__1', ACCOUNT_FILES_STR); }
else
{
my $lxc_etc = $self->{root} . '/etc/';
my $re_ids = $self->{user};
# TODO: Should we distinguish UIDs/GIDs? For now we just simply
# add them all. This has the charm that files of other users
# within the same group will be visible with their names in
# directory listings. The disadvantage is making them known by
# name (but the password hashes are always safe):
foreach (@{$self->{uids}}, @{$self->{gids}})
{ $re_ids .= '|' . $_; }
foreach (ACCOUNT_FILES)
{
# remove first to be sure not to overwrite something linked:
if (-f $lxc_etc . $_)
{
unlink $lxc_etc . $_
or fatal 'can_t_remove__1__2', $lxc_etc . $_, $!;
}
open my $in, '<', $_root_etc . $_
or fatal 'can_t_open__1__2', $_root_etc . $_, $!;
open my $out, '>', $lxc_etc . $_
or fatal 'can_t_open__1__2', $lxc_etc . $_, $!;
while (<$in>)
{
next unless m/(?:^|[:,])(?:$re_ids|root)(?:[:,]|$)/;
# If applicable, remove the encrypted password, as it's
# not needed inside of the container:
s/^([^:]+):([^!:*][^:*][^:]+):/$1:!:/;
print $out $_;
}
close $out;
close $in;
}
}
}
}
#########################################################################
=head2 B<_run> - run command in container
$self->_run();
=head3 description:
This method attaches to the container, if it's already running. Otherwise
it starts it. In either case it runs the previously (C<L<_write_init_sh>>)
created initialisation script C</lxc-run.sh> inside of it.
=cut
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _run($)
{
my $self = shift;
debug(2, __PACKAGE__, '::_run($self)');
if ($self->{running})
{
# system instead of exec as Devel::Cover has problems with exec
debug(3, 'attaching LXC application container ', $self->{name});
0 == system(
'lxc-attach', '--rcfile', $self->{rc},
'--name', $self->{name}, '--', '/lxc-run.sh')
or fatal('call_failed__1__2', 'lxc-attach', $!);
}
else
{
debug(3, 'starting LXC application container ', $self->{name});
lib/App/LXC/Container/Run.pm view on Meta::CPAN
# 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);
=head3 description:
This method writes an X11 authority file for the container and the user it
is run (including attached) for. It is used when the container is started
or attached and an X11 display using the environment variable C<XAUTHORITY>
exists (within C<_write_init_sh> above). The method returns the path to the
created X11 authority file as it is used inside of the container.
Note that each user needs its own writable directory for the lock-file.
=cut
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _write_xauthority($$)
{
my ($self, $display) = @_;
debug(4, __PACKAGE__, '::_write_xauthority($self)');
local $_ = '/.xauth-' . $self->{user};
my $container_path = $_ . '/.Xauthority';
my $xauth_dir = $self->{root} . $_;
-d $xauth_dir
or mkdir $xauth_dir, 0700
or fatal('can_t_create__1__2', $xauth_dir, $!);
my $xauth = $xauth_dir . '/.Xauthority';
unless (-f $xauth)
{
my @entries = `xauth list`;
my $name = $self->{name};
my $entry = undef;
foreach (@entries)
{
if (s|^[^/]+(?=/[^:]+$display)|$name|)
{ $entry = $_; }
}
defined $entry
or fatal('call_failed__1__2',
'xauth list', 'no ' . $display);
debug(4, 'Xauthority entry is: ', $entry);
my $xauth_add = 'xauth -b -f ' . $xauth . ' add ' . $entry;
system($xauth_add) == 0
or fatal('call_failed__1__2', $xauth_add, $?);
if ($self->{user} ne 'root')
{
my ($uid, $gid) = (getpwnam($self->{user}))[2..3];
chown $uid, $gid, $xauth_dir, $xauth;
}
}
return $container_path;
}
#########################################################################
1;
#########################################################################
#########################################################################
=head1 SEE ALSO
man pages C<lxc-execute>, C<lxc-attach>, C<lxc.container.conf> and C<nft>
LXC documentation on L<https://linuxcontainers.org>
=head1 LICENSE
Copyright (C) Thomas Dorner.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See LICENSE file for more details.
=head1 AUTHOR
Thomas Dorner E<lt>dorner (at) cpan (dot) orgE<gt>
=head2 Contributors
none so far
=cut
( run in 2.891 seconds using v1.01-cache-2.11-cpan-ceb78f64989 )