summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-08-31 15:40:00 +0200
committerLudovic Courtès <ludo@gnu.org>2016-08-31 15:44:20 +0200
commit7b44cae50aed1d6d67337e9eae9f449ccd00a870 (patch)
treefa0b5237fcc146217dc5ac2210bffac127a0b71c /gnu/services
parentd4f8884fdb897e648fd7f4262b2142d8c363ac76 (diff)
downloadpatches-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')
-rw-r--r--gnu/services/shepherd.scm52
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