me
/
guix
Archived
1
0
Fork 0
Code

services: herd: Add a new 'current-service' procedure. 

* gnu/services/herd.scm (current-service): New procedure, mostly reusing the
existing current-services.
(current-services): Implement in terms of the above procedure.
Maxim Cournoyer 2023-05-18 20:21:35 -04:00
parent c4713ad89d
commit f15c5edb1a
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
1 changed files with 33 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
gnu/services/herd.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2019, 2022-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2019, 2022-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -51,6 +52,7 @@
live-service-canonical-name live-service-canonical-name
with-shepherd-action with-shepherd-action
current-service
current-services current-services
unload-services unload-services
unload-service unload-service
@ -208,31 +210,43 @@ of pairs."
"Return the 'canonical name' of SERVICE." "Return the 'canonical name' of SERVICE."
(first (live-service-provision service))) (first (live-service-provision service)))
(define (current-services) (define (current-service name)
"Return the list of currently defined Shepherd services, represented as "Return the currently defined Shepherd service NAME, as a <live-service>
<live-service> objects. Return #f if the list of services could not be object. Return #f if the service could not be obtained. As a special case,
obtained." @code{(current-service 'root)} returns all the current services."
(with-shepherd-action 'root ('status) results (define (process-services services)
;; We get a list of results, one for each service with the name 'root'. (resolve-transients
(map (lambda (service)
(alist-let* service (provides requires running transient?)
;; The Shepherd 0.9.0 would not provide 'transient?' in
;; its status sexp. Thus, when it's missing, query it
;; via an "eval" request.
(live-service provides requires
(if (sloppy-assq 'transient? service)
transient?
(and running *unspecified*))
running)))
services)))
(with-shepherd-action name ('status) results
;; We get a list of results, one for each service with the name NAME.
;; In practice there's only one such service though. ;; In practice there's only one such service though.
(match results (match results
((services _ ...) ((services _ ...)
(match services (match services
((('service ('version 0 _ ...) _ ...) ...) ((('service ('version 0 _ ...) _ ...) ...)
(resolve-transients ;; Summary of all services (when NAME is 'root or 'shepherd).
(map (lambda (service) (process-services services))
(alist-let* service (provides requires running transient?) (('service ('version 0 _ ...) _ ...) ;single service
;; The Shepherd 0.9.0 would not provide 'transient?' in its (first (process-services (list services))))
;; status sexp. Thus, when it's missing, query it via an
;; "eval" request.
(live-service provides requires
(if (sloppy-assq 'transient? service)
transient?
(and running *unspecified*))
running)))
services)))
(x (x
#f)))))) #f)))))) ;singleton
(define (current-services)
"Return the list of currently defined Shepherd services, represented as
<live-service> objects. Return #f if the list of services could not be
obtained."
(current-service 'root))
(define (resolve-transients services) (define (resolve-transients services)
"Resolve the subset of SERVICES whose 'transient?' field is undefined. This "Resolve the subset of SERVICES whose 'transient?' field is undefined. This