view release on metacpan or  search on metacpan

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

=cut

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

=head2 B<new> - create configuration object for application container

    $configuration =
        App::LXC::Container::Run->new($container, $user, $dir, @command);

=head3 parameters:

    $container          name of the container to be run
    $user               name of the user running the command
    $dir                name of the start directory for the command
    @command            the command to be run itself

=head3 description:

This is the constructor for the object used to run the LXC application
container of the given name as the given user using the given command.  It
reads and checks the configuration, but does not yet run any external
programs.

=head3 returns:

the configuration object for the application container

=cut

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

sub new($$$$@)
{
    my $class = shift;
    $class eq __PACKAGE__  or  fatal 'bad_call_to__1', __PACKAGE__ . '->new';
    debug(1, __PACKAGE__, '::new("', join('", "', @_), '")');
    my $container = shift;
    my $user = shift;
    my $dir = shift;

    my %configuration = (audio => '-',
			 command => [@_],
			 dir => $dir,
			 gateway => '',
			 gids => [],
			 init => '/initialisation/script/is/undefined',
			 ip => '',
			 mounts => {},
			 name => $container,
			 network => 0,
			 network_type => 'N',
			 rc => _ROOT_DIR_ . '/' . $container . '.conf',
			 root => 'root/of/container/not/found',
			 running => 0,
			 uids => [],
			 user => $user,
			 x11 => '-');
    my $self = bless \%configuration, $class;
    -e _ROOT_DIR_  or  fatal 'link_to_root_missing';
    -l _ROOT_DIR_  or  fatal '_1_is_not_a_symbolic_link' , _ROOT_DIR_;

    open my $in, '<', $self->{rc}  or  fatal 'can_t_open__1__2', $self->{rc}, $!;
    my $found = 0;
    while (<$in>)
    {
	if (m/^\s*#\s*MASTER\s*:\s*([GLN])(\d+)?\s*,\s*([-X])\s*,\s*([-A])\s*$/)
	{
	    if ($1 ne 'N')
	    {
		defined $2  or  fatal 'bad_master__1', $1 . ',' . $3 . ',' . $4;
		$2 > 1  or  fatal 'bad_master__1', $1 . $2;
		$self->{network_type} = $1;
		$self->{network} = $2;
	    }
	    $self->{x11} = $3;
	    $self->{audio} = $4;
	    $found = 1;
	}
	elsif (m|^\s*lxc\.rootfs\.path\s*=\s*(/\S+)\s*$|)
	{
	    $_ = $self->{root} = abs_path($1);
	    -d $_  or  fatal 'missing_directory__1', $_;
	    m|^/\w+/|  or  fatal 'bad_directory__1', $_;
	    $self->{init} = $_ . '/lxc-run.sh';
	}
	elsif (m|^\s*lxc\.net\.0\.ipv4\.address\s*=\s*(\d[.0-9]+)/\d+\s*$|)
	{
	    $self->{ip} = $1;
	    $_ = $self->{network};
	    $self->{ip} =~ m/\.$_$/
		or  fatal 'bad_master__1', $self->{ip} . ' (!~ ' . $_ . '$)';
	    $_ = $self->{ip};
	    s/\.\d+$/.1/;
	    $self->{gateway} = $_;
	}
	elsif (m|^\s*lxc\.idmap\s*=\s*u\s+(\d+)\s+\1\s+1$|)
	{
	    push @{$self->{uids}}, $1  if  $1 > 0;
	}
	elsif (m|^\s*lxc\.idmap\s*=\s*g\s+(\d+)\s+\1\s+1$|)
	{
	    push @{$self->{gids}}, $1  if  $1 > 0;
	}
	elsif (m|^\s*lxc\.mount\.entry\s*=\s*(/\S+)\s|)
	{
	    $self->{mounts}{$1} = 1;
	}
    }
    close $in;
    $found == 1  or  fatal 'bad_master__1', '???';

    return $self;
}

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

=head2 B<main> - run LXC application container

    $configuration->main();