diff options
author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-10-01 17:10:49 -0400 |
---|---|---|
committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-10-01 17:10:49 -0400 |
commit | 2e65e4834a226c570866f2e8976ed7f252b45cd1 (patch) | |
tree | 21d625bce8d03627680214df4a6622bf8eb79dc9 /gnu/machine | |
parent | 9c68ecb24dd1660ce736cdcdea0422a73ec318a2 (diff) | |
parent | f1a3c11407b52004e523ec5de20d326c5661681f (diff) |
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
Diffstat (limited to 'gnu/machine')
-rw-r--r-- | gnu/machine/digital-ocean.scm | 5 | ||||
-rw-r--r-- | gnu/machine/ssh.scm | 41 |
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: |