me/guix
Archived
1
0
Fork 0
Code Activity

install: Extract procedure: install-grub-config.

Browse source 
* gnu/build/install.scm (install-grub-config): New procedure.
(install-grub): Use it.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Chris Marusich 2016-11-01 22:48:14 -07:00 • committed by Ludovic Courtès
parent aff7280a0b
commit 1e17a2d5f2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
gnu/build/install.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,6 +23,7 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (install-grub #:export (install-grub
install-grub-config
populate-root-file-system populate-root-file-system
reset-timestamps reset-timestamps
register-closure register-closure
@ -36,13 +38,24 @@
;;; ;;;
;;; Code: ;;; Code:
(define* (install-grub grub.cfg device mount-point) (define (install-grub grub.cfg device mount-point)
"Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on
MOUNT-POINT. MOUNT-POINT.
Note that the caller must make sure that GRUB.CFG is registered as a GC root Note that the caller must make sure that GRUB.CFG is registered as a GC root
so that the fonts, background images, etc. referred to by GRUB.CFG are not so that the fonts, background images, etc. referred to by GRUB.CFG are not
GC'd." GC'd."
(install-grub-config grub.cfg mount-point)
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
(error "failed to install GRUB")))
(define (install-grub-config grub.cfg mount-point)
"Atomically copy GRUB.CFG into boot/grub/grub.cfg on the MOUNT-POINT. Note
that the caller must make sure that GRUB.CFG is registered as a GC root so
that the fonts, background images, etc. referred to by GRUB.CFG are not GC'd."
(let* ((target (string-append mount-point "/boot/grub/grub.cfg")) (let* ((target (string-append mount-point "/boot/grub/grub.cfg"))
(pivot (string-append target ".new"))) (pivot (string-append target ".new")))
(mkdir-p (dirname target)) (mkdir-p (dirname target))
@ -50,13 +63,7 @@ GC'd."
;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't
;; work when /boot is on a separate partition. Do that atomically. ;; work when /boot is on a separate partition. Do that atomically.
(copy-file grub.cfg pivot) (copy-file grub.cfg pivot)
(rename-file pivot target) (rename-file pivot target)))
(unless (zero? (system* "grub-install" "--no-floppy"
"--boot-directory"
(string-append mount-point "/boot")
device))
(error "failed to install GRUB"))))
(define (evaluate-populate-directive directive target) (define (evaluate-populate-directive directive target)
"Evaluate DIRECTIVE, an sexp describing a file or directory to create under "Evaluate DIRECTIVE, an sexp describing a file or directory to create under