view release on metacpan or  search on metacpan

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

	    push @todo, '', '# PipeWire / PulseAudio:',
		'export PULSE_SERVER=' . $self->{gateway};
	}

	if ($self->{x11} eq 'X'  and  defined $ENV{DISPLAY})
	{
	    my $display = $ENV{DISPLAY};
	    debug(3, 'DISPLAY is ', $display);
	    push @todo, '', '# X11:', 'export DISPLAY=' . $display;
	    # We must pass the X11-authority for the correct display here:
	    if (defined $ENV{XAUTHORITY})
	    {
		my $container_path = $self->_write_xauthority($display);
		push @todo, 'export XAUTHORITY=' . $container_path;
	    }
	}
    }

    # next to last build command:
    push @todo, '', '# run command:', 'cd "' . $self->{dir} . '"';
    my @command = @{$self->{command}};
    @command > 0  or  @command = (SHELL);
    my $cmd = shift @command;
    $cmd =~ m/'/  and  fatal 'can_t_run_with__1__2', $cmd, "'";
    local $_;
    foreach (@command)
    {
	if (! m/'/)
	{   $_ = "'$_'";   }
	elsif (! m/"/)
	{   $_ = '"' . $_ . '"';   }
	else
	{   fatal 'can_t_run_with__1__2', $_, "'\"";   }
    }
    if ($self->{user} ne 'root')
    {
	if ($cmd eq SHELL)
	{   @command = ('su', $self->{user}, '-s', SHELL);   }
	elsif (0 == @command)
	{   @command = ('su', $self->{user}, '-s', SHELL, '-c', "'$cmd'");   }
	else
	{
	    # su with command parameters is a bit tricky, but the following
	    # should do the job:
	    $cmd .= ' "$@"';	# a literal $@ in the command line itself
	    unshift @command,
		'su', $self->{user}, '-s', SHELL, '-c', "'$cmd'",
		'--', 'dummy_argv0';
	}
    }
    else
    {   unshift @command, "'$cmd'";   }
    debug(4, 'command is "exec', join(' ', @command), '"');
    push @todo, join(' ', 'exec', @command);

    # finally write startup script:
    open my $f, '>', $self->{init}
	or  fatal 'can_t_open__1__2', $self->{init}, $!;
    say $f $_ foreach @todo;
    close $f;
    # 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;
}