guix system: Do not unload services depended on.
Reported by Mark H Weaver <mhw@netris.org> at <https://lists.gnu.org/archive/html/guix-devel/2016-08/msg01470.html>. * guix/scripts/system.scm (service-upgrade)[live-service-required?]: New procedure. [obsolete?]: Use it. * tests/system.scm ("service-upgrade: service depended on is not unloaded", "service-upgrade: obsolete services that depend on each other"): New tests.
This commit is contained in:
parent
6673bddc9a
commit
d4f8884fdb
|
@ -298,9 +298,14 @@ needs to be loaded."
|
|||
(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 #t)
|
||||
(#f (every obsolete? (live-service-dependents service)))
|
||||
(_ #f)))
|
||||
|
||||
(define to-load
|
||||
|
|
|
@ -149,4 +149,36 @@
|
|||
(list (map live-service-provision unload)
|
||||
(map shepherd-service-provision load)))))
|
||||
|
||||
(test-equal "service-upgrade: service depended on is not unloaded"
|
||||
'(((baz)) ;unload
|
||||
()) ;load
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
;; Service 'bar' is not among the target services; yet, it must not be
|
||||
;; unloaded because 'foo' depends on it.
|
||||
(service-upgrade (list (live-service '(foo) '(bar) #t)
|
||||
(live-service '(bar) '() #t) ;still used!
|
||||
(live-service '(baz) '() #t))
|
||||
(list (shepherd-service (provision '(foo))
|
||||
(start #t)))))
|
||||
(lambda (unload load)
|
||||
(list (map live-service-provision unload)
|
||||
(map shepherd-service-provision load)))))
|
||||
|
||||
(test-equal "service-upgrade: obsolete services that depend on each other"
|
||||
'(((foo) (bar) (baz)) ;unload
|
||||
((qux))) ;load
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
;; 'foo', 'bar', and 'baz' depend on each other, but all of them are
|
||||
;; obsolete, and thus should be unloaded.
|
||||
(service-upgrade (list (live-service '(foo) '(bar) #t) ;obsolete
|
||||
(live-service '(bar) '(baz) #t) ;obsolete
|
||||
(live-service '(baz) '() #t)) ;obsolete
|
||||
(list (shepherd-service (provision '(qux))
|
||||
(start #t)))))
|
||||
(lambda (unload load)
|
||||
(list (map live-service-provision unload)
|
||||
(map shepherd-service-provision load)))))
|
||||
|
||||
(test-end)
|
||||
|
|
Loading…
Reference in New Issue