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'.

gnu/services/herd.scm

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

guix/scripts/system.scm

@@ -211,6 +211,16 @@ the ownership of '~a' may be incorrect!~%")
       (lambda ()
         (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)
   "Upgrade the Shepherd (PID 1) by unloading obsolete services and loading new
 services specified in OS and not currently running.
@@ -230,6 +240,8 @@ bring the system down."
     (map (compose first shepherd-service-provision)
          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)))
      (define to-load
        ;; Only load services that are either new or currently stopped.
@@ -265,7 +277,7 @@ bring the system down."
 
              (for-each start-service
                        (map shepherd-service-canonical-name to-start))
-            (return #t)))))))
+             (return #t))))))))
 
 (define* (switch-to-system os
                            #:optional (profile %system-profile))