]>
Commit | Line | Data |
---|---|---|
eae43687 | 1 | package PVE::Systemd; |
f024a872 WB |
2 | |
3 | use strict; | |
4 | use warnings; | |
5 | ||
ffe48b8e | 6 | use Net::DBus qw(dbus_uint32 dbus_uint64 dbus_boolean); |
f024a872 WB |
7 | use Net::DBus::Callback; |
8 | use Net::DBus::Reactor; | |
9 | ||
e65624a3 SI |
10 | use PVE::Tools qw(file_set_contents file_get_contents trim); |
11 | ||
b4f88e88 TL |
12 | sub escape_unit { |
13 | my ($val, $is_path) = @_; | |
14 | ||
15 | # NOTE: this is not complete, but enough for our needs. normally all | |
16 | # characters which are not alpha-numerical, '.' or '_' would need escaping | |
17 | $val =~ s/\-/\\x2d/g; | |
18 | ||
19 | if ($is_path) { | |
20 | $val =~ s/^\///g; | |
21 | $val =~ s/\/$//g; | |
22 | } | |
23 | $val =~ s/\//-/g; | |
24 | ||
25 | return $val; | |
26 | } | |
27 | ||
28 | sub unescape_unit { | |
29 | my ($val) = @_; | |
30 | ||
31 | $val =~ s/-/\//g; | |
32 | $val =~ s/\\x([a-fA-F0-9]{2})/chr(hex($1))/eg; | |
33 | ||
34 | return $val; | |
35 | } | |
36 | ||
b8d15bfd WB |
37 | # $code should take the parameters ($interface, $reactor, $finish_callback). |
38 | # | |
39 | # $finish_callback can be used by dbus-signal-handlers to stop the reactor. | |
40 | # | |
41 | # In order to even start waiting on the reactor, $code needs to return undef, if it returns a | |
42 | # defined value instead, it is assumed that this is the result already and we can stop. | |
f024a872 | 43 | # NOTE: This calls the dbus main loop and must not be used when another dbus |
b8d15bfd WB |
44 | # main loop is being used as we need to wait signals. |
45 | sub systemd_call($;$) { | |
46 | my ($code, $timeout) = @_; | |
47 | ||
48 | my $bus = Net::DBus->system(); | |
49 | my $reactor = Net::DBus::Reactor->main(); | |
50 | ||
51 | my $service = $bus->get_service('org.freedesktop.systemd1'); | |
52 | my $if = $service->get_object('/org/freedesktop/systemd1', 'org.freedesktop.systemd1.Manager'); | |
53 | ||
54 | my ($finished, $current_result, $timer); | |
55 | my $finish_callback = sub { | |
56 | my ($result) = @_; | |
57 | ||
58 | $current_result = $result; | |
59 | ||
60 | $finished = 1; | |
61 | ||
62 | if (defined($timer)) { | |
63 | $reactor->remove_timeout($timer); | |
64 | $timer = undef; | |
65 | } | |
66 | ||
67 | if (defined($reactor)) { | |
68 | $reactor->shutdown(); | |
69 | $reactor = undef; | |
70 | } | |
71 | }; | |
72 | ||
73 | my $result = $code->($if, $reactor, $finish_callback); | |
74 | # Are we done immediately? | |
75 | return $result if defined $result; | |
76 | ||
77 | # Alterantively $finish_callback may have been called already? | |
78 | return $current_result if $finished; | |
79 | ||
80 | # Otherwise wait: | |
81 | my $on_timeout = sub { | |
82 | $finish_callback->(undef); | |
83 | die "timeout waiting on systemd\n"; | |
84 | }; | |
85 | $timer = $reactor->add_timeout($timeout * 1000, Net::DBus::Callback->new(method => $on_timeout)) | |
86 | if defined($timeout); | |
87 | ||
88 | $reactor->run(); | |
89 | $reactor->shutdown() if defined($reactor); # $finish_callback clears it | |
90 | ||
91 | return $current_result; | |
92 | } | |
93 | ||
f024a872 WB |
94 | # Polling the job status instead doesn't work because this doesn't give us the |
95 | # distinction between success and failure. | |
96 | # | |
97 | # Note that the description is mandatory for security reasons. | |
98 | sub enter_systemd_scope { | |
99 | my ($unit, $description, %extra) = @_; | |
100 | die "missing description\n" if !defined($description); | |
101 | ||
102 | my $timeout = delete $extra{timeout}; | |
103 | ||
104 | $unit .= '.scope'; | |
105 | my $properties = [ [PIDs => [dbus_uint32($$)]] ]; | |
106 | ||
107 | foreach my $key (keys %extra) { | |
108 | if ($key eq 'Slice' || $key eq 'KillMode') { | |
109 | push @{$properties}, [$key, $extra{$key}]; | |
ffe48b8e SR |
110 | } elsif ($key eq 'SendSIGKILL') { |
111 | push @{$properties}, [$key, dbus_boolean($extra{$key})]; | |
112 | } elsif ($key eq 'CPUShares' || $key eq 'CPUWeight' || $key eq 'TimeoutStopUSec') { | |
f024a872 WB |
113 | push @{$properties}, [$key, dbus_uint64($extra{$key})]; |
114 | } elsif ($key eq 'CPUQuota') { | |
115 | push @{$properties}, ['CPUQuotaPerSecUSec', | |
b8d15bfd | 116 | dbus_uint64($extra{$key} * 10_000)]; |
f024a872 WB |
117 | } else { |
118 | die "Don't know how to encode $key for systemd scope\n"; | |
119 | } | |
120 | } | |
121 | ||
b8d15bfd WB |
122 | systemd_call(sub { |
123 | my ($if, $reactor, $finish_cb) = @_; | |
f024a872 | 124 | |
b8d15bfd | 125 | my $job; |
f024a872 | 126 | |
b8d15bfd WB |
127 | $if->connect_to_signal('JobRemoved', sub { |
128 | my ($id, $removed_job, $signaled_unit, $result) = @_; | |
129 | return if $signaled_unit ne $unit || $removed_job ne $job; | |
130 | if ($result ne 'done') { | |
131 | # I seem to remember $reactor->run() catching die() at some point? | |
132 | # so better call finish to be sure...: | |
133 | $finish_cb->(0); | |
134 | die "systemd job failed\n"; | |
135 | } else { | |
136 | $finish_cb->(1); | |
137 | } | |
138 | }); | |
f024a872 | 139 | |
b8d15bfd | 140 | $job = $if->StartTransientUnit($unit, 'fail', $properties, []); |
f024a872 | 141 | |
b8d15bfd WB |
142 | return undef; |
143 | }, $timeout); | |
144 | } | |
f024a872 | 145 | |
b8d15bfd WB |
146 | sub wait_for_unit_removed($;$) { |
147 | my ($unit, $timeout) = @_; | |
148 | ||
149 | systemd_call(sub { | |
150 | my ($if, $reactor, $finish_cb) = @_; | |
151 | ||
152 | my $unit_obj = eval { $if->GetUnit($unit) }; | |
153 | return 1 if !$unit_obj; | |
154 | ||
155 | $if->connect_to_signal('UnitRemoved', sub { | |
156 | my ($id, $removed_unit) = @_; | |
157 | $finish_cb->(1) if $removed_unit eq $unit_obj; | |
158 | }); | |
159 | ||
160 | # Deal with what we lost between GetUnit() and connecting to UnitRemoved: | |
161 | my $unit_obj_new = eval { $if->GetUnit($unit) }; | |
162 | if (!$unit_obj_new) { | |
163 | return 1; | |
164 | } | |
165 | ||
166 | return undef; | |
167 | }, $timeout); | |
f024a872 WB |
168 | } |
169 | ||
e65624a3 SI |
170 | sub read_ini { |
171 | my ($filename) = @_; | |
172 | ||
173 | my $content = file_get_contents($filename); | |
174 | my @lines = split /\n/, $content; | |
175 | ||
176 | my $result = {}; | |
177 | my $section; | |
178 | ||
179 | foreach my $line (@lines) { | |
180 | $line = trim($line); | |
181 | if ($line =~ m/^\[([^\]]+)\]/) { | |
182 | $section = $1; | |
183 | if (!defined($result->{$section})) { | |
184 | $result->{$section} = {}; | |
185 | } | |
186 | } elsif ($line =~ m/^(.*?)=(.*)$/) { | |
187 | my ($key, $val) = ($1, $2); | |
188 | if (!$section) { | |
189 | warn "key value pair found without section, skipping\n"; | |
190 | next; | |
191 | } | |
192 | ||
193 | if ($result->{$section}->{$key}) { | |
194 | # make duplicate properties to arrays to keep the order | |
195 | my $prop = $result->{$section}->{$key}; | |
196 | if (ref($prop) eq 'ARRAY') { | |
197 | push @$prop, $val; | |
198 | } else { | |
199 | $result->{$section}->{$key} = [$prop, $val]; | |
200 | } | |
201 | } else { | |
202 | $result->{$section}->{$key} = $val; | |
203 | } | |
204 | } | |
205 | # ignore everything else | |
206 | } | |
207 | ||
208 | return $result; | |
209 | }; | |
210 | ||
211 | sub write_ini { | |
212 | my ($ini, $filename) = @_; | |
213 | ||
214 | my $content = ""; | |
215 | ||
216 | foreach my $sname (sort keys %$ini) { | |
217 | my $section = $ini->{$sname}; | |
218 | ||
219 | $content .= "[$sname]\n"; | |
220 | ||
221 | foreach my $pname (sort keys %$section) { | |
222 | my $prop = $section->{$pname}; | |
223 | ||
224 | if (!ref($prop)) { | |
225 | $content .= "$pname=$prop\n"; | |
226 | } elsif (ref($prop) eq 'ARRAY') { | |
227 | foreach my $val (@$prop) { | |
228 | $content .= "$pname=$val\n"; | |
229 | } | |
230 | } else { | |
231 | die "invalid property '$pname'\n"; | |
232 | } | |
233 | } | |
234 | $content .= "\n"; | |
235 | } | |
236 | ||
237 | file_set_contents($filename, $content); | |
238 | }; | |
239 | ||
f024a872 | 240 | 1; |