1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
package Mojo::IOLoop::ReadWriteProcess::CGroup;
use Mojo::Base -base;
use Mojo::File 'path';
use Mojo::IOLoop::ReadWriteProcess::CGroup::v1;
use Mojo::IOLoop::ReadWriteProcess::CGroup::v2;
use File::Spec::Functions 'splitdir';
our @EXPORT_OK = qw(cgroupv2 cgroupv1);
use Exporter 'import';
use constant CGROUP_FS => $ENV{MOJO_CGROUP_FS} // '/sys/fs/cgroup';
use constant DEBUG => $ENV{MOJO_PROCESS_DEBUG};
has '_vfs' => sub { CGROUP_FS() };
has [qw(name parent)];
sub cgroupv2 { Mojo::IOLoop::ReadWriteProcess::CGroup::v2->new(@_)->create }
sub cgroupv1 { Mojo::IOLoop::ReadWriteProcess::CGroup::v1->new(@_)->create }
sub from {
my ($self, $string) = @_;
my $g = $self->_vfs;
$string =~ s/$g//;
my @p = splitdir($string);
my $pre = substr $string, 0, 1;
shift @p if $pre eq '/';
my $name = shift @p;
return $_[0]->new(name => $name, parent => path(@p));
}
sub _cgroup {
path($_[0]->parent
? path($_[0]->_vfs, $_[0]->name // '', $_[0]->parent)
: path($_[0]->_vfs, $_[0]->name // ''));
}
sub create { $_[0]->_cgroup->make_path unless -d $_[0]->_cgroup; $_[0] }
# TODO: Make sure there aren't pid belonging to cgroup before removing
# This is done in Container class, but we might want to warn in case this is hit
sub remove { rmdir $_[0]->_cgroup->to_string } #->remove_tree() }
sub child {
return $_[0]->new(
name => $_[0]->name,
parent => $_[0]->parent ? path($_[0]->parent, $_[1]) : $_[1])->create;
}
sub exists { -d $_[0]->_cgroup }
sub _append { my $h = $_[0]->_cgroup->child($_[1])->open('>>'); print $h pop() }
sub _write { my $h = $_[0]->_cgroup->child($_[1])->open('>'); print $h pop() }
sub _flag {
my $f = pop;
my $h = $_[0]->_cgroup->child($_[1])->open('>');
print $h ($f == 0 ? 0 : 1);
}
sub _appendln { shift->_append(shift() => pop() . "\n") }
sub _list { my $c = shift->_cgroup->child(pop); $c->slurp if -e $c }
sub _listarray { split(/\n/, shift->_list(@_)) }
sub _contains {
my $p = pop;
my $i = pop;
grep { $p eq $_ } shift->_listarray($i);
}
sub _setget {
$_[2]
? shift->_cgroup->child($_[0])->spew($_[1])
: shift->_cgroup->child($_[0])->slurp;
}
1;
=encoding utf-8
=head1 NAME
Mojo::IOLoop::ReadWriteProcess::CGroup - Base object for CGroups implementations.
=head1 SYNOPSIS
use Mojo::IOLoop::ReadWriteProcess::CGroup;
my $cgroup = Mojo::IOLoop::ReadWriteProcess::CGroup->new( name => "test" );
$cgroup->create;
$cgroup->exists;
my $child = $cgroup->child('bar');
=head1 DESCRIPTION
This module uses features that are only available on Linux,
and requires cgroups and capability for unshare syscalls to achieve pid isolation.
=head1 METHODS
L<Mojo::IOLoop::ReadWriteProcess::CGroup> inherits all methods from L<Mojo::Base> and implements
the following new ones.
=head1 LICENSE
Copyright (C) Ettore Di Giacinto.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Ettore Di Giacinto E<lt>edigiacinto@suse.comE<gt>
=cut
|
