view release on metacpan or  search on metacpan

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

=head2 B<new> - create object to manage mount-points

    $mounts = App::LXC::Container::Mounts->new();

=head3 description:

This is the constructor for the object used to manage the possible
mount-poins and directories of an LXC application container.

=head3 returns:

the management object

=cut

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

sub new($)
{
    my $class = shift;
    $class eq __PACKAGE__  or  fatal 'bad_call_to__1', __PACKAGE__ . '->new';
    debug(2, __PACKAGE__, '::new()');

    my $object = {'/' => [NO_MERGE, {}]}; # [ state, sub-directory counters ]
    return bless $object, $class;
}

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

=head2 B<implicit_mount_lines> - get list of implicit mount-lines for path

    say $out $_  foreach  $mounts->implicit_mount_lines('/');

=head3 parameters:

    $path               root path

=head3 description:

This method (recursively) returns a list of mount-lines for the LXC
configuration.  It returns all implicit mount-points below (including) the
given path.

=head3 returns:

list of implicit mount-lines for path

=cut

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

sub implicit_mount_lines($$)
{
    my ($self, $path) = @_;
    my @mount_lines = ();
    if ($self->mount_point($path) == IMPLICIT)
    {
	push @mount_lines,
	    'lxc.mount.entry = ' . $path . ' ' . substr($path, 1) .
	    ' none create=' . (-d $path ? 'dir' : 'file') . ',ro,bind 0 0';
    }
    local $_;
    foreach ($self->sub_directories($path))
    {	push @mount_lines, $self->implicit_mount_lines($_);   }
    return @mount_lines;
}

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

=head2 B<merge_mount_points> - merge mount-points

    $mounts->merge_mount_points($limit2, $limit3, $limit4, $limit5);

=head3 parameters:

    $limitN             heuristic limit for depth N used for the merge decision

=head3 description:

This method merges all IMPLICIT mount-points gathered so far.  The heuristic
limits are the maximum number of children a directory of the corresponding
depth may have as separate mount-points.

=cut

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

sub merge_mount_points($$$$$)
{
    my ($self, $limit2, $limit3, $limit4, $limit5) = @_;

    # merge child mount-points into one mount-point of parent, if reasonable:
    local $_;
    foreach (sort _depth_sort keys %{$self})
    {
	next if -f $_;		# Existing files can't have children!

	# Children of entries with these states never may be merged:
	my $state = $self->mount_point($_);
	next if $state == EXPLICIT  or  $state == IGNORE  or  $state == NO_MERGE;

	# Never merge single children:
	my @children = keys %{$self->{$_}[1]};
	my $childs = @children;
	next if $childs <= 1;

	# The nearer the root, the more children are needed to allow a merge:
	my $depth = _depth_of($_);
	next if $depth < 2;
	my $limit = ($depth == 2 ? $limit2 :
		     $depth == 3 ? $limit3 :
		     $depth == 4 ? $limit4 : $limit5);
	next unless $childs >= $limit;

	# Finally we only merge children of undefined entries:
	if ($state == UNDEFINED)
	{
	    debug(4, __PACKAGE__,
		  '::merge_mount_points: merging ', $childs, ' into ', $_);
	    $self->mount_point($_, IMPLICIT);