switch-to-configuration: use Net::DBus to retrieve the list of units
This resolves the FIXME, and opens up the possibility of using more of the systemd DBus interface to make things more robust.
This commit is contained in:
parent
e65676d25d
commit
2fa1165e89
2 changed files with 11 additions and 11 deletions
|
@ -4,6 +4,7 @@ use strict;
|
|||
use warnings;
|
||||
use File::Basename;
|
||||
use File::Slurp;
|
||||
use Net::DBus;
|
||||
use Sys::Syslog qw(:standard :macros);
|
||||
use Cwd 'abs_path';
|
||||
|
||||
|
@ -67,17 +68,15 @@ EOF
|
|||
$SIG{PIPE} = "IGNORE";
|
||||
|
||||
sub getActiveUnits {
|
||||
# FIXME: use D-Bus or whatever to query this, since parsing the
|
||||
# output of list-units is likely to break.
|
||||
# Use current version of systemctl binary before daemon is reexeced.
|
||||
my $lines = `LANG= /run/current-system/sw/bin/systemctl list-units --full --no-legend`;
|
||||
my $mgr = Net::DBus->system->get_service("org.freedesktop.systemd1")->get_object("/org/freedesktop/systemd1");
|
||||
my $units = $mgr->ListUnitsByPatterns([], []);
|
||||
my $res = {};
|
||||
foreach my $line (split '\n', $lines) {
|
||||
chomp $line;
|
||||
last if $line eq "";
|
||||
$line =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s/ or next;
|
||||
next if $1 eq "UNIT";
|
||||
$res->{$1} = { load => $2, state => $3, substate => $4 };
|
||||
for my $item (@$units) {
|
||||
my ($id, $description, $load_state, $active_state, $sub_state,
|
||||
$following, $unit_path, $job_id, $job_type, $job_path) = @$item;
|
||||
next unless $following eq '';
|
||||
next if $job_id == 0 and $active_state eq 'inactive';
|
||||
$res->{$id} = { load => $load_state, state => $active_state, substate => $sub_state };
|
||||
}
|
||||
return $res;
|
||||
}
|
||||
|
|
|
@ -127,7 +127,8 @@ let
|
|||
configurationName = config.boot.loader.grub.configurationName;
|
||||
|
||||
# Needed by switch-to-configuration.
|
||||
perl = "${pkgs.perl}/bin/perl -I${pkgs.perlPackages.FileSlurp}/lib/perl5/site_perl";
|
||||
|
||||
perl = "${pkgs.perl}/bin/perl " + (concatMapStringsSep " " (lib: "-I${lib}/${pkgs.perl.libPrefix}") (with perlPackages; [ FileSlurp NetDBus XMLParser XMLTwig ]));
|
||||
} else throw "\nFailed assertions:\n${concatStringsSep "\n" (map (x: "- ${x}") failed)}");
|
||||
|
||||
# Replace runtime dependencies
|
||||
|
|
Loading…
Reference in a new issue