| 1 | |
| 2 | |
| 3 | |
| 4 | |
| 5 | |
| 6 | |
| 7 | |
| 8 | |
| 9 | |
| 10 | |
| 11 | |
| 12 | |
| 13 | |
| 14 | |
| 15 | |
| 16 | |
| 17 | |
| 18 | |
| 19 | |
| 20 |
|
| 21 | (define-module (gnu bootloader extlinux)
|
| 22 | #:use-module (gnu bootloader)
|
| 23 | #:use-module (gnu packages bootloaders)
|
| 24 | #:use-module (guix gexp)
|
| 25 | #:use-module (guix utils)
|
| 26 | #:export (extlinux-bootloader
|
| 27 | extlinux-bootloader-gpt))
|
| 28 |
|
| 29 | (define* (extlinux-configuration-file config entries
|
| 30 | #:key
|
| 31 | (system (%current-system))
|
| 32 | (old-entries '())
|
| 33 | #:allow-other-keys)
|
| 34 | "Return the U-Boot configuration file corresponding to CONFIG, a
|
| 35 | <u-boot-configuration> object, and where the store is available at STORE-FS, a
|
| 36 | <file-system> object. OLD-ENTRIES is taken to be a list of menu entries
|
| 37 | corresponding to old generations of the system."
|
| 38 |
|
| 39 | (define all-entries
|
| 40 | (append entries (bootloader-configuration-menu-entries config)))
|
| 41 |
|
| 42 | (define with-fdtdir?
|
| 43 | (bootloader-configuration-device-tree-support? config))
|
| 44 |
|
| 45 | (define (menu-entry->gexp entry)
|
| 46 | (let ((label (menu-entry-label entry))
|
| 47 | (kernel (menu-entry-linux entry))
|
| 48 | (kernel-arguments (menu-entry-linux-arguments entry))
|
| 49 | (initrd (menu-entry-initrd entry)))
|
| 50 | #~(format port "LABEL ~a
|
| 51 | MENU LABEL ~a
|
| 52 | KERNEL ~a
|
| 53 | ~a
|
| 54 | INITRD ~a
|
| 55 | APPEND ~a
|
| 56 | ~%"
|
| 57 | #$label #$label
|
| 58 | #$kernel
|
| 59 | (if #$with-fdtdir?
|
| 60 | (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
|
| 61 | "")
|
| 62 | #$initrd
|
| 63 | (string-join (list #$@kernel-arguments)))))
|
| 64 |
|
| 65 | (define builder
|
| 66 | #~(call-with-output-file #$output
|
| 67 | (lambda (port)
|
| 68 | (let ((timeout #$(bootloader-configuration-timeout config)))
|
| 69 | (format port "# This file was generated from your Guix configuration. Any changes
|
| 70 | # will be lost upon reconfiguration.
|
| 71 | UI menu.c32
|
| 72 | MENU TITLE GNU Guix Boot Options
|
| 73 | PROMPT ~a
|
| 74 | TIMEOUT ~a~%"
|
| 75 | (if (> timeout 0) 1 0)
|
| 76 | |
| 77 | (* 10 timeout))
|
| 78 | #$@(map menu-entry->gexp all-entries)
|
| 79 |
|
| 80 | #$@(if (pair? old-entries)
|
| 81 | #~((format port "~%")
|
| 82 | #$@(map menu-entry->gexp old-entries)
|
| 83 | (format port "~%"))
|
| 84 | #~())))))
|
| 85 |
|
| 86 | (computed-file "extlinux.conf" builder
|
| 87 | #:options '(#:local-build? #t
|
| 88 | #:substitutable? #f)))
|
| 89 |
|
| 90 |
|
| 91 |
|
| 92 |
|
| 93 | |
| 94 | |
| 95 | |
| 96 |
|
| 97 | (define (install-extlinux mbr)
|
| 98 | #~(lambda (bootloader device mount-point)
|
| 99 | (let ((extlinux (string-append bootloader "/sbin/extlinux"))
|
| 100 | (install-dir (string-append mount-point "/boot/extlinux"))
|
| 101 | (syslinux-dir (string-append bootloader "/share/syslinux")))
|
| 102 | (for-each (lambda (file)
|
| 103 | (install-file file install-dir))
|
| 104 | (find-files syslinux-dir "\\.c32$"))
|
| 105 | (invoke/quiet extlinux "--install" install-dir)
|
| 106 | (write-file-on-device (string-append syslinux-dir "/" #$mbr)
|
| 107 | 440 device 0))))
|
| 108 |
|
| 109 | (define install-extlinux-mbr
|
| 110 | (install-extlinux "mbr.bin"))
|
| 111 |
|
| 112 | (define install-extlinux-gpt
|
| 113 | (install-extlinux "gptmbr.bin"))
|
| 114 |
|
| 115 |
|
| 116 |
|
| 117 | |
| 118 | |
| 119 | |
| 120 |
|
| 121 | (define extlinux-bootloader
|
| 122 | (bootloader
|
| 123 | (name 'extlinux)
|
| 124 | (package syslinux)
|
| 125 | (installer install-extlinux-mbr)
|
| 126 | (configuration-file "/boot/extlinux/extlinux.conf")
|
| 127 | (configuration-file-generator extlinux-configuration-file)))
|
| 128 |
|
| 129 | (define extlinux-bootloader-gpt
|
| 130 | (bootloader
|
| 131 | (inherit extlinux-bootloader)
|
| 132 | (installer install-extlinux-gpt)))
|