view release on metacpan or  search on metacpan

lib/App/LXC/Container/Run.pm  view on Meta::CPAN

		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});
	my $rc = system(
			'lxc-execute', '--rcfile', $self->{rc},
			'--name', $self->{name}, '--', '/lxc-run.sh');
	my $err = $!;
	# remove all .Xauthority files in container (the credentials may
	# change before the next run):
	local $_;
	foreach (glob($self->{root} . '/.xauth-*/.Xauthority'))
	{
	    unlink $_  or  error 'can_t_remove__1__2', $_, $!;
	}
	0 == $rc  or  fatal('call_failed__1__2', 'lxc-execute', $err);
    }
}

#########################################################################

=head2 B<_write_init_sh> - write startup script for container

    $self->_write_init_sh();

=head3 description:

This method writes the startup script C</lxc-run.sh>.  It is used when the
container is started or attached to set up the initial configuration of the
container and to run the requested command (or the interactive shell
C</bin/sh>, if none is specified).

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _write_init_sh($)
{
    my $self = shift;
    debug(2, __PACKAGE__, '::_write_init_sh($self)');

    use constant SHELL => '/bin/sh';
    my @todo = ('#!' . SHELL);

    if ($self->{running})
    {
	push @todo, '', '# PipeWire / PulseAudio:',
	    'export PULSE_SERVER=' . $self->{gateway}
	    if $self->{audio} eq 'A';
	if ($self->{x11} eq 'X'  and  defined $ENV{DISPLAY})
	{
	    my $display = $ENV{DISPLAY};
	    push @todo, '', '# X11:', 'export DISPLAY=' . $display;
	    if (defined $ENV{XAUTHORITY})
	    {
		my $container_path = $self->_write_xauthority($display);
		push @todo, 'export XAUTHORITY=' . $container_path;
	    }
	}
    }
    else
    {
	# network needs gateway and DNS:
	if ($self->{network_type} ne 'N')
	{
	    debug(3, 'gateway is ', $self->{gateway});
	    push @todo,
		'',
		'# set-up network via lxc bridge:',
		'gateway=' . $self->{gateway},