view release on metacpan or  search on metacpan

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

	-d $path  and  not -l $path
	    and  fatal('internal_error__1', $path.' is directory in COPY');
	my $target = $self->{root_fs} . '/' . $self->{name} . $path;
	unless (-e $target  or  -l $target)
	{
	    system('cp', '--archive', $path, $target) == 0
		or  error('can_t_copy__1__2', $path, $?);
	}
    }
    $self->_create_mount_points($mounts, $_)
	foreach $mounts->sub_directories($path);
}

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

=head2 B<_make_lxc_path> - create path in LXC directory tree of container

    $self->_make_lxc_path($path);

=head3 parameters:

    $path               the path to be created

=head3 description:

This method creates the given path below the containers LXC directory
(usually C</var/lib/lxc/CONTAINER>).  The path will have the same
permissions as the original one.  If the update is run by root, it will also
have the same ownership as the original one.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _make_lxc_path($$)
{
    my ($self, $path) = @_;
    debug(4, __PACKAGE__, '::_make_lxc_path($self, "', $path, '")');
    local $_ = $path . '/';
    s|(?<=.)/+$||;		# remove trailing / (just to be on the safe side)
    my @paths = ($_);
    unshift @paths, $_  while s|/+(?:[^/]+)$||  and  $_;

    my $root = $self->{root_fs} . '/' . $self->{name};
    -d $root  or  mkdir $root  or  fatal('can_t_create__1__2', $root, $!);
    foreach (@paths)
    {
	-e $_  or  fatal('_1_does_not_exist', $path);
	my $target = $root . $_;
	next if -e $target;
	my $stat = stat($_);
	my ($mode, $uid, $gid) = ($stat->mode, $stat->uid, $stat->gid);
	if (-d)
	{
	    $mode |= 0200;	# prevent blocking ourselves later on
	    if (-l)
	    {
		# links can be arbitrarily deep, so we use make_path on the
		# absolute path and hope for no clashes:
		$target = $root . abs_path($_);
		my $errors = [];
		make_path($target, {chmod => $mode, error => \$errors});
		$errors = join(' ', map { (values(%$_)) } @$errors);
		$errors eq ''
		    or  error('can_t_create__1__2', $target, $errors);
	    }
	    else
	    {
		mkdir $target  or  fatal('can_t_create__1__2', $target, $!);
	    }
	    # There are no standard files known to me meeting condition 2 or
	    # 4 (but not 1 and 3):
	    # uncoverable condition right
	    # uncoverable condition right count:3
	    $uid == 0  or  $gid == 0  or  $mode & 0001  or  $_ eq $path
		or  warning('_1_may_be_inaccessible', $_);
	}
	else
	{
	    open my $f, '>', $target
		or  fatal('can_t_create__1__2', $target, $!);
	    close $f;
	}
	if (-W $target)
	{
	    # ignoring errors as mounting overrules most problems anyway:
	    chmod $mode, $target;
	    chown $uid, $gid, $target;
	}
    }
}

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

=head2 B<_parse_filter> - parse filter configuration file

    $self->_parse_filter();

=head3 description:

This method parses the applicable global special filter meta-configuration
files and those of the chosen container(s) into the configuration object.

Note that in the case of multiple containers the filter configurations are
merged and only the last occurrence of a filter is the one used in the
created LXC configuration file.

=cut

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

    my @special = ('50-default');
    foreach my $container (@special, @{$self->{containers}})
    {
	my $fname = substr($container, 0, 1) . substr($container, -1, 1)
	    . '-NOT-' . $container . '.filter';
	$container =~ m/^\d\d-/  and
	    $fname = (substr($container, 0, 2) . '-NOT-' .
		      substr($container, 3) . '.filter');
	my $path = _ROOT_DIR_ . '/conf/' . $fname;
	open my $in, '<', $path  or  fatal 'can_t_open__1__2', $path, $!;
	local $_;

	while (<$in>)
	{
	    next if m/^\s*(?:#|$)/;
	    s/\s*#.*$//;
	    if (m{^\s*(/\S+)\s+(copy|empty|ignore|nomerge)\s*$})
	    {	$self->{filter}{$1} = $2;   }
	    else
	    {	error 'ignoring_unknown_item_in__1__2', $path, $.;   }
	}
	close $in;
    }
}

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

=head2 B<_parse_master> - parse master configuration file(s)

    $self->_parse_master();

=head3 description:

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

	{   $mounts->mount_point($key, NO_MERGE);   }
	else
	{   fatal 'internal_error__1', 'bad filter value: ' . $_;   }
    }

    ################################
    # part 4c - implicit mounts (from packages) - gather and merge paths of
    # packages (while respecting the filters!):

    foreach my $package (@packages)
    {
	# gather paths of next package:
	foreach (paths_of($package))
	{
	    unless (-e)
	    {
		error('_1_does_not_exist', $_);
		next;
	    }
	    my $state = undef;
	    if (-l)
	    {
		$state = $mounts->mount_point($_);
		$mounts->mount_point($_, IMPLICIT_LINK)  if  $state == UNDEFINED;
		next;
	    }
	    next if -d;
	    $_ =  abs_path($_);		# resolve links in path!
	    $state = $mounts->mount_point($_);
	    if ($state == UNDEFINED)
	    {	$mounts->mount_point($_, IMPLICIT);   }
	}
	# TODO: tune heuristic, put into constant or make configurable:
	$mounts->merge_mount_points(100, 30, 4, 3);
    }

    ################################
    # part 4d - implicit mounts (from packages) - write configuration:
    say $out HEADER_1, 'mounts derived from above packages', HEADER_2;
    say $out $_  foreach  $mounts->implicit_mount_lines('/');

    ################################
    # part 5 - create all mount points:
    my $errors = [];
    $_ = $self->{root_fs} . '/' . $container;
    -d $_  and  remove_tree($_, {error => \$errors, safe => 1});
    $errors = join(' ', map { (values(%$_)) } @$errors);
    $errors eq ''  or  error('can_t_remove__1__2', $_, $errors);
    $self->_create_mount_points($mounts, '/');

    ################################
    # part 6 - create all empty files:
    foreach (@{$self->{empty_files}})
    {
	$_ = $self->{root_fs} . '/' . $container . $_;
	# As we just deleted the whole tree we can't create a test for a
	# failed empty file here:
	# uncoverable branch true
	open my $empty, '>', $_  or  fatal 'can_t_open__1__2', $_, $!;
	close $empty;
	chmod 0600, $_;
    }

    close $out;
}

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

1;

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

=head1 SEE ALSO

man pages C<lxc.container.conf>, C<lxc> and C<lxcfs>

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