Skip to content
Snippets Groups Projects
Commit c3e79cde authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

guix system: Factorize 'grub-install' error handling, and use more 'mbegin'.

* guix/scripts/system.scm (install-grub*): New procedure.
  (install): Use it, and use 'mwhen?'.
  (perform-action) <reconfigure>: Likewise.
parent bb986599
No related branches found
No related tags found
No related merge requests found
...@@ -131,6 +131,14 @@ (define* (copy-closure item target ...@@ -131,6 +131,14 @@ (define* (copy-closure item target
(map (cut copy-item <> target #:log-port log-port) (map (cut copy-item <> target #:log-port log-port)
to-copy)))) to-copy))))
(define (install-grub* grub.cfg device target)
"This is a variant of 'install-grub' with error handling, lifted in
%STORE-MONAD"
(with-monad %store-monad
(unless (false-if-exception (install-grub grub.cfg device target))
(leave (_ "failed to install GRUB on device '~a'~%") device))
(return #t)))
(define* (install os-drv target (define* (install os-drv target
#:key (log-port (current-output-port)) #:key (log-port (current-output-port))
grub? grub.cfg device) grub? grub.cfg device)
...@@ -162,11 +170,8 @@ (define (maybe-copy to-copy) ...@@ -162,11 +170,8 @@ (define (maybe-copy to-copy)
(format log-port "populating '~a'...~%" target) (format log-port "populating '~a'...~%" target)
(populate os-dir target) (populate os-dir target)
(begin (mwhen grub?
(when grub? (install-grub* grub.cfg device target)))))
(unless (false-if-exception (install-grub grub.cfg device target))
(leave (_ "failed to install GRUB on device '~a'~%") device)))
(return #t)))))
;;; ;;;
...@@ -338,14 +343,11 @@ (define* (perform-action action os ...@@ -338,14 +343,11 @@ (define* (perform-action action os
(case action (case action
((reconfigure) ((reconfigure)
(mlet %store-monad ((% (switch-to-system os))) (mbegin %store-monad
(when grub? (switch-to-system os)
(unless (false-if-exception (mwhen grub?
(install-grub (derivation->output-path grub.cfg) (install-grub* (derivation->output-path grub.cfg)
device "/")) device "/"))))
(leave (_ "failed to install GRUB on device '~a'~%")
device)))
(return #t)))
((init) ((init)
(newline) (newline)
(format #t (_ "initializing operating system under '~a'...~%") (format #t (_ "initializing operating system under '~a'...~%")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment