diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-08-31 15:40:00 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-08-31 15:44:20 +0200 |
commit | 7b44cae50aed1d6d67337e9eae9f449ccd00a870 (patch) | |
tree | fa0b5237fcc146217dc5ac2210bffac127a0b71c /gnu/services/shepherd.scm | |
parent | d4f8884fdb897e648fd7f4262b2142d8c363ac76 (diff) | |
download | patches-7b44cae50aed1d6d67337e9eae9f449ccd00a870.tar patches-7b44cae50aed1d6d67337e9eae9f449ccd00a870.tar.gz |
services: shepherd: Add 'shepherd-service-upgrade', from 'guix system'.
* guix/scripts/system.scm (service-upgrade): Move to...
* gnu/services/shepherd.scm (shepherd-service-upgrade): ... here.
* tests/system.scm ("service-upgrade: nothing to do", "service-upgrade:
one unchanged, one upgraded, one new", "service-upgrade: service
depended on is not unloaded", "service-upgrade: obsolete services that
depend on each other"): Move to...
* tests/services.scm: ... here. Adjust to 'service-upgrade' rename.
Diffstat (limited to 'gnu/services/shepherd.scm')
-rw-r--r-- | gnu/services/shepherd.scm | 52 |
1 files changed, 51 insertions, 1 deletions
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 426b0e7290..3273184b9a 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -25,6 +25,7 @@ #:use-module (guix records) #:use-module (guix derivations) ;imported-modules, etc. #:use-module (gnu services) + #:use-module (gnu services herd) #:use-module (gnu packages admin) #:use-module (ice-9 match) #:use-module (ice-9 vlist) @@ -53,7 +54,8 @@ shepherd-service-file shepherd-service-lookup-procedure - shepherd-service-back-edges)) + shepherd-service-back-edges + shepherd-service-upgrade)) ;;; Commentary: ;;; @@ -293,4 +295,52 @@ symbols provided/required by a service." (lambda (service) (vhash-foldq* cons '() service edges))) +(define (shepherd-service-upgrade live target) + "Return two values: the subset of LIVE (a list of <live-service>) that needs +to be unloaded, and the subset of TARGET (a list of <shepherd-service>) that +needs to be loaded." + (define (essential? service) + (memq (first (live-service-provision service)) + '(root shepherd))) + + (define lookup-target + (shepherd-service-lookup-procedure target + shepherd-service-provision)) + + (define lookup-live + (shepherd-service-lookup-procedure live + live-service-provision)) + + (define (running? service) + (and=> (lookup-live (shepherd-service-canonical-name service)) + live-service-running)) + + (define (stopped service) + (match (lookup-live (shepherd-service-canonical-name service)) + (#f #f) + (service (and (not (live-service-running service)) + service)))) + + (define live-service-dependents + (shepherd-service-back-edges live + #:provision live-service-provision + #:requirement live-service-requirement)) + + (define (obsolete? service) + (match (lookup-target (first (live-service-provision service))) + (#f (every obsolete? (live-service-dependents service))) + (_ #f))) + + (define to-load + ;; Only load services that are either new or currently stopped. + (remove running? target)) + + (define to-unload + ;; Unload services that are (1) no longer required, or (2) are in TO-LOAD. + (remove essential? + (append (filter obsolete? live) + (filter-map stopped to-load)))) + + (values to-unload to-load)) + ;;; shepherd.scm ends here |