view release on metacpan or  search on metacpan

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

    # 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