Merge remote-tracking branch 'origin/master' into staging

With resolved conflicts in:
	gnu/packages/bittorrent.scm
	gnu/packages/databases.scm
	gnu/packages/geo.scm
	gnu/packages/gnupg.scm
	gnu/packages/gstreamer.scm
	gnu/packages/gtk.scm
	gnu/packages/linux.scm
	gnu/packages/python-xyz.scm
	gnu/packages/xorg.scm
	guix/build/qt-utils.scm

2 files changed, 41 insertions, 5 deletions

diff --git a/gnu/machine/digital-ocean.scm b/gnu/machine/digital-ocean.scm
index 82383a8c7c..90b66a54d9 100644
--- a/gnu/machine/digital-ocean.scm
+++ b/gnu/machine/digital-ocean.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -234,7 +235,7 @@ cat > /etc/bootstrap-config.scm << EOF
   (timezone \"Etc/UTC\")
   (bootloader (bootloader-configuration
                (bootloader grub-bootloader)
-               (target \"/dev/vda\")
+               (targets '(\"/dev/vda\"))
                (terminal-outputs '(console))))
   (file-systems (cons (file-system
                         (mount-point \"/\")
@@ -256,7 +257,7 @@ cat > /etc/bootstrap-config.scm << EOF
                  (service openssh-service-type
                           (openssh-configuration
                            (log-level 'debug)
-                           (permit-root-login 'without-password))))
+                           (permit-root-login 'prohibit-password))))
            %base-services)))
 EOF
 # guix pull
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fa942169c4..ecd02e336c 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -38,6 +38,9 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module ((guix inferior)
+                #:select (inferior-exception?
+                          inferior-exception-arguments))
   #:use-module (gcrypt pk-crypto)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -443,17 +446,47 @@ have you run 'guix archive --generate-key?'")
   (mlet %store-monad ((_ (check-deployment-sanity machine))
                       (boot-parameters (machine-boot-parameters machine)))
     (let* ((os (machine-operating-system machine))
+           (host (machine-ssh-configuration-host-name
+                  (machine-configuration machine)))
            (eval (cut machine-remote-eval machine <>))
            (menu-entries (map boot-parameters->menu-entry boot-parameters))
            (bootloader-configuration (operating-system-bootloader os))
            (bootcfg (operating-system-bootcfg os menu-entries)))
+      (define-syntax-rule (eval/error-handling condition handler ...)
+        ;; Return a wrapper around EVAL such that HANDLER is evaluated if an
+        ;; exception is raised.
+        (lambda (exp)
+          (lambda (store)
+            (guard (condition ((inferior-exception? condition)
+                               (values (begin handler ...) store)))
+              (values (run-with-store store (eval exp))
+                      store)))))
+
       (mbegin %store-monad
         (with-roll-back #f
-          (switch-to-system eval os))
+          (switch-to-system (eval/error-handling c
+                              (raise (formatted-message
+                                      (G_ "\
+failed to switch systems while deploying '~a':~%~{~s ~}")
+                                      host
+                                      (inferior-exception-arguments c))))
+                            os))
         (with-roll-back #t
           (mbegin %store-monad
-            (upgrade-shepherd-services eval os)
-            (install-bootloader eval bootloader-configuration bootcfg)))))))
+            (upgrade-shepherd-services (eval/error-handling c
+                                         (warning (G_ "\
+an error occurred while upgrading services on '~a':~%~{~s ~}~%")
+                                                  host
+                                                  (inferior-exception-arguments
+                                                   c)))
+                                       os)
+            (install-bootloader (eval/error-handling c
+                                  (raise (formatted-message
+                                          (G_ "\
+failed to install bootloader on '~a':~%~{~s ~}~%")
+                                          host
+                                          (inferior-exception-arguments c))))
+                                bootloader-configuration bootcfg)))))))
 
 
 ;;;
@@ -540,4 +573,6 @@ for environment of type '~a'")
 
 ;; Local Variables:
 ;; eval: (put 'remote-let 'scheme-indent-function 1)
+;; eval: (put 'with-roll-back 'scheme-indent-function 1)
+;; eval: (put 'eval/error-handling 'scheme-indent-function 1)
 ;; End: