view release on metacpan or  search on metacpan

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

package App::LXC::Container::Mounts;

# Author, Copyright and License: see end of file

=head1 NAME

App::LXC::Container::Mounts - manage mount-points for LXC container configuration

=head1 SYNOPSIS

    use App::LXC::Container::Mounts;
    my $mounts = App::LXC::Container::Mounts->new();
    $mounts->mount_point($path, EXPLICIT);
    if ($mounts->mount_point($path) == IMPLICIT) { ... }
    $mounts->mount_point($path, REMOVE);

    $mounts->merge_mount_points(12);
    ... foreach $mounts->sub_directories($path);

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

=head1 ABSTRACT

This module is used by L<App::LXC::Container::Update> to manage the
(possible) mount-points of a container that is updated.

=head1 DESCRIPTION

The module handles all kinds of mount-points of an LXC container
configuration created (and maybe destroyed again) during the update of an
LXC container.

=cut

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

use v5.14;
use strictures;
no indirect 'fatal';
no multidimensional;
use warnings 'once';

our $VERSION = "0.41";

use Cwd 'abs_path';

use App::LXC::Container::Texts;

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

=head1 EXPORT

All access functions are exported by default as that's the point of this
module.

=cut

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

require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(REMOVE
		 UNDEFINED
		 IGNORE
		 NO_MERGE
		 EMPTY
		 COPY
		 EXPLICIT
		 IMPLICIT
		 IMPLICIT_LINK
	       );

# possible states of a possible mount-point or directory above it:
use constant REMOVE => -1;
use constant UNDEFINED => 0;
use constant IGNORE => 1;
use constant NO_MERGE => 2;
use constant EMPTY => 3;
use constant COPY => 4;
use constant EXPLICIT => 5;
use constant IMPLICIT => 6;
use constant IMPLICIT_LINK => 7; # an optional copy that may be merged away

#########################################################################
#
# internal constants and data:

our @CARP_NOT = (substr(__PACKAGE__, 0, rindex(__PACKAGE__, "::")));

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

=head1 MAIN METHODS

The module defines the following main methods which are used by
L<App::LXC::Container>:

=cut

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

=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: