nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix system: Simply warn if we cannot talk to the shepherd. 

Before that 'open-connection' would return #f, and thus
'current-services' would return a single #f value when its continuation
expects two.

Reported by calher on #guix.

* gnu/services/herd.scm (open-connection): Rethrow system-error
exceptions.
(with-shepherd): Expect CONNECTION to always be true; remove useless
'dynamic-wind'.
* guix/scripts/system.scm (warn-on-system-error): New macro.
(upgrade-shepherd-services): Wrap body in 'warn-on-system-error'.
This commit is contained in:
Ludovic Courtès 2016-02-05 11:39:27 +01:00
parent 6b55ee8889
commit 1d6b7d5847
2 changed files with 49 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gnu/services/herd.scm
View File

@ -52,20 +52,14 @@ return the socket."
(connect sock address) (connect sock address)
(setvbuf sock _IOFBF 1024) (setvbuf sock _IOFBF 1024)
sock) sock)
(lambda (key proc format-string format-args errno . rest) (lambda args
(warning (_ "cannot connect to ~a: ~a~%") file (close-port sock)
(apply format #f format-string format-args)) (apply throw args))))))
#f)))))
(define-syntax-rule (with-shepherd connection body ...) (define-syntax-rule (with-shepherd connection body ...)
"Evaluate BODY... with CONNECTION bound to an open socket to PID 1." "Evaluate BODY... with CONNECTION bound to an open socket to PID 1."
(let ((connection (open-connection))) (let ((connection (open-connection)))
(and connection body ...))
(dynamic-wind
(const #t)
(lambda ()
body ...)
(const #t)))))
(define (report-action-error error) (define (report-action-error error)
"Report ERROR, an sexp received by a shepherd client in reply to COMMAND, a "Report ERROR, an sexp received by a shepherd client in reply to COMMAND, a

14
guix/scripts/system.scm
View File

@ -211,6 +211,16 @@ the ownership of '~a' may be incorrect!~%")
(lambda () (lambda ()
(environ env))))) (environ env)))))
(define-syntax-rule (warn-on-system-error body ...)
(catch 'system-error
(lambda ()
body ...)
(lambda (key proc format-string format-args errno . rest)
(warning (_ "while talking to shepherd: ~a~%")
(apply format #f format-string format-args))
(with-monad %store-monad
(return #f)))))
(define (upgrade-shepherd-services os) (define (upgrade-shepherd-services os)
"Upgrade the Shepherd (PID 1) by unloading obsolete services and loading new "Upgrade the Shepherd (PID 1) by unloading obsolete services and loading new
services specified in OS and not currently running. services specified in OS and not currently running.
@ -230,6 +240,8 @@ bring the system down."
(map (compose first shepherd-service-provision) (map (compose first shepherd-service-provision)
new-services)) new-services))
;; Arrange to simply emit a warning if we cannot connect to the shepherd.
(warn-on-system-error
(let-values (((running stopped) (current-services))) (let-values (((running stopped) (current-services)))
(define to-load (define to-load
;; Only load services that are either new or currently stopped. ;; Only load services that are either new or currently stopped.
@ -265,7 +277,7 @@ bring the system down."
(for-each start-service (for-each start-service
(map shepherd-service-canonical-name to-start)) (map shepherd-service-canonical-name to-start))
(return #t))))))) (return #t))))))))
(define* (switch-to-system os (define* (switch-to-system os
#:optional (profile %system-profile)) #:optional (profile %system-profile))