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:
edef 2017-08-12 21:14:36 +02:00
parent 542ef2b182
commit 54a13b07d5
2 changed files with 11 additions and 11 deletions

View File

@ -4,6 +4,7 @@ use strict;
use warnings; use warnings;
use File::Basename; use File::Basename;
use File::Slurp; use File::Slurp;
use Net::DBus;
use Sys::Syslog qw(:standard :macros); use Sys::Syslog qw(:standard :macros);
use Cwd 'abs_path'; use Cwd 'abs_path';
@ -67,17 +68,15 @@ EOF
$SIG{PIPE} = "IGNORE"; $SIG{PIPE} = "IGNORE";
sub getActiveUnits { sub getActiveUnits {
# FIXME: use D-Bus or whatever to query this, since parsing the my $mgr = Net::DBus->system->get_service("org.freedesktop.systemd1")->get_object("/org/freedesktop/systemd1");
# output of list-units is likely to break. my $units = $mgr->ListUnitsByPatterns([], []);
# 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 $res = {}; my $res = {};
foreach my $line (split '\n', $lines) { for my $item (@$units) {
chomp $line; my ($id, $description, $load_state, $active_state, $sub_state,
last if $line eq ""; $following, $unit_path, $job_id, $job_type, $job_path) = @$item;
$line =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s/ or next; next unless $following eq '';
next if $1 eq "UNIT"; next if $job_id == 0 and $active_state eq 'inactive';
$res->{$1} = { load => $2, state => $3, substate => $4 }; $res->{$id} = { load => $load_state, state => $active_state, substate => $sub_state };
} }
return $res; return $res;
} }

View File

@ -127,7 +127,8 @@ let
configurationName = config.boot.loader.grub.configurationName; configurationName = config.boot.loader.grub.configurationName;
# Needed by switch-to-configuration. # 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)}"); } else throw "\nFailed assertions:\n${concatStringsSep "\n" (map (x: "- ${x}") failed)}");
# Replace runtime dependencies # Replace runtime dependencies