[bug#75010,2/7] gnu: machine: ssh: Refactor roll-back-managed-host.
Commit Message
* gnu/machine/ssh.scm (roll-back-managed-host): Use let* and mbegin.
Change-Id: Ic3d5039ecf01e1e965dce8a696e7dbd625d2b3c5
---
gnu/machine/ssh.scm | 53 ++++++++++++++++++++++-----------------------
1 file changed, 26 insertions(+), 27 deletions(-)
Comments
Hi,
Herman Rimm <herman@rimm.ee> skribis:
> * gnu/machine/ssh.scm (roll-back-managed-host): Use let* and mbegin.
>
> Change-Id: Ic3d5039ecf01e1e965dce8a696e7dbd625d2b3c5
[...]
> + (mmatch %store-monad (machine-boot-parameters machine)
> + ((_ params rest ...)
> + (let* ((entries (list (boot-parameters->menu-entry params)))
> + (locale (boot-parameters-locale params))
> + (crypto-dev (boot-parameters-store-crypto-devices params))
> + (store-dir (boot-parameters-store-directory-prefix params))
> + (old-entries (map boot-parameters->menu-entry rest))
> + (bootloader (operating-system-bootloader
> + (machine-operating-system machine)))
> + (generate-bootloader-configuration-file
> + (bootloader-configuration-file-generator
> + (bootloader-configuration-bootloader bootloader))))
> + (mbegin %store-monad
> + (lower-object (generate-bootloader-configuration-file
> + bootloader entries
> + #:locale locale
> + #:store-crypto-devices crypto-dev
> + #:store-directory-prefix store-dir
> + #:old-entries old-entries)))
> + (mlet %store-monad
> + ((remote-result (machine-remote-eval machine remote-exp)))
> + (when (eqv? 'error remote-result)
> + (raise roll-back-failure)))))
The (mbegin …) expression has no effect because it’s not in tail
position (it expands to (lambda (…) …)).
Even if it had an effect, generating the bootloader config file in
itself does nothing: it has to at least be copied to the right place or
passed as an argument to ‘grub-install’ or similar.
The following ‘mlet’ should use ‘mwhen’ rather than ‘when’ to return a
monadic value when the condition is false.
These two bugs are actually already present in ‘master’, so I guess
we’re dealing with untested code. 😱
(We should come up with a strategy to test those things.)
Ludo’.
@@ -2,6 +2,8 @@
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2020-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Ricardo <rekado@elephly.net>
+;;; Copyright © 2024 Felix Lechner <felix.lechner@lease-up.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -589,33 +591,30 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
- (_ -> (if (< (length boot-parameters) 2)
- (raise roll-back-failure)))
- (entries -> (map boot-parameters->menu-entry
- (list (second boot-parameters))))
- (locale -> (boot-parameters-locale
- (second boot-parameters)))
- (crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-parameters)))
- (store-dir -> (boot-parameters-store-directory-prefix
- (second boot-parameters)))
- (old-entries -> (map boot-parameters->menu-entry
- (drop boot-parameters 2)))
- (bootloader -> (operating-system-bootloader
- (machine-operating-system machine)))
- (bootcfg (lower-object
- ((bootloader-configuration-file-generator
- (bootloader-configuration-bootloader
- bootloader))
- bootloader entries
- #:locale locale
- #:store-crypto-devices crypto-dev
- #:store-directory-prefix store-dir
- #:old-entries old-entries)))
- (remote-result (machine-remote-eval machine remote-exp)))
- (when (eqv? 'error remote-result)
- (raise roll-back-failure))))
+ (mmatch %store-monad (machine-boot-parameters machine)
+ ((_ params rest ...)
+ (let* ((entries (list (boot-parameters->menu-entry params)))
+ (locale (boot-parameters-locale params))
+ (crypto-dev (boot-parameters-store-crypto-devices params))
+ (store-dir (boot-parameters-store-directory-prefix params))
+ (old-entries (map boot-parameters->menu-entry rest))
+ (bootloader (operating-system-bootloader
+ (machine-operating-system machine)))
+ (generate-bootloader-configuration-file
+ (bootloader-configuration-file-generator
+ (bootloader-configuration-bootloader bootloader))))
+ (mbegin %store-monad
+ (lower-object (generate-bootloader-configuration-file
+ bootloader entries
+ #:locale locale
+ #:store-crypto-devices crypto-dev
+ #:store-directory-prefix store-dir
+ #:old-entries old-entries)))
+ (mlet %store-monad
+ ((remote-result (machine-remote-eval machine remote-exp)))
+ (when (eqv? 'error remote-result)
+ (raise roll-back-failure)))))
+ (_ (raise roll-back-failure))))
;;;