]>
git.proxmox.com Git - pve-common.git/blob - src/PVE/Systemd.pm
6 use Net
::DBus
qw(dbus_uint32 dbus_uint64);
7 use Net
::DBus
::Callback
;
8 use Net
::DBus
::Reactor
;
10 use PVE
::Tools
qw(file_set_contents file_get_contents trim);
13 my ($val, $is_path) = @_;
15 # NOTE: this is not complete, but enough for our needs. normally all
16 # characters which are not alpha-numerical, '.' or '_' would need escaping
32 $val =~ s/\\x([a-fA-F0-9]{2})/chr(hex($1))/eg;
37 # $code should take the parameters ($interface, $reactor, $finish_callback).
39 # $finish_callback can be used by dbus-signal-handlers to stop the reactor.
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.
43 # NOTE: This calls the dbus main loop and must not be used when another dbus
44 # main loop is being used as we need to wait signals.
45 sub systemd_call
($;$) {
46 my ($code, $timeout) = @_;
48 my $bus = Net
::DBus-
>system();
49 my $reactor = Net
::DBus
::Reactor-
>main();
51 my $service = $bus->get_service('org.freedesktop.systemd1');
52 my $if = $service->get_object('/org/freedesktop/systemd1', 'org.freedesktop.systemd1.Manager');
54 my ($finished, $current_result, $timer);
55 my $finish_callback = sub {
58 $current_result = $result;
62 if (defined($timer)) {
63 $reactor->remove_timeout($timer);
67 if (defined($reactor)) {
73 my $result = $code->($if, $reactor, $finish_callback);
74 # Are we done immediately?
75 return $result if defined $result;
77 # Alterantively $finish_callback may have been called already?
78 return $current_result if $finished;
81 my $on_timeout = sub {
82 $finish_callback->(undef);
83 die "timeout waiting on systemd\n";
85 $timer = $reactor->add_timeout($timeout * 1000, Net
::DBus
::Callback-
>new(method => $on_timeout))
89 $reactor->shutdown() if defined($reactor); # $finish_callback clears it
91 return $current_result;
94 # Polling the job status instead doesn't work because this doesn't give us the
95 # distinction between success and failure.
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);
102 my $timeout = delete $extra{timeout
};
105 my $properties = [ [PIDs
=> [dbus_uint32
($$)]] ];
107 foreach my $key (keys %extra) {
108 if ($key eq 'Slice' || $key eq 'KillMode') {
109 push @{$properties}, [$key, $extra{$key}];
110 } elsif ($key eq 'CPUShares' || $key eq 'CPUWeight') {
111 push @{$properties}, [$key, dbus_uint64
($extra{$key})];
112 } elsif ($key eq 'CPUQuota') {
113 push @{$properties}, ['CPUQuotaPerSecUSec',
114 dbus_uint64
($extra{$key} * 10_000)];
116 die "Don't know how to encode $key for systemd scope\n";
121 my ($if, $reactor, $finish_cb) = @_;
125 $if->connect_to_signal('JobRemoved', sub {
126 my ($id, $removed_job, $signaled_unit, $result) = @_;
127 return if $signaled_unit ne $unit || $removed_job ne $job;
128 if ($result ne 'done') {
129 # I seem to remember $reactor->run() catching die() at some point?
130 # so better call finish to be sure...:
132 die "systemd job failed\n";
138 $job = $if->StartTransientUnit($unit, 'fail', $properties, []);
144 sub wait_for_unit_removed
($;$) {
145 my ($unit, $timeout) = @_;
148 my ($if, $reactor, $finish_cb) = @_;
150 my $unit_obj = eval { $if->GetUnit($unit) };
151 return 1 if !$unit_obj;
153 $if->connect_to_signal('UnitRemoved', sub {
154 my ($id, $removed_unit) = @_;
155 $finish_cb->(1) if $removed_unit eq $unit_obj;
158 # Deal with what we lost between GetUnit() and connecting to UnitRemoved:
159 my $unit_obj_new = eval { $if->GetUnit($unit) };
160 if (!$unit_obj_new) {
171 my $content = file_get_contents
($filename);
172 my @lines = split /\n/, $content;
177 foreach my $line (@lines) {
179 if ($line =~ m/^\[([^\]]+)\]/) {
181 if (!defined($result->{$section})) {
182 $result->{$section} = {};
184 } elsif ($line =~ m/^(.*?)=(.*)$/) {
185 my ($key, $val) = ($1, $2);
187 warn "key value pair found without section, skipping\n";
191 if ($result->{$section}->{$key}) {
192 # make duplicate properties to arrays to keep the order
193 my $prop = $result->{$section}->{$key};
194 if (ref($prop) eq 'ARRAY') {
197 $result->{$section}->{$key} = [$prop, $val];
200 $result->{$section}->{$key} = $val;
203 # ignore everything else
210 my ($ini, $filename) = @_;
214 foreach my $sname (sort keys %$ini) {
215 my $section = $ini->{$sname};
217 $content .= "[$sname]\n";
219 foreach my $pname (sort keys %$section) {
220 my $prop = $section->{$pname};
223 $content .= "$pname=$prop\n";
224 } elsif (ref($prop) eq 'ARRAY') {
225 foreach my $val (@$prop) {
226 $content .= "$pname=$val\n";
229 die "invalid property '$pname'\n";
235 file_set_contents
($filename, $content);