;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 David Craven ;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu system bootloader) #:use-module (gnu system) #:use-module (gnu system grub) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (bootloader-configuration bootloader-configuration? bootloader-configuration-bootloader bootloader-configuration-type bootloader-configuration-device bootloader-configuration-menu-entries bootloader-configuration-default-entry bootloader-configuration-timeout bootloader-configuration-file-location bootloader-configuration-file-procedure bootloader-configuration-install-procedure bootloader-configuration-additional-configuration %extlinux-configuration %grub-configuration %grub-efi-configuration %syslinux-configuration lookup-bootloader-configuration extlinux-configuration grub-configuration grub-efi-configuration syslinux-configuration dd install-grub install-syslinux)) ;;; Commentary: ;;; ;;; Generic configuration for bootloaders. ;;; ;;; Code: (define-record-type* bootloader-configuration make-bootloader-configuration bootloader-configuration? (bootloader bootloader-configuration-bootloader ; package (default #f)) (type bootloader-configuration-type (default #f)) ; symbol (device bootloader-configuration-device ; string (default #f)) (menu-entries bootloader-configuration-menu-entries ; list of (default '())) (default-entry bootloader-configuration-default-entry ; integer (default 0)) (timeout bootloader-configuration-timeout ; integer (default 5)) (configuration-file-location bootloader-configuration-file-location (default #f)) (configuration-file-procedure bootloader-configuration-file-procedure ; procedure (default #f)) (install-procedure bootloader-configuration-install-procedure ; procedure (default #f)) (additional-configuration bootloader-configuration-additional-configuration ; record (default #f))) ;;; ;;; Extlinux configuration file. ;;; (define* (extlinux-configuration-file config entries #:key (system (%current-system)) (old-entries '())) "Return the U-Boot configuration file corresponding to CONFIG, a object, and where the store is available at STORE-FS, a object. OLD-ENTRIES is taken to be a list of menu entries corresponding to old generations of the system." (define all-entries (append entries (bootloader-configuration-menu-entries config))) (define boot-parameters->gexp (match-lambda (($ label _ _ _ kernel kernel-arguments initrd) #~(format port "LABEL ~a MENU LABEL ~a KERNEL ~a FDTDIR ~a/lib/dtbs INITRD ~a APPEND ~a ~%" #$label #$label #$kernel #$kernel #$initrd (string-join (list #$@kernel-arguments)))))) (define builder #~(call-with-output-file #$output (lambda (port) (let ((timeout #$(bootloader-configuration-timeout config))) (format port " UI menu.c32 PROMPT ~a TIMEOUT ~a~%" (if (> timeout 0) 1 0) (* 10 timeout)) #$@(map boot-parameters->gexp all-entries) #$@(if (pair? old-entries) #~((format port "~%") #$@(map boot-parameters->gexp old-entries) (format port "~%")) #~()))))) (gexp->derivation "extlinux.conf" builder)) ;;; ;;; Bootloader install procedures. ;;; (define dd #~(lambda (bs count if of) (zero? (system* "dd" (string-append "bs=" (number->string bs)) (string-append "count=" (number->string count)) (string-append "if=" if) (string-append "of=" of))))) (define install-grub #~(lambda (bootloader device mount-point) ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. (let ((grub (string-append bootloader "/sbin/grub-install")) (install-dir (string-append mount-point "/boot"))) ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or ;; root partition. (setenv "GRUB_ENABLE_CRYPTODISK" "y") (unless (zero? (system* grub "--no-floppy" "--boot-directory" install-dir device)) (error "failed to install GRUB"))))) (define install-syslinux #~(lambda (bootloader device mount-point) (let ((extlinux (string-append bootloader "/sbin/extlinux")) (install-dir (string-append mount-point "/boot/extlinux")) (syslinux-dir (string-append bootloader "/share/syslinux"))) (mkdir-p install-dir) (for-each (lambda (file) (copy-file file (string-append install-dir "/" (basename file)))) (find-files syslinux-dir "\\.c32$")) (unless (and (zero? (system* extlinux "--install" install-dir)) (#$dd 440 1 (string-append syslinux-dir "/mbr.bin") device)) (error "failed to install SYSLINUX"))))) ;;; ;;; Bootloader configurations. ;;; (define* %extlinux-configuration (bootloader-configuration (type 'extlinux) (configuration-file-location "/boot/extlinux/extlinux.conf") (configuration-file-procedure extlinux-configuration-file))) (define* %grub-configuration (bootloader-configuration (type 'grub) (bootloader (@ (gnu packages bootloaders) grub)) (configuration-file-location "/boot/grub/grub.cfg") (configuration-file-procedure grub-configuration-file) (install-procedure install-grub) (additional-configuration %default-theme))) (define* %grub-efi-configuration (bootloader-configuration (inherit %grub-configuration) (type 'grub-efi) (bootloader (@ (gnu packages bootloaders) grub-efi)))) (define* %syslinux-configuration (bootloader-configuration (inherit %extlinux-configuration) (type 'syslinux) (bootloader (@ (gnu packages bootloaders) syslinux)) (install-procedure install-syslinux))) (define %bootloader-configurations (list %extlinux-configuration %grub-configuration %grub-efi-configuration %syslinux-configuration)) (define (lookup-bootloader-configuration type) (or (find (lambda (conf) (eq? (bootloader-configuration-type conf) type)) %bootloader-configurations) (error "~a: unknown bootloader type" type))) ;;; ;;; Compatibility macros. ;;; (define-syntax-rule (extlinux-configuration fields ...) (bootloader-configuration (inherit %extlinux-configuration) fields ...)) (define-syntax-rule (grub-configuration fields ...) (bootloader-configuration (inherit %grub-configuration) fields ...)) (define-syntax-rule (grub-efi-configuration fields ...) (bootloader-configuration (inherit %grub-efi-configuration) fields ...)) (define-syntax-rule (syslinux-configuration fields ...) (bootloader-configuration (inherit %syslinux-configuration) fields ...)) ;;; bootloader.scm ends here