amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: shepherd: Make 'shepherd-configuration-file' non-monadic.

Browse source 
Suggested by atw on #guix.

* gnu/services/shepherd.scm (shepherd-service-file): Use 'scheme-file'
instead of 'gexp->file'.
(shepherd-configuration-file): Likewise, and adjust to non-monadic
style.
(shepherd-boot-gexp): Adjust accordingly.
* guix/scripts/system.scm (upgrade-shepherd-services): Use
'lower-object' in addition to 'shepherd-service-file'.
This commit is contained in:
Ludovic Courtès 2018-01-20 23:17:23 +01:00
parent 7175abaaa4
commit 33033a620e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

34
gnu/services/shepherd.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -66,7 +66,7 @@
(define (shepherd-boot-gexp services) (define (shepherd-boot-gexp services)
(mlet %store-monad ((shepherd-conf (shepherd-configuration-file services))) (with-monad %store-monad
(return #~(begin (return #~(begin
;; Keep track of the booted system. ;; Keep track of the booted system.
(false-if-exception (delete-file "/run/booted-system")) (false-if-exception (delete-file "/run/booted-system"))
@ -84,7 +84,8 @@
;; Start shepherd. ;; Start shepherd.
(execl #$(file-append shepherd "/bin/shepherd") (execl #$(file-append shepherd "/bin/shepherd")
"shepherd" "--config" #$shepherd-conf))))) "shepherd" "--config"
#$(shepherd-configuration-file services))))))
(define shepherd-root-service-type (define shepherd-root-service-type
(service-type (service-type
@ -203,25 +204,24 @@ stored."
(define (shepherd-service-file service) (define (shepherd-service-file service)
"Return a file defining SERVICE." "Return a file defining SERVICE."
(gexp->file (shepherd-service-file-name service) (scheme-file (shepherd-service-file-name service)
(with-imported-modules %default-imported-modules (with-imported-modules %default-imported-modules
#~(begin #~(begin
(use-modules #$@(shepherd-service-modules service)) (use-modules #$@(shepherd-service-modules service))
(make <service> (make <service>
#:docstring '#$(shepherd-service-documentation service) #:docstring '#$(shepherd-service-documentation service)
#:provides '#$(shepherd-service-provision service) #:provides '#$(shepherd-service-provision service)
#:requires '#$(shepherd-service-requirement service) #:requires '#$(shepherd-service-requirement service)
#:respawn? '#$(shepherd-service-respawn? service) #:respawn? '#$(shepherd-service-respawn? service)
#:start #$(shepherd-service-start service) #:start #$(shepherd-service-start service)
#:stop #$(shepherd-service-stop service)))))) #:stop #$(shepherd-service-stop service))))))
(define (shepherd-configuration-file services) (define (shepherd-configuration-file services)
"Return the shepherd configuration file for SERVICES." "Return the shepherd configuration file for SERVICES."
(assert-valid-graph services) (assert-valid-graph services)
(mlet %store-monad ((files (mapm %store-monad (let ((files (map shepherd-service-file services)))
shepherd-service-file services)))
(define config (define config
#~(begin #~(begin
(use-modules (srfi srfi-34) (use-modules (srfi srfi-34)
@ -252,7 +252,7 @@ stored."
(filter shepherd-service-auto-start? (filter shepherd-service-auto-start?
services))))))) services)))))))
(gexp->file "shepherd.conf" config))) (scheme-file "shepherd.conf" config)))
(define* (shepherd-service-lookup-procedure services (define* (shepherd-service-lookup-procedure services
#:optional #:optional

6
guix/scripts/system.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@ -331,7 +331,9 @@ bring the system down."
(let ((to-load-names (map shepherd-service-canonical-name to-load)) (let ((to-load-names (map shepherd-service-canonical-name to-load))
(to-start (filter shepherd-service-auto-start? to-load))) (to-start (filter shepherd-service-auto-start? to-load)))
(info (G_ "loading new services:~{ ~a~}...~%") to-load-names) (info (G_ "loading new services:~{ ~a~}...~%") to-load-names)
(mlet %store-monad ((files (mapm %store-monad shepherd-service-file (mlet %store-monad ((files (mapm %store-monad
(compose lower-object
shepherd-service-file)
to-load))) to-load)))
;; Here we assume that FILES are exactly those that were computed ;; Here we assume that FILES are exactly those that were computed
;; as part of the derivation that built OS, which is normally the ;; as part of the derivation that built OS, which is normally the