view release on metacpan or  search on metacpan

lib/Linux/LXC.pm  view on Meta::CPAN

	my ($this) = @_;
	if (!$this->_get_template()) {
		my $utsname = $this->get_utsname();
		croak "Template is not provided for '$utsname' container.";
	}
	$this->_get_template();
}

sub is_existing {
	my ($this) = @_;
	my $name = $this->get_utsname();
	grep {/^$name$/} get_existing_containers();
}

sub is_running {
	my ($this) = @_;
	my $name = $this->get_utsname();
	grep {/^$name$/} get_running_containers();
}

sub is_stopped {
	my ($this) = @_;
	my $name = $this->get_utsname();
	grep {/^$name$/} get_stopped_containers();
}

sub put {
	my ($this, $input, $dest_from_container_root) = @_;
	# id map configuration attribute name changes between LXC version 2 and 3… Purpose of $idmap_label variable is to
	# take care of it.
	my $idmap_label = $this->get_version() =~ /^2/
		? 'lxc.id_map'
		: 'lxc.idmap';
	my ($uid) = $this->get_config($idmap_label, qr/^u 0 (\d+)/, ALLOW_UNDEF);
	$this->_check_container_is_existing();
	if (!-r $input) {
		croak "Input $input is not readable";
	}
	if ($dest_from_container_root !~ /^\//) {
		croak 'Destination should be an absolute path';
	}
	my $container_root = $this->get_lxc_path() . '/rootfs';
	my ($dir_dest) = $dest_from_container_root =~ /^(.*\/)/;
	# He have to use a transit folder and to use chroot for being able to correctly resolve symlinks.
	$Backticks::autodie = 0;
	`test -e $container_root/tmp/lxc-transit && rm -rf $container_root/tmp/lxc-transit`;
	$Backticks::autodie = 1;
	`cp -R $input $container_root/tmp/lxc-transit`;
	# Here, we are creating all folder path in which we want to copy the $input.
	my @folders = split(/\//, $dir_dest);
	shift @folders;
	my $abs_folder = '';
	while (my $cur_folder = shift @folders) {
		$abs_folder .= '/' . $cur_folder;
		# If the current folder is not existing or if it is not a symlink, we create it.
		if (!$this->_check_folder_existence($container_root, $abs_folder)) {
			`chroot $container_root mkdir $abs_folder`;
			# This instruction is the cause we can not simply use a `mkdir -p` command for creating the path: we need
			# to set the good rights to folder in order to copy it.
			# Note: we set right only if we have to create the folder, for avoiding to create too much mess.
			`chroot $container_root chown $uid:$uid $abs_folder` if (defined $uid);
		}
	}
	`chroot $container_root mv /tmp/lxc-transit $dest_from_container_root`;
	`chroot $container_root chown -R $uid:$uid $dest_from_container_root` if defined $uid;
}

sub del_config {
	my ($this, $attr, $filter) = @_;
	if (defined $filter and ref($filter) ne 'Regexp') {
		croak '$filter should be a regular expression';
	}
	$filter //= qr/(.*)/;
	open my $CONF_R, '<', $this->get_lxc_path() . '/config';
	my $CONF_W = new File::Temp();
	my $entries_deleted = 0;
	for (<$CONF_R>) {
		if (/^$attr\W*=\W*(?P<value>.*)$/) {
			if ($+{value} =~ $filter) {
				$entries_deleted++;
				next;
			}
		}
		print $CONF_W $_;
	}
	close $CONF_W;
	move ($CONF_W->filename, $this->get_lxc_path() . '/config') or die ($!);
	return $entries_deleted;
}

sub set_config {
	my ($this, $attr, $value, $flags) = @_;
	$flags = ERASING_MODE unless defined $flags;
	croak 'set_config can not be in erasing and addition mode'
		if ($flags == (ERASING_MODE | ADDITION_MODE));
	$this->_check_container_is_existing();
	if ($flags & ADDITION_MODE) {
		open my $CONF, '>>', $this->get_lxc_path() . '/config';
		print $CONF "$attr = $value\n";
	} else {
		my $written = 0;
		open my $CONF_R, '<', $this->get_lxc_path().'/config';
		my $CONF_W = File::Temp->new();
		for (<$CONF_R>) {
			if (/^$attr = .*$/) {
				print $CONF_W "$attr = $value\n";
				$written = 1;
			} else {
				print $CONF_W $_;
			}
		}
		!$written and print $CONF_W "$attr = $value\n";
		close $CONF_R;
		close $CONF_W;
		move ($CONF_W->filename, $this->get_lxc_path().'/config') or die ($!);
	}
}

sub start {
	my ($this) = @_;
	my $utsname = $this->get_utsname();
	$this->_check_container_is_existing();
	if ($this->is_running()) {
		return;
	}