[pve-common.git] / src / PVE / CGroup.pm

# cgroup handler
#
# This package should deal with figuring out the right cgroup path for a
# container (via the command socket), reading and writing cgroup values, and
# handling cgroup v1 & v2 differences.
#
# Note that the long term plan is to have resource manage functions instead of
# dealing with cgroup files on the outside.

package PVE::CGroup;

use strict;
use warnings;

use IO::File;
use IO::Select;
use POSIX qw();

use PVE::ProcFSTools;
use PVE::Tools qw(
    file_get_contents
    file_read_firstline
);

# We don't want to do a command socket round trip for every cgroup read/write,
# so any cgroup function needs to have the container's path cached, so this
# package has to be instantiated.
#
# LXC keeps separate paths by controller (although they're normally all the
# same, in our # case anyway), so we cache them by controller as well.
sub new {
    my ($class, $vmid) = @_;

    my $self = { vmid => $vmid };

    return bless $self, $class;
}

# Get the v1 controller list.
#
# Returns a set (hash mapping names to `1`) of cgroupv1 controllers, and an
# optional boolean whether a unified (cgroupv2) hierarchy exists.
#
# Deprecated: Use `get_cgroup_controllers()` instead.
sub get_v1_controllers {
    my $v1 = {};
    my $v2 = 0;
    my $data = PVE::Tools::file_get_contents('/proc/self/cgroup');
    while ($data =~ /^\d+:([^:\n]*):.*$/gm) {
	my $type = $1;
	if (length($type)) {
	    $v1->{$_} = 1 foreach split(/,/, $type);
	} else {
	    $v2 = 1;
	}
    }
    return wantarray ? ($v1, $v2) : $v1;
}

# Get the set v2 controller list from the `cgroup.controllers` file.
my sub get_v2_controllers {
    my $v2 = eval { file_get_contents('/sys/fs/cgroup/cgroup.controllers') }
	|| eval { file_get_contents('/sys/fs/cgroup/unified/cgroup.controllers') };
    return undef if !defined $v2;

    # It's a simple space separated list:
    return { map { $_ => 1 } split(/\s+/, $v2) };
}

my $CGROUP_CONTROLLERS = undef;
# Get a list of controllers enabled in each cgroup subsystem.
#
# This is a more complete version of `PVE::LXC::get_cgroup_subsystems`.
#
# Returns 2 sets (hashes mapping controller names to `1`), one for each cgroup
# version.
sub get_cgroup_controllers() {
    if (!defined($CGROUP_CONTROLLERS)) {
	my ($v1, undef) = get_v1_controllers();
	my $v2 = get_v2_controllers();

	$CGROUP_CONTROLLERS = [$v1, $v2];
    }

    return $CGROUP_CONTROLLERS->@*;
}

my $CGROUP_MODE = undef;
# Figure out which cgroup mode we're operating under:
#
# Returns 1 if cgroupv1 controllers exist (hybrid or legacy mode), and 2 in a
# cgroupv2-only environment.
#
# NOTE: To fully support a hybrid layout it is better to use functions like
# `cpuset_controller_path`.
#
# This is a function, not a method!
sub cgroup_mode() {
    if (!defined($CGROUP_MODE)) {
	my ($v1, $v2) = get_cgroup_controllers();
	if (keys %$v1) {
	    # hybrid or legacy mode
	    $CGROUP_MODE = 1;
	} elsif ($v2) {
	    $CGROUP_MODE = 2;
	}
    }

    die "unknown cgroup mode\n" if !defined($CGROUP_MODE);
    return $CGROUP_MODE;
}

my $CGROUPV2_PATH = undef;
sub cgroupv2_base_path() {
    if (!defined($CGROUPV2_PATH)) {
	if (cgroup_mode() == 2) {
	    $CGROUPV2_PATH = '/sys/fs/cgroup';
	} else {
	    $CGROUPV2_PATH = '/sys/fs/cgroup/unified';
	}
    }
    return $CGROUPV2_PATH;
}

# Find a cgroup controller and return its path and version.
#
# LXC initializes the unified hierarchy first, so if a controller is
# available via both we favor cgroupv2 here as well.
#
# Returns nothing if the controller is not available.

sub find_cgroup_controller($) {
    my ($controller) = @_;

    my ($v1, $v2) = get_cgroup_controllers();

    if (!defined($controller) || $v2->{$controller}) {
	my $path = cgroupv2_base_path();
	return wantarray ? ($path, 2) : $path;
    }

    if (defined($controller) && $v1->{$controller}) {
	my $path = "/sys/fs/cgroup/$controller";
	return wantarray ? ($path, 1) : $path;
    }

    return;
}

my $CG_PATH_CPUSET = undef;
my $CG_VER_CPUSET = undef;
# Find the cpuset cgroup controller.
#
# This is a function, not a method!
sub cpuset_controller_path() {
    if (!defined($CG_PATH_CPUSET)) {
	($CG_PATH_CPUSET, $CG_VER_CPUSET) = find_cgroup_controller('cpuset')
	    or die "failed to find cpuset controller\n";
    }

    return wantarray ? ($CG_PATH_CPUSET, $CG_VER_CPUSET) : $CG_PATH_CPUSET;
}

# Get a subdirectory (without the cgroup mount point) for a controller.
sub get_subdir {
    my ($self, $controller, $limiting) = @_;

    die "implement in subclass";
}

# Get path and version for a controller.
#
# `$controller` may be `undef`, see get_subdir above for details.
#
# Returns either just the path, or the path and cgroup version as a tuple.
sub get_path {
    my ($self, $controller, $limiting) = @_;
    # Find the controller before querying the lxc monitor via a socket:
    my ($cgpath, $ver) = find_cgroup_controller($controller)
	or return undef;

    my $path = $self->get_subdir($controller, $limiting)
	or return undef;

    $path = "$cgpath/$path";
    return wantarray ? ($path, $ver) : $path;
}

# Convenience method to get the path info if the first existing controller.
#
# Returns the same as `get_path`.
sub get_any_path {
    my ($self, $limiting, @controllers) = @_;

    my ($path, $ver);
    for my $c (@controllers) {
	($path, $ver) = $self->get_path($c, $limiting);
	last if defined $path;
    }
    return wantarray ? ($path, $ver) : $path;
}

# Parse a 'Nested keyed' file:
#
# See kernel documentation `admin-guide/cgroup-v2.rst` 4.1.
my sub parse_nested_keyed_file($) {
    my ($data) = @_;
    my $res = {};
    foreach my $line (split(/\n/, $data)) {
	my ($key, @values) = split(/\s+/, $line);

	my $d = ($res->{$key} = {});

	foreach my $value (@values) {
	    if (my ($key, $value) = ($value =~ /^([^=]+)=(.*)$/)) {
		$d->{$key} = $value;
	    } else {
		warn "bad key=value pair in nested keyed file\n";
	    }
	}
    }
    return $res;
}

# Parse a 'Flat keyed' file:
#
# See kernel documentation `admin-guide/cgroup-v2.rst` 4.1.
my sub parse_flat_keyed_file($) {
    my ($data) = @_;
    my $res = {};
    foreach my $line (split(/\n/, $data)) {
	if (my ($key, $value) = ($line =~ /^(\S+)\s+(.*)$/)) {
	    $res->{$key} = $value;
	} else {
	    warn "bad 'key value' pair in flat keyed file\n";
	}
    }
    return $res;
}

# Parse out 'diskread' and 'diskwrite' values from I/O stats for this container.
sub get_io_stats {
    my ($self) = @_;

    my $res = {
	diskread => 0,
	diskwrite => 0,
    };

    # With cgroupv1 we have a 'blkio' controller, with cgroupv2 it's just 'io':
    my ($path, $ver) = $self->get_any_path(1, 'io', 'blkio');
    if (!defined($path)) {
	# container not running
	return undef;
    } elsif ($ver == 2) {
	# cgroupv2 environment, io controller enabled
	my $io_stat = file_get_contents("$path/io.stat");

	my $data = parse_nested_keyed_file($io_stat);
	foreach my $dev (keys %$data) {
	    my $dev = $data->{$dev};
	    if (my $b = $dev->{rbytes}) {
		$res->{diskread} += $b;
	    }
	    if (my $b = $dev->{wbytes}) {
		$res->{diskread} += $b;
	    }
	}

	return $res;
    } elsif ($ver == 1) {
	# cgroupv1 environment:
	my $io = file_get_contents("$path/blkio.throttle.io_service_bytes_recursive");
	foreach my $line (split(/\n/, $io)) {
	    if (my ($type, $bytes) = ($line =~ /^\d+:\d+\s+(Read|Write)\s+(\d+)$/)) {
		$res->{diskread} += $bytes if $type eq 'Read';
		$res->{diskwrite} += $bytes if $type eq 'Write';
	    }
	}

	return $res;
    } else {
	die "bad cgroup version: $ver\n";
    }

    # container not running
    return undef;
}

# Read utime and stime for this container from the cpuacct cgroup.
# Values are in milliseconds!
sub get_cpu_stat {
    my ($self) = @_;

    my $res = {
	utime => 0,
	stime => 0,
    };

    my ($path, $ver) = $self->get_any_path(1, 'cpuacct', 'cpu');
    if (!defined($path)) {
	# container not running
	return undef;
    } elsif ($ver == 2) {
	my $data = eval { file_get_contents("$path/cpu.stat") };

	# or no io controller available:
	return undef if !defined($data);

	$data = parse_flat_keyed_file($data);
	$res->{utime} = int($data->{user_usec} / 1000);
	$res->{stime} = int($data->{system_usec} / 1000);
    } elsif ($ver == 1) {
	# cgroupv1 environment:
	my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
	my $clk_to_usec = 1000 / $clock_ticks;

	my $data = parse_flat_keyed_file(file_get_contents("$path/cpuacct.stat"));
	$res->{utime} = int($data->{user} * $clk_to_usec);
	$res->{stime} = int($data->{system} * $clk_to_usec);
    } else {
	die "bad cgroup version: $ver\n";
    }

    return $res;
}

# Parse some memory data from `memory.stat`
sub get_memory_stat {
    my ($self) = @_;

    my $res = {
	mem => 0,
	swap => 0,
    };

    my ($path, $ver) = $self->get_path('memory', 1);
    if (!defined($path)) {
	# container most likely isn't running
	return undef;
    } elsif ($ver == 2) {
	my $mem = file_get_contents("$path/memory.current");
	my $swap = file_get_contents("$path/memory.swap.current");
	my $stat = parse_flat_keyed_file(file_get_contents("$path/memory.stat"));

	chomp ($mem, $swap);

	$res->{mem} = $mem - $stat->{file};
	$res->{swap} = $swap;
    } elsif ($ver == 1) {
	# cgroupv1 environment:
	my $stat = parse_flat_keyed_file(file_get_contents("$path/memory.stat"));
	my $mem = file_get_contents("$path/memory.usage_in_bytes");
	my $memsw = file_get_contents("$path/memory.memsw.usage_in_bytes");
	chomp ($mem, $memsw);

	$res->{mem} = $mem - $stat->{total_cache};
	$res->{swap} = $memsw - $mem;
    } else {
	die "bad cgroup version: $ver\n";
    }

    return $res;
}

sub get_pressure_stat {
    my ($self) = @_;

    my $res = {
	cpu => {
	    some => { avg10 => 0, avg60 => 0, avg300 => 0 }
	},
	memory => {
	    some => { avg10 => 0, avg60 => 0, avg300 => 0 },
	    full => { avg10 => 0, avg60 => 0, avg300 => 0 }
	},
	io => {
	    some => { avg10 => 0, avg60 => 0, avg300 => 0 },
	    full => { avg10 => 0, avg60 => 0, avg300 => 0 }
	},
    };

    my ($path, $version) = $self->get_path(undef, 1);
    if (!defined($path)) {
	return $res; # container or VM most likely isn't running, retrun zero stats
    } elsif ($version == 1) {
	return undef; # v1 controller does not provides pressure stat
    } elsif ($version == 2) {
	for my $type (qw(cpu memory io)) {
	    my $stats = PVE::ProcFSTools::parse_pressure("$path/$type.pressure");
	    $res->{$type} = $stats if $stats;
	}
    } else {
	die "bad cgroup version: $version\n";
    }

    return $res;
}

# Change the memory limit for this container.
#
# Dies on error (including a not-running or currently-shutting-down guest).
sub change_memory_limit {
    my ($self, $mem_bytes, $swap_bytes) = @_;

    my ($path, $ver) = $self->get_path('memory', 1);
    if (!defined($path)) {
	die "trying to change memory cgroup values: container not running\n";
    } elsif ($ver == 2) {
	PVE::ProcFSTools::write_proc_entry("$path/memory.swap.max", $swap_bytes)
	    if defined($swap_bytes);
	PVE::ProcFSTools::write_proc_entry("$path/memory.max", $mem_bytes)
	    if defined($mem_bytes);
    } elsif ($ver == 1) {
	# With cgroupv1 we cannot control memory and swap limits separately.
	# This also means that since the two values aren't independent, we need to handle
	# growing and shrinking separately.
	my $path_mem = "$path/memory.limit_in_bytes";
	my $path_memsw = "$path/memory.memsw.limit_in_bytes";

	my $old_mem_bytes = file_get_contents($path_mem);
	my $old_memsw_bytes = file_get_contents($path_memsw);
	chomp($old_mem_bytes, $old_memsw_bytes);

	$mem_bytes //= $old_mem_bytes;
	$swap_bytes //= $old_memsw_bytes - $old_mem_bytes;
	my $memsw_bytes = $mem_bytes + $swap_bytes;

	if ($memsw_bytes > $old_memsw_bytes) {
	    # Growing the limit means growing the combined limit first, then pulling the
	    # memory limitup.
	    PVE::ProcFSTools::write_proc_entry($path_memsw, $memsw_bytes);
	    PVE::ProcFSTools::write_proc_entry($path_mem, $mem_bytes);
	} else {
	    # Shrinking means we first need to shrink the mem-only memsw cannot be
	    # shrunk below it.
	    PVE::ProcFSTools::write_proc_entry($path_mem, $mem_bytes);
	    PVE::ProcFSTools::write_proc_entry($path_memsw, $memsw_bytes);
	}
    } else {
	die "bad cgroup version: $ver\n";
    }

    # return a truth value
    return 1;
}

# Change the cpu quota for a container.
#
# Dies on error (including a not-running or currently-shutting-down guest).
sub change_cpu_quota {
    my ($self, $quota, $period) = @_;

    die "quota without period not allowed\n" if !defined($period) && defined($quota);

    my ($path, $ver) = $self->get_path('cpu', 1);
    if (!defined($path)) {
	die "trying to change cpu quota cgroup values: container not running\n";
    } elsif ($ver == 2) {
	# cgroupv2 environment, an undefined (unlimited) quota is defined as "max"
	# in this interface:
	$quota //= 'max'; # unlimited
	if (defined($quota)) {
	    PVE::ProcFSTools::write_proc_entry("$path/cpu.max", "$quota $period");
	} else {
	    # we're allowed to only write the quota:
	    PVE::ProcFSTools::write_proc_entry("$path/cpu.max", 'max');
	}
    } elsif ($ver == 1) {
	$quota //= -1; # default (unlimited)
	$period //= 100_000; # default (100 ms)
	PVE::ProcFSTools::write_proc_entry("$path/cpu.cfs_period_us", $period);
	PVE::ProcFSTools::write_proc_entry("$path/cpu.cfs_quota_us", $quota);
    } else {
	die "bad cgroup version: $ver\n";
    }

    # return a truth value
    return 1;
}

# Change the cpu "shares" for a container.
#
# In cgroupv1 we used a value in `[0..500000]` with a default of 1024.
#
# In cgroupv2 we do not have "shares", we have "weights" in the range
# of `[1..10000]` with a default of 100.
#
# Since the default values don't match when scaling linearly, we use the
# values we get as-is and simply error for values >10000 in cgroupv2.
#
# It is left to the user to figure this out for now.
#
# Dies on error (including a not-running or currently-shutting-down guest).
sub change_cpu_shares {
    my ($self, $shares, $cgroupv1_default) = @_;

    my ($path, $ver) = $self->get_path('cpu', 1);
    if (!defined($path)) {
	die "trying to change cpu shares/weight cgroup values: container not running\n";
    } elsif ($ver == 2) {
	# the cgroupv2 documentation defines the default to 100
	$shares //= 100;
	die "cpu weight (shares) must be in range [1, 10000]\n" if $shares < 1 || $shares > 10000;
	PVE::ProcFSTools::write_proc_entry("$path/cpu.weight", $shares);
    } elsif ($ver == 1) {
	$shares //= 1024;
	PVE::ProcFSTools::write_proc_entry("$path/cpu.shares", $shares // $cgroupv1_default);
    } else {
	die "bad cgroup version: $ver\n";
    }

    # return a truth value
    return 1;
}

my sub v1_freeze_thaw {
    my ($self, $controller_path, $freeze) = @_;
    my $path = $self->get_subdir('freezer', 1)
	or die "trying to freeze container: container not running\n";
    $path = "$controller_path/$path/freezer.state";

    my $data = $freeze ? 'FROZEN' : 'THAWED';
    PVE::ProcFSTools::write_proc_entry($path, $data);

    # Here we just poll the freezer.state once per second.
    while (1) {
	my $state = file_get_contents($path);
	chomp $state;
	last if $state eq $data;
    }
}

my sub v2_freeze_thaw {
    my ($self, $controller_path, $freeze) = @_;
    my $path = $self->get_subdir(undef, 1)
	or die "trying to freeze container: container not running\n";
    $path = "$controller_path/$path";

    my $desired_state = $freeze ? 1 : 0;

    # cgroupv2 supports poll events on cgroup.events which contains the frozen
    # state.
    my $fh = IO::File->new("$path/cgroup.events", 'r')
	or die "failed to open $path/cgroup.events file: $!\n";
    my $select = IO::Select->new();
    $select->add($fh);

    PVE::ProcFSTools::write_proc_entry("$path/cgroup.freeze", $desired_state);
    while (1) {
	my $data = do {
	    local $/ = undef;
	    <$fh>
	};
	$data = parse_flat_keyed_file($data);
	last if $data->{frozen} == $desired_state;
	my @handles = $select->has_exception();
	next if !@handles;
	seek($fh, 0, 0)
	    or die "failed to rewind cgroup.events file: $!\n";
    }
}

# Freeze or unfreeze a container.
#
# This will freeze the container at its outer (limiting) cgroup path. We use
# this instead of `lxc-freeze` as `lxc-freeze` from lxc4 will not be able to
# fetch the cgroup path from contaienrs still running on lxc3.
sub freeze_thaw {
    my ($self, $freeze) = @_;

    my $controller_path = find_cgroup_controller('freezer');
    if (defined($controller_path)) {
	return v1_freeze_thaw($self, $controller_path, $freeze);
    } else {
	# cgroupv2 always has a freezer, there can be both cgv1 and cgv2
	# freezers, but we'll prefer v1 when it's available as that's what lxc
	# does as well...
	return v2_freeze_thaw($self, cgroupv2_base_path(), $freeze);
    }
}

1;
Commit	Line	Data
86dff11c AD	1	# cgroup handler
	2	#
	3	# This package should deal with figuring out the right cgroup path for a
	4	# container (via the command socket), reading and writing cgroup values, and
	5	# handling cgroup v1 & v2 differences.
	6	#
	7	# Note that the long term plan is to have resource manage functions instead of
	8	# dealing with cgroup files on the outside.
	9
	10	package PVE::CGroup;
	11
	12	use strict;
	13	use warnings;
	14
	15	use IO::File;
	16	use IO::Select;
	17	use POSIX qw();
	18
	19	use PVE::ProcFSTools;
	20	use PVE::Tools qw(
	21	file_get_contents
	22	file_read_firstline
	23	);
	24
86dff11c AD	25	# We don't want to do a command socket round trip for every cgroup read/write,
	26	# so any cgroup function needs to have the container's path cached, so this
	27	# package has to be instantiated.
	28	#
	29	# LXC keeps separate paths by controller (although they're normally all the
	30	# same, in our # case anyway), so we cache them by controller as well.
	31	sub new {
	32	my ($class, $vmid) = @_;
	33
	34	my $self = { vmid => $vmid };
	35
	36	return bless $self, $class;
	37	}
	38
	39	# Get the v1 controller list.
	40	#
	41	# Returns a set (hash mapping names to `1`) of cgroupv1 controllers, and an
	42	# optional boolean whether a unified (cgroupv2) hierarchy exists.
	43	#
	44	# Deprecated: Use `get_cgroup_controllers()` instead.
	45	sub get_v1_controllers {
	46	my $v1 = {};
	47	my $v2 = 0;
	48	my $data = PVE::Tools::file_get_contents('/proc/self/cgroup');
	49	while ($data =~ /^\d+:([^:\n]):.$/gm) {
	50	my $type = $1;
	51	if (length($type)) {
	52	$v1->{$_} = 1 foreach split(/,/, $type);
	53	} else {
	54	$v2 = 1;
	55	}
	56	}
	57	return wantarray ? ($v1, $v2) : $v1;
	58	}
	59
	60	# Get the set v2 controller list from the `cgroup.controllers` file.
	61	my sub get_v2_controllers {
	62	my $v2 = eval { file_get_contents('/sys/fs/cgroup/cgroup.controllers') }
	63	\|\| eval { file_get_contents('/sys/fs/cgroup/unified/cgroup.controllers') };
	64	return undef if !defined $v2;
	65
	66	# It's a simple space separated list:
	67	return { map { $_ => 1 } split(/\s+/, $v2) };
	68	}
	69
	70	my $CGROUP_CONTROLLERS = undef;
	71	# Get a list of controllers enabled in each cgroup subsystem.
	72	#
	73	# This is a more complete version of `PVE::LXC::get_cgroup_subsystems`.
	74	#
	75	# Returns 2 sets (hashes mapping controller names to `1`), one for each cgroup
	76	# version.
	77	sub get_cgroup_controllers() {
	78	if (!defined($CGROUP_CONTROLLERS)) {
	79	my ($v1, undef) = get_v1_controllers();
	80	my $v2 = get_v2_controllers();
	81
	82	$CGROUP_CONTROLLERS = [$v1, $v2];
	83	}
	84
	85	return $CGROUP_CONTROLLERS->@*;
	86	}
	87
	88	my $CGROUP_MODE = undef;
89	# Figure out which cgroup mode we're operating under:
90	#
91	# Returns 1 if cgroupv1 controllers exist (hybrid or legacy mode), and 2 in a
92	# cgroupv2-only environment.
93	#
94	# NOTE: To fully support a hybrid layout it is better to use functions like
95	# `cpuset_controller_path`.
96	#
97	# This is a function, not a method!
98	sub cgroup_mode() {
99	if (!defined($CGROUP_MODE)) {
100	my ($v1, $v2) = get_cgroup_controllers();
101	if (keys %$v1) {
102	# hybrid or legacy mode
103	$CGROUP_MODE = 1;
104	} elsif ($v2) {
105	$CGROUP_MODE = 2;
106	}
107	}
108
109	die "unknown cgroup mode\n" if !defined($CGROUP_MODE);
110	return $CGROUP_MODE;
111	}
112
113	my $CGROUPV2_PATH = undef;
114	sub cgroupv2_base_path() {
115	if (!defined($CGROUPV2_PATH)) {
116	if (cgroup_mode() == 2) {
117	$CGROUPV2_PATH = '/sys/fs/cgroup';
118	} else {
119	$CGROUPV2_PATH = '/sys/fs/cgroup/unified';
120	}
121	}
122	return $CGROUPV2_PATH;
123	}
124
125	# Find a cgroup controller and return its path and version.
126	#
127	# LXC initializes the unified hierarchy first, so if a controller is
128	# available via both we favor cgroupv2 here as well.
129	#
130	# Returns nothing if the controller is not available.
9465abe2	131
86dff11c AD	132	sub find_cgroup_controller($) {
	133	my ($controller) = @_;
	134
	135	my ($v1, $v2) = get_cgroup_controllers();
	136
	137	if (!defined($controller) \|\| $v2->{$controller}) {
	138	my $path = cgroupv2_base_path();
	139	return wantarray ? ($path, 2) : $path;
	140	}
	141
	142	if (defined($controller) && $v1->{$controller}) {
	143	my $path = "/sys/fs/cgroup/$controller";
	144	return wantarray ? ($path, 1) : $path;
	145	}
	146
	147	return;
	148	}
	149
	150	my $CG_PATH_CPUSET = undef;
	151	my $CG_VER_CPUSET = undef;
	152	# Find the cpuset cgroup controller.
	153	#
	154	# This is a function, not a method!
	155	sub cpuset_controller_path() {
	156	if (!defined($CG_PATH_CPUSET)) {
	157	($CG_PATH_CPUSET, $CG_VER_CPUSET) = find_cgroup_controller('cpuset')
	158	or die "failed to find cpuset controller\n";
	159	}
	160
	161	return wantarray ? ($CG_PATH_CPUSET, $CG_VER_CPUSET) : $CG_PATH_CPUSET;
	162	}
	163
	164	# Get a subdirectory (without the cgroup mount point) for a controller.
9465abe2	165	sub get_subdir {
86dff11c AD	166	my ($self, $controller, $limiting) = @_;
86dff11c AD	167
9465abe2	168	die "implement in subclass";
86dff11c AD	169	}
	170
	171	# Get path and version for a controller.
	172	#
	173	# `$controller` may be `undef`, see get_subdir above for details.
	174	#
	175	# Returns either just the path, or the path and cgroup version as a tuple.
	176	sub get_path {
	177	my ($self, $controller, $limiting) = @_;
86dff11c AD	178	# Find the controller before querying the lxc monitor via a socket:
	179	my ($cgpath, $ver) = find_cgroup_controller($controller)
	180	or return undef;
	181
9465abe2	182	my $path = $self->get_subdir($controller, $limiting)
86dff11c AD	183	or return undef;
	184
	185	$path = "$cgpath/$path";
	186	return wantarray ? ($path, $ver) : $path;
	187	}
	188
	189	# Convenience method to get the path info if the first existing controller.
	190	#
	191	# Returns the same as `get_path`.
	192	sub get_any_path {
	193	my ($self, $limiting, @controllers) = @_;
	194
	195	my ($path, $ver);
	196	for my $c (@controllers) {
	197	($path, $ver) = $self->get_path($c, $limiting);
	198	last if defined $path;
	199	}
	200	return wantarray ? ($path, $ver) : $path;
	201	}
	202
	203	# Parse a 'Nested keyed' file:
	204	#
	205	# See kernel documentation `admin-guide/cgroup-v2.rst` 4.1.
	206	my sub parse_nested_keyed_file($) {
	207	my ($data) = @_;
	208	my $res = {};
	209	foreach my $line (split(/\n/, $data)) {
	210	my ($key, @values) = split(/\s+/, $line);
	211
	212	my $d = ($res->{$key} = {});
	213
	214	foreach my $value (@values) {
	215	if (my ($key, $value) = ($value =~ /^([^=]+)=(.*)$/)) {
	216	$d->{$key} = $value;
	217	} else {
	218	warn "bad key=value pair in nested keyed file\n";
	219	}
	220	}
	221	}
	222	return $res;
	223	}
	224
	225	# Parse a 'Flat keyed' file:
	226	#
	227	# See kernel documentation `admin-guide/cgroup-v2.rst` 4.1.
	228	my sub parse_flat_keyed_file($) {
	229	my ($data) = @_;
	230	my $res = {};
	231	foreach my $line (split(/\n/, $data)) {
	232	if (my ($key, $value) = ($line =~ /^(\S+)\s+(.*)$/)) {
	233	$res->{$key} = $value;
	234	} else {
	235	warn "bad 'key value' pair in flat keyed file\n";
	236	}
	237	}
	238	return $res;
	239	}
	240
	241	# Parse out 'diskread' and 'diskwrite' values from I/O stats for this container.
	242	sub get_io_stats {
	243	my ($self) = @_;
	244
	245	my $res = {
	246	diskread => 0,
247	diskwrite => 0,
248	};
249
250	# With cgroupv1 we have a 'blkio' controller, with cgroupv2 it's just 'io':
251	my ($path, $ver) = $self->get_any_path(1, 'io', 'blkio');
252	if (!defined($path)) {
253	# container not running
254	return undef;
255	} elsif ($ver == 2) {
256	# cgroupv2 environment, io controller enabled
257	my $io_stat = file_get_contents("$path/io.stat");
258
259	my $data = parse_nested_keyed_file($io_stat);
260	foreach my $dev (keys %$data) {
261	my $dev = $data->{$dev};
262	if (my $b = $dev->{rbytes}) {
263	$res->{diskread} += $b;
264	}
265	if (my $b = $dev->{wbytes}) {
266	$res->{diskread} += $b;
267	}
268	}
269
270	return $res;
271	} elsif ($ver == 1) {
272	# cgroupv1 environment:
273	my $io = file_get_contents("$path/blkio.throttle.io_service_bytes_recursive");
274	foreach my $line (split(/\n/, $io)) {
275	if (my ($type, $bytes) = ($line =~ /^\d+:\d+\s+(Read\|Write)\s+(\d+)$/)) {
276	$res->{diskread} += $bytes if $type eq 'Read';
277	$res->{diskwrite} += $bytes if $type eq 'Write';
278	}
279	}
280
281	return $res;
282	} else {
283	die "bad cgroup version: $ver\n";
284	}
285
286	# container not running
287	return undef;
288	}
289
290	# Read utime and stime for this container from the cpuacct cgroup.
291	# Values are in milliseconds!
292	sub get_cpu_stat {
293	my ($self) = @_;
294
295	my $res = {
296	utime => 0,
297	stime => 0,
298	};
299
300	my ($path, $ver) = $self->get_any_path(1, 'cpuacct', 'cpu');
301	if (!defined($path)) {
302	# container not running
303	return undef;
304	} elsif ($ver == 2) {
305	my $data = eval { file_get_contents("$path/cpu.stat") };
306
307	# or no io controller available:
308	return undef if !defined($data);
309
310	$data = parse_flat_keyed_file($data);
311	$res->{utime} = int($data->{user_usec} / 1000);
312	$res->{stime} = int($data->{system_usec} / 1000);
313	} elsif ($ver == 1) {
314	# cgroupv1 environment:
315	my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
316	my $clk_to_usec = 1000 / $clock_ticks;
317
318	my $data = parse_flat_keyed_file(file_get_contents("$path/cpuacct.stat"));
319	$res->{utime} = int($data->{user} * $clk_to_usec);
320	$res->{stime} = int($data->{system} * $clk_to_usec);
321	} else {
322	die "bad cgroup version: $ver\n";
323	}
324
325	return $res;
326	}
327
328	# Parse some memory data from `memory.stat`
329	sub get_memory_stat {
330	my ($self) = @_;
331
332	my $res = {
333	mem => 0,
334	swap => 0,
335	};
336
337	my ($path, $ver) = $self->get_path('memory', 1);
338	if (!defined($path)) {
339	# container most likely isn't running
340	return undef;
341	} elsif ($ver == 2) {
342	my $mem = file_get_contents("$path/memory.current");
343	my $swap = file_get_contents("$path/memory.swap.current");
61f1cb1a	344	my $stat = parse_flat_keyed_file(file_get_contents("$path/memory.stat"));
86dff11c AD	345
	346	chomp ($mem, $swap);
	347
61f1cb1a	348	$res->{mem} = $mem - $stat->{file};
86dff11c AD	349	$res->{swap} = $swap;
	350	} elsif ($ver == 1) {
	351	# cgroupv1 environment:
	352	my $stat = parse_flat_keyed_file(file_get_contents("$path/memory.stat"));
	353	my $mem = file_get_contents("$path/memory.usage_in_bytes");
	354	my $memsw = file_get_contents("$path/memory.memsw.usage_in_bytes");
	355	chomp ($mem, $memsw);
	356
	357	$res->{mem} = $mem - $stat->{total_cache};
	358	$res->{swap} = $memsw - $mem;
	359	} else {
	360	die "bad cgroup version: $ver\n";
	361	}
	362
	363	return $res;
	364	}
	365
0bc3dac9 AD	366	sub get_pressure_stat {
	367	my ($self) = @_;
	368
	369	my $res = {
	370	cpu => {
	371	some => { avg10 => 0, avg60 => 0, avg300 => 0 }
	372	},
	373	memory => {
	374	some => { avg10 => 0, avg60 => 0, avg300 => 0 },
	375	full => { avg10 => 0, avg60 => 0, avg300 => 0 }
	376	},
	377	io => {
	378	some => { avg10 => 0, avg60 => 0, avg300 => 0 },
	379	full => { avg10 => 0, avg60 => 0, avg300 => 0 }
	380	},
	381	};
	382
b82ddf5d	383	my ($path, $version) = $self->get_path(undef, 1);
0bc3dac9	384	if (!defined($path)) {
b82ddf5d TL	385	return $res; # container or VM most likely isn't running, retrun zero stats
	386	} elsif ($version == 1) {
	387	return undef; # v1 controller does not provides pressure stat
	388	} elsif ($version == 2) {
eadfaabd TL	389	for my $type (qw(cpu memory io)) {
	390	my $stats = PVE::ProcFSTools::parse_pressure("$path/$type.pressure");
	391	$res->{$type} = $stats if $stats;
0bc3dac9 AD	392	}
0bc3dac9 AD	393	} else {
b82ddf5d	394	die "bad cgroup version: $version\n";
0bc3dac9 AD	395	}
	396
	397	return $res;
	398	}
	399
86dff11c AD	400	# Change the memory limit for this container.
	401	#
	402	# Dies on error (including a not-running or currently-shutting-down guest).
	403	sub change_memory_limit {
	404	my ($self, $mem_bytes, $swap_bytes) = @_;
	405
	406	my ($path, $ver) = $self->get_path('memory', 1);
	407	if (!defined($path)) {
	408	die "trying to change memory cgroup values: container not running\n";
	409	} elsif ($ver == 2) {
	410	PVE::ProcFSTools::write_proc_entry("$path/memory.swap.max", $swap_bytes)
	411	if defined($swap_bytes);
	412	PVE::ProcFSTools::write_proc_entry("$path/memory.max", $mem_bytes)
	413	if defined($mem_bytes);
	414	} elsif ($ver == 1) {
	415	# With cgroupv1 we cannot control memory and swap limits separately.
	416	# This also means that since the two values aren't independent, we need to handle
	417	# growing and shrinking separately.
	418	my $path_mem = "$path/memory.limit_in_bytes";
	419	my $path_memsw = "$path/memory.memsw.limit_in_bytes";
	420
	421	my $old_mem_bytes = file_get_contents($path_mem);
	422	my $old_memsw_bytes = file_get_contents($path_memsw);
	423	chomp($old_mem_bytes, $old_memsw_bytes);
	424
	425	$mem_bytes //= $old_mem_bytes;
	426	$swap_bytes //= $old_memsw_bytes - $old_mem_bytes;
	427	my $memsw_bytes = $mem_bytes + $swap_bytes;
	428
	429	if ($memsw_bytes > $old_memsw_bytes) {
	430	# Growing the limit means growing the combined limit first, then pulling the
	431	# memory limitup.
	432	PVE::ProcFSTools::write_proc_entry($path_memsw, $memsw_bytes);
	433	PVE::ProcFSTools::write_proc_entry($path_mem, $mem_bytes);
	434	} else {
	435	# Shrinking means we first need to shrink the mem-only memsw cannot be
	436	# shrunk below it.
	437	PVE::ProcFSTools::write_proc_entry($path_mem, $mem_bytes);
	438	PVE::ProcFSTools::write_proc_entry($path_memsw, $memsw_bytes);
	439	}
	440	} else {
	441	die "bad cgroup version: $ver\n";
	442	}
	443
	444	# return a truth value
	445	return 1;
	446	}
	447
	448	# Change the cpu quota for a container.
	449	#
	450	# Dies on error (including a not-running or currently-shutting-down guest).
	451	sub change_cpu_quota {
	452	my ($self, $quota, $period) = @_;
	453
	454	die "quota without period not allowed\n" if !defined($period) && defined($quota);
	455
	456	my ($path, $ver) = $self->get_path('cpu', 1);
	457	if (!defined($path)) {
	458	die "trying to change cpu quota cgroup values: container not running\n";
	459	} elsif ($ver == 2) {
	460	# cgroupv2 environment, an undefined (unlimited) quota is defined as "max"
	461	# in this interface:
	462	$quota //= 'max'; # unlimited
	463	if (defined($quota)) {
464	PVE::ProcFSTools::write_proc_entry("$path/cpu.max", "$quota $period");
465	} else {
466	# we're allowed to only write the quota:
467	PVE::ProcFSTools::write_proc_entry("$path/cpu.max", 'max');
468	}
469	} elsif ($ver == 1) {
d37a7186 OB	470	$quota //= -1; # default (unlimited)
d37a7186 OB	471	$period //= 100_000; # default (100 ms)
86dff11c AD	472	PVE::ProcFSTools::write_proc_entry("$path/cpu.cfs_period_us", $period);
	473	PVE::ProcFSTools::write_proc_entry("$path/cpu.cfs_quota_us", $quota);
	474	} else {
	475	die "bad cgroup version: $ver\n";
	476	}
	477
	478	# return a truth value
	479	return 1;
	480	}
	481
	482	# Change the cpu "shares" for a container.
	483	#
	484	# In cgroupv1 we used a value in `[0..500000]` with a default of 1024.
	485	#
	486	# In cgroupv2 we do not have "shares", we have "weights" in the range
	487	# of `[1..10000]` with a default of 100.
	488	#
	489	# Since the default values don't match when scaling linearly, we use the
	490	# values we get as-is and simply error for values >10000 in cgroupv2.
	491	#
	492	# It is left to the user to figure this out for now.
	493	#
	494	# Dies on error (including a not-running or currently-shutting-down guest).
	495	sub change_cpu_shares {
	496	my ($self, $shares, $cgroupv1_default) = @_;
	497
	498	my ($path, $ver) = $self->get_path('cpu', 1);
	499	if (!defined($path)) {
	500	die "trying to change cpu shares/weight cgroup values: container not running\n";
	501	} elsif ($ver == 2) {
	502	# the cgroupv2 documentation defines the default to 100
	503	$shares //= 100;
	504	die "cpu weight (shares) must be in range [1, 10000]\n" if $shares < 1 \|\| $shares > 10000;
	505	PVE::ProcFSTools::write_proc_entry("$path/cpu.weight", $shares);
	506	} elsif ($ver == 1) {
6d7c3065	507	$shares //= 1024;
86dff11c AD	508	PVE::ProcFSTools::write_proc_entry("$path/cpu.shares", $shares // $cgroupv1_default);
	509	} else {
	510	die "bad cgroup version: $ver\n";
	511	}
	512
	513	# return a truth value
	514	return 1;
	515	}
	516
	517	my sub v1_freeze_thaw {
	518	my ($self, $controller_path, $freeze) = @_;
9465abe2	519	my $path = $self->get_subdir('freezer', 1)
86dff11c AD	520	or die "trying to freeze container: container not running\n";
	521	$path = "$controller_path/$path/freezer.state";
	522
	523	my $data = $freeze ? 'FROZEN' : 'THAWED';
	524	PVE::ProcFSTools::write_proc_entry($path, $data);
	525
	526	# Here we just poll the freezer.state once per second.
	527	while (1) {
	528	my $state = file_get_contents($path);
	529	chomp $state;
	530	last if $state eq $data;
	531	}
	532	}
	533
	534	my sub v2_freeze_thaw {
	535	my ($self, $controller_path, $freeze) = @_;
9465abe2	536	my $path = $self->get_subdir(undef, 1)
86dff11c AD	537	or die "trying to freeze container: container not running\n";
	538	$path = "$controller_path/$path";
	539
	540	my $desired_state = $freeze ? 1 : 0;
	541
	542	# cgroupv2 supports poll events on cgroup.events which contains the frozen
	543	# state.
	544	my $fh = IO::File->new("$path/cgroup.events", 'r')
	545	or die "failed to open $path/cgroup.events file: $!\n";
	546	my $select = IO::Select->new();
	547	$select->add($fh);
	548
	549	PVE::ProcFSTools::write_proc_entry("$path/cgroup.freeze", $desired_state);
	550	while (1) {
	551	my $data = do {
	552	local $/ = undef;
	553	<$fh>
	554	};
	555	$data = parse_flat_keyed_file($data);
	556	last if $data->{frozen} == $desired_state;
	557	my @handles = $select->has_exception();
	558	next if !@handles;
	559	seek($fh, 0, 0)
	560	or die "failed to rewind cgroup.events file: $!\n";
	561	}
	562	}
	563
	564	# Freeze or unfreeze a container.
	565	#
	566	# This will freeze the container at its outer (limiting) cgroup path. We use
	567	# this instead of `lxc-freeze` as `lxc-freeze` from lxc4 will not be able to
	568	# fetch the cgroup path from contaienrs still running on lxc3.
	569	sub freeze_thaw {
	570	my ($self, $freeze) = @_;
	571
	572	my $controller_path = find_cgroup_controller('freezer');
	573	if (defined($controller_path)) {
	574	return v1_freeze_thaw($self, $controller_path, $freeze);
	575	} else {
	576	# cgroupv2 always has a freezer, there can be both cgv1 and cgv2
	577	# freezers, but we'll prefer v1 when it's available as that's what lxc
	578	# does as well...
	579	return v2_freeze_thaw($self, cgroupv2_base_path(), $freeze);
	580	}
	581	}
	582
	583	1;