From 7b44cae50aed1d6d67337e9eae9f449ccd00a870 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 31 Aug 2016 15:40:00 +0200 Subject: 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. --- guix/scripts/system.scm | 50 +------------------------------------------------ 1 file changed, 1 insertion(+), 49 deletions(-) (limited to 'guix/scripts/system.scm') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index bcf19dbb7e..953c6243ed 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -272,54 +272,6 @@ on service '~a':~%") ((not error) ;not an error #t))) -(define (service-upgrade live target) - "Return two values: the subset of LIVE (a list of ) that needs -to be unloaded, and the subset of TARGET (a list of ) 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)) - (define (call-with-service-upgrade-info new-services mproc) "Call MPROC, a monadic procedure in %STORE-MONAD, passing it the list of names of services to load (upgrade), and the list of names of services to @@ -327,7 +279,7 @@ unload." (match (current-services) ((services ...) (let-values (((to-unload to-load) - (service-upgrade services new-services))) + (shepherd-service-upgrade services new-services))) (mproc to-load (map (compose first live-service-provision) to-unload)))) -- cgit v1.2.3