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
542ef2b182
commit
54a13b07d5
@ -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 pkgs.perlPackages; [ FileSlurp NetDBus XMLParser XMLTwig ]));
|
||||
} else throw "\nFailed assertions:\n${concatStringsSep "\n" (map (x: "- ${x}") failed)}");
|
||||
|
||||
# Replace runtime dependencies
|
||||
|
Loading…
Reference in New Issue
Block a user