Mirror of GNU Guix
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

442 lines
16 KiB

Remove traces of "GuixSD". * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Remove mentions of "GuixSD". * gnu/bootloader/grub.scm (install-grub-efi): Likewise. * gnu/build/vm.scm (make-iso9660-image): Change default #:volume-id to "Guix_image". (initialize-hard-disk): Search for the "Guix_image" label. * gnu/ci.scm (system-test-jobs, tarball-jobs): Remove "GuixSD". * gnu/installer/newt/welcome.scm (run-welcome-page): Likewise. * gnu/packages/audio.scm (supercollider)[description]: Likewise. * gnu/packages/curl.scm (curl): Likewise. * gnu/packages/emacs.scm (emacs): Likewise. * gnu/packages/gnome.scm (network-manager): Likewise. * gnu/packages/julia.scm (julia): Likewise. * gnu/packages/linux.scm (alsa-plugins): Likewise. (powertop, wireless-regdb): Likewise. * gnu/packages/package-management.scm (guix): Likewise. * gnu/packages/polkit.scm (polkit): Likewise. * gnu/packages/tex.scm (texlive-bin): Likewise. * gnu/services/base.scm (file-systems->fstab): Likewise. * gnu/services/cups.scm (%cups-activation): Likewise. * gnu/services/mail.scm (%dovecot-activation): Likewise. * gnu/services/messaging.scm (prosody-configuration)[log]: Likewise. * gnu/system/examples/vm-image.tmpl (vm-image-motd): Likewise. * gnu/system/install.scm (installation-os)[file-systems]: Change root file system label to "Guix_image". * gnu/system/mapped-devices.scm (check-device-initrd-modules): Remove "GuixSD". * gnu/system/vm.scm (system-docker-image): Likewise. (system-disk-image)[root-label]: Change to "Guix_image". * gnu/tests/install.scm (run-install): Remove "GuixSD". * guix/modules.scm (guix-module-name?): Likewise. * nix/libstore/optimise-store.cc: Likewise.
3 years ago
file-systems: Remove 'title' field and add <file-system-label>. The 'title' field was easily overlooked and was an endless source of confusion. Now, the value of the 'device' field is self-contained. * gnu/system/file-systems.scm (<file-system>): Change constructor name to '%file-system'. [title]: Remove. (<file-system-label>): New record type with printer. (report-deprecation, device-expression) (process-file-system-declaration, file-system): New macros. (file-system-title): New procedure. (file-system->spec, spec->file-system): Adjust to handle <file-system-label>. * gnu/system.scm (bootable-kernel-arguments): Add case for 'file-system-label?'. (read-boot-parameters): Likewise. (mapped-device-user): Avoid 'file-system-title'. (fs->boot-device): Remove. (operating-system-boot-parameters): Use 'file-system-device' instead of 'fs->boot-device'. (device->sexp): Add case for 'file-system-label?'. * gnu/bootloader/grub.scm (grub-root-search): Add case for 'file-system-label?'. * gnu/system/examples/bare-bones.tmpl, gnu/system/examples/beaglebone-black.tmpl, gnu/system/examples/lightweight-desktop.tmpl, gnu/system/examples/vm-image.tmpl: Remove uses of 'title'. * gnu/system/vm.scm (virtualized-operating-system): Remove uses of 'file-system-title'. * guix/scripts/system.scm (check-file-system-availability): Likewise, and adjust fix-it hint. (check-initrd-modules)[file-system-/dev]: Likewise. * gnu/build/file-systems.scm (canonicalize-device-spec): Remove 'title' parameter. [canonical-title]: Remove. Match on SPEC's type rather than on CANONICAL-TITLE. (mount-file-system): Adjust caller. * gnu/build/linux-boot.scm (boot-system): Interpret ROOT here. * gnu/services/base.scm (file-system->fstab-entry): Remove use of 'file-system-title'. * doc/guix.texi (File Systems): Remove documentation of the 'title' field. Rewrite documentation of 'device' and document 'file-system-label'.
4 years ago
file-systems: Remove 'title' field and add <file-system-label>. The 'title' field was easily overlooked and was an endless source of confusion. Now, the value of the 'device' field is self-contained. * gnu/system/file-systems.scm (<file-system>): Change constructor name to '%file-system'. [title]: Remove. (<file-system-label>): New record type with printer. (report-deprecation, device-expression) (process-file-system-declaration, file-system): New macros. (file-system-title): New procedure. (file-system->spec, spec->file-system): Adjust to handle <file-system-label>. * gnu/system.scm (bootable-kernel-arguments): Add case for 'file-system-label?'. (read-boot-parameters): Likewise. (mapped-device-user): Avoid 'file-system-title'. (fs->boot-device): Remove. (operating-system-boot-parameters): Use 'file-system-device' instead of 'fs->boot-device'. (device->sexp): Add case for 'file-system-label?'. * gnu/bootloader/grub.scm (grub-root-search): Add case for 'file-system-label?'. * gnu/system/examples/bare-bones.tmpl, gnu/system/examples/beaglebone-black.tmpl, gnu/system/examples/lightweight-desktop.tmpl, gnu/system/examples/vm-image.tmpl: Remove uses of 'title'. * gnu/system/vm.scm (virtualized-operating-system): Remove uses of 'file-system-title'. * guix/scripts/system.scm (check-file-system-availability): Likewise, and adjust fix-it hint. (check-initrd-modules)[file-system-/dev]: Likewise. * gnu/build/file-systems.scm (canonicalize-device-spec): Remove 'title' parameter. [canonical-title]: Remove. Match on SPEC's type rather than on CANONICAL-TITLE. (mount-file-system): Adjust caller. * gnu/build/linux-boot.scm (boot-system): Interpret ROOT here. * gnu/services/base.scm (file-system->fstab-entry): Remove use of 'file-system-title'. * doc/guix.texi (File Systems): Remove documentation of the 'title' field. Rewrite documentation of 'device' and document 'file-system-label'.
4 years ago
Remove traces of "GuixSD". * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Remove mentions of "GuixSD". * gnu/bootloader/grub.scm (install-grub-efi): Likewise. * gnu/build/vm.scm (make-iso9660-image): Change default #:volume-id to "Guix_image". (initialize-hard-disk): Search for the "Guix_image" label. * gnu/ci.scm (system-test-jobs, tarball-jobs): Remove "GuixSD". * gnu/installer/newt/welcome.scm (run-welcome-page): Likewise. * gnu/packages/audio.scm (supercollider)[description]: Likewise. * gnu/packages/curl.scm (curl): Likewise. * gnu/packages/emacs.scm (emacs): Likewise. * gnu/packages/gnome.scm (network-manager): Likewise. * gnu/packages/julia.scm (julia): Likewise. * gnu/packages/linux.scm (alsa-plugins): Likewise. (powertop, wireless-regdb): Likewise. * gnu/packages/package-management.scm (guix): Likewise. * gnu/packages/polkit.scm (polkit): Likewise. * gnu/packages/tex.scm (texlive-bin): Likewise. * gnu/services/base.scm (file-systems->fstab): Likewise. * gnu/services/cups.scm (%cups-activation): Likewise. * gnu/services/mail.scm (%dovecot-activation): Likewise. * gnu/services/messaging.scm (prosody-configuration)[log]: Likewise. * gnu/system/examples/vm-image.tmpl (vm-image-motd): Likewise. * gnu/system/install.scm (installation-os)[file-systems]: Change root file system label to "Guix_image". * gnu/system/mapped-devices.scm (check-device-initrd-modules): Remove "GuixSD". * gnu/system/vm.scm (system-docker-image): Likewise. (system-disk-image)[root-label]: Change to "Guix_image". * gnu/tests/install.scm (run-install): Remove "GuixSD". * guix/modules.scm (guix-module-name?): Likewise. * nix/libstore/optimise-store.cc: Likewise.
3 years ago
Remove traces of "GuixSD". * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Remove mentions of "GuixSD". * gnu/bootloader/grub.scm (install-grub-efi): Likewise. * gnu/build/vm.scm (make-iso9660-image): Change default #:volume-id to "Guix_image". (initialize-hard-disk): Search for the "Guix_image" label. * gnu/ci.scm (system-test-jobs, tarball-jobs): Remove "GuixSD". * gnu/installer/newt/welcome.scm (run-welcome-page): Likewise. * gnu/packages/audio.scm (supercollider)[description]: Likewise. * gnu/packages/curl.scm (curl): Likewise. * gnu/packages/emacs.scm (emacs): Likewise. * gnu/packages/gnome.scm (network-manager): Likewise. * gnu/packages/julia.scm (julia): Likewise. * gnu/packages/linux.scm (alsa-plugins): Likewise. (powertop, wireless-regdb): Likewise. * gnu/packages/package-management.scm (guix): Likewise. * gnu/packages/polkit.scm (polkit): Likewise. * gnu/packages/tex.scm (texlive-bin): Likewise. * gnu/services/base.scm (file-systems->fstab): Likewise. * gnu/services/cups.scm (%cups-activation): Likewise. * gnu/services/mail.scm (%dovecot-activation): Likewise. * gnu/services/messaging.scm (prosody-configuration)[log]: Likewise. * gnu/system/examples/vm-image.tmpl (vm-image-motd): Likewise. * gnu/system/install.scm (installation-os)[file-systems]: Change root file system label to "Guix_image". * gnu/system/mapped-devices.scm (check-device-initrd-modules): Remove "GuixSD". * gnu/system/vm.scm (system-docker-image): Likewise. (system-disk-image)[root-label]: Change to "Guix_image". * gnu/tests/install.scm (run-install): Remove "GuixSD". * guix/modules.scm (guix-module-name?): Likewise. * nix/libstore/optimise-store.cc: Likewise.
3 years ago
Remove traces of "GuixSD". * gnu/bootloader/extlinux.scm (extlinux-configuration-file): Remove mentions of "GuixSD". * gnu/bootloader/grub.scm (install-grub-efi): Likewise. * gnu/build/vm.scm (make-iso9660-image): Change default #:volume-id to "Guix_image". (initialize-hard-disk): Search for the "Guix_image" label. * gnu/ci.scm (system-test-jobs, tarball-jobs): Remove "GuixSD". * gnu/installer/newt/welcome.scm (run-welcome-page): Likewise. * gnu/packages/audio.scm (supercollider)[description]: Likewise. * gnu/packages/curl.scm (curl): Likewise. * gnu/packages/emacs.scm (emacs): Likewise. * gnu/packages/gnome.scm (network-manager): Likewise. * gnu/packages/julia.scm (julia): Likewise. * gnu/packages/linux.scm (alsa-plugins): Likewise. (powertop, wireless-regdb): Likewise. * gnu/packages/package-management.scm (guix): Likewise. * gnu/packages/polkit.scm (polkit): Likewise. * gnu/packages/tex.scm (texlive-bin): Likewise. * gnu/services/base.scm (file-systems->fstab): Likewise. * gnu/services/cups.scm (%cups-activation): Likewise. * gnu/services/mail.scm (%dovecot-activation): Likewise. * gnu/services/messaging.scm (prosody-configuration)[log]: Likewise. * gnu/system/examples/vm-image.tmpl (vm-image-motd): Likewise. * gnu/system/install.scm (installation-os)[file-systems]: Change root file system label to "Guix_image". * gnu/system/mapped-devices.scm (check-device-initrd-modules): Remove "GuixSD". * gnu/system/vm.scm (system-docker-image): Likewise. (system-disk-image)[root-label]: Change to "Guix_image". * gnu/tests/install.scm (run-install): Remove "GuixSD". * guix/modules.scm (guix-module-name?): Likewise. * nix/libstore/optimise-store.cc: Likewise.
3 years ago
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
  4. ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
  5. ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
  6. ;;;
  7. ;;; This file is part of GNU Guix.
  8. ;;;
  9. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10. ;;; under the terms of the GNU General Public License as published by
  11. ;;; the Free Software Foundation; either version 3 of the License, or (at
  12. ;;; your option) any later version.
  13. ;;;
  14. ;;; GNU Guix is distributed in the hope that it will be useful, but
  15. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;;; GNU General Public License for more details.
  18. ;;;
  19. ;;; You should have received a copy of the GNU General Public License
  20. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  21. (define-module (gnu bootloader grub)
  22. #:use-module (guix records)
  23. #:use-module ((guix utils) #:select (%current-system))
  24. #:use-module (guix gexp)
  25. #:use-module (gnu artwork)
  26. #:use-module (gnu bootloader)
  27. #:use-module (gnu system uuid)
  28. #:use-module (gnu system file-systems)
  29. #:autoload (gnu packages bootloaders) (grub)
  30. #:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
  31. #:use-module (ice-9 match)
  32. #:use-module (ice-9 regex)
  33. #:use-module (srfi srfi-1)
  34. #:export (grub-image
  35. grub-image?
  36. grub-image-aspect-ratio
  37. grub-image-file
  38. grub-theme
  39. grub-theme?
  40. grub-theme-images
  41. grub-theme-color-normal
  42. grub-theme-color-highlight
  43. %background-image
  44. %default-theme
  45. grub-bootloader
  46. grub-efi-bootloader
  47. grub-mkrescue-bootloader
  48. grub-configuration))
  49. ;;; Commentary:
  50. ;;;
  51. ;;; Configuration of GNU GRUB.
  52. ;;;
  53. ;;; Code:
  54. (define (strip-mount-point mount-point file)
  55. "Strip MOUNT-POINT from FILE, which is a gexp or other lowerable object
  56. denoting a file name."
  57. (match mount-point
  58. ((? string? mount-point)
  59. (if (string=? mount-point "/")
  60. file
  61. #~(let ((file #$file))
  62. (if (string-prefix? #$mount-point file)
  63. (substring #$file #$(string-length mount-point))
  64. file))))
  65. (#f file)))
  66. (define-record-type* <grub-image>
  67. grub-image make-grub-image
  68. grub-image?
  69. (aspect-ratio grub-image-aspect-ratio ;rational number
  70. (default 4/3))
  71. (file grub-image-file)) ;file-valued gexp (SVG)
  72. (define-record-type* <grub-theme>
  73. grub-theme make-grub-theme
  74. grub-theme?
  75. (images grub-theme-images
  76. (default '())) ;list of <grub-image>
  77. (color-normal grub-theme-color-normal
  78. (default '((fg . cyan) (bg . blue))))
  79. (color-highlight grub-theme-color-highlight
  80. (default '((fg . white) (bg . blue)))))
  81. (define %background-image
  82. (grub-image
  83. (aspect-ratio 4/3)
  84. (file (file-append %artwork-repository
  85. "/grub/GuixSD-fully-black-4-3.svg"))))
  86. (define %default-theme
  87. ;; Default theme contributed by Felipe López.
  88. (grub-theme
  89. (images (list %background-image))
  90. (color-highlight '((fg . yellow) (bg . black)))
  91. (color-normal '((fg . light-gray) (bg . black))))) ;XXX: #x303030
  92. ;;;
  93. ;;; Background image & themes.
  94. ;;;
  95. (define (bootloader-theme config)
  96. "Return user defined theme in CONFIG if defined or %default-theme
  97. otherwise."
  98. (or (bootloader-configuration-theme config) %default-theme))
  99. (define* (svg->png svg #:key width height)
  100. "Build a PNG of HEIGHT x WIDTH from SVG."
  101. (computed-file "grub-image.png"
  102. (with-imported-modules '((gnu build svg))
  103. (with-extensions (list guile-rsvg guile-cairo)
  104. #~(begin
  105. (use-modules (gnu build svg))
  106. (svg->png #+svg #$output
  107. #:width #$width
  108. #:height #$height))))))
  109. (define* (grub-background-image config #:key (width 1024) (height 768))
  110. "Return the GRUB background image defined in CONFIG with a ratio of
  111. WIDTH/HEIGHT, or #f if none was found."
  112. (let* ((ratio (/ width height))
  113. (image (find (lambda (image)
  114. (= (grub-image-aspect-ratio image) ratio))
  115. (grub-theme-images
  116. (bootloader-theme config)))))
  117. (and image
  118. (svg->png (grub-image-file image)
  119. #:width width #:height height))))
  120. (define* (eye-candy config store-device store-mount-point
  121. #:key system port)
  122. "Return a gexp that writes to PORT (a port-valued gexp) the
  123. 'grub.cfg' part concerned with graphics mode, background images, colors, and
  124. all that. STORE-DEVICE designates the device holding the store, and
  125. STORE-MOUNT-POINT is its mount point; these are used to determine where the
  126. background image and fonts must be searched for. SYSTEM must be the target
  127. system string---e.g., \"x86_64-linux\"."
  128. (define setup-gfxterm-body
  129. ;; Intel and EFI systems need to be switched into graphics mode, whereas
  130. ;; most other modern architectures have no other mode and therefore don't
  131. ;; need to be switched.
  132. (if (string-match "^(x86_64|i[3-6]86)-" system)
  133. "
  134. # Leave 'gfxmode' to 'auto'.
  135. insmod video_bochs
  136. insmod video_cirrus
  137. insmod gfxterm
  138. if [ \"${grub_platform}\" == efi ]; then
  139. # This is for (U)EFI systems (these modules are unavailable in the
  140. # non-EFI GRUB.) If we don't load them, GRUB boots in \"blind mode\",
  141. # which isn't convenient.
  142. insmod efi_gop
  143. insmod efi_uga
  144. else
  145. # These are specific to non-EFI Intel machines.
  146. insmod vbe
  147. insmod vga
  148. fi
  149. "
  150. ""))
  151. (define (setup-gfxterm config font-file)
  152. (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
  153. #~(format #f "if loadfont ~a; then
  154. setup_gfxterm
  155. fi~%" #$font-file)
  156. ""))
  157. (define (theme-colors type)
  158. (let* ((theme (bootloader-theme config))
  159. (colors (type theme)))
  160. (string-append (symbol->string (assoc-ref colors 'fg)) "/"
  161. (symbol->string (assoc-ref colors 'bg)))))
  162. (define font-file
  163. (strip-mount-point store-mount-point
  164. (file-append grub "/share/grub/unicode.pf2")))
  165. (define image
  166. (grub-background-image config))
  167. (and image
  168. #~(format #$port "
  169. function setup_gfxterm {~a}
  170. # Set 'root' to the partition that contains /gnu/store.
  171. ~a
  172. ~a
  173. ~a
  174. insmod png
  175. if background_image ~a; then
  176. set color_normal=~a
  177. set color_highlight=~a
  178. else
  179. set menu_color_normal=cyan/blue
  180. set menu_color_highlight=white/blue
  181. fi~%"
  182. #$setup-gfxterm-body
  183. #$(grub-root-search store-device font-file)
  184. #$(setup-gfxterm config font-file)
  185. #$(grub-setup-io config)
  186. #$(strip-mount-point store-mount-point image)
  187. #$(theme-colors grub-theme-color-normal)
  188. #$(theme-colors grub-theme-color-highlight))))
  189. ;;;
  190. ;;; Configuration file.
  191. ;;;
  192. (define (grub-setup-io config)
  193. "Return GRUB commands to configure the input / output interfaces. The result
  194. is a string that can be inserted in grub.cfg."
  195. (let* ((symbols->string (lambda (list)
  196. (string-join (map symbol->string list) " ")))
  197. (outputs (bootloader-configuration-terminal-outputs config))
  198. (inputs (bootloader-configuration-terminal-inputs config))
  199. (unit (bootloader-configuration-serial-unit config))
  200. (speed (bootloader-configuration-serial-speed config))
  201. ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
  202. ;; as documented in GRUB manual section "Simple Configuration
  203. ;; Handling".
  204. (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
  205. gfxterm vga_text mda_text morse spkmodem))
  206. (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
  207. at_keyboard usb_keyboard))
  208. (io (string-append
  209. "terminal_output "
  210. (symbols->string
  211. (map
  212. (lambda (output)
  213. (if (memq output valid-outputs) output #f)) outputs)) "\n"
  214. (if (null? inputs)
  215. ""
  216. (string-append
  217. "terminal_input "
  218. (symbols->string
  219. (map
  220. (lambda (input)
  221. (if (memq input valid-inputs) input #f)) inputs)) "\n"))
  222. ;; UNIT and SPEED are arguments to the same GRUB command
  223. ;; ("serial"), so we process them together.
  224. (if (or unit speed)
  225. (string-append
  226. "serial"
  227. (if unit
  228. ;; COM ports 1 through 4
  229. (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
  230. (string-append " --unit=" (number->string unit))
  231. #f)
  232. "")
  233. (if speed
  234. (if (exact-integer? speed)
  235. (string-append " --speed=" (number->string speed))
  236. #f)
  237. ""))
  238. ""))))
  239. (format #f "~a" io)))
  240. (define (grub-root-search device file)
  241. "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
  242. a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
  243. code."
  244. ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
  245. ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
  246. ;; custom menu entries. In the latter case, don't emit a 'search' command.
  247. (if (and (string? file) (not (string-prefix? "/" file)))
  248. ""
  249. (match device
  250. ;; Preferably refer to DEVICE by its UUID or label. This is more
  251. ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
  252. ((? uuid? uuid)
  253. (format #f "search --fs-uuid --set ~a"
  254. (uuid->string device)))
  255. ((? file-system-label? label)
  256. (format #f "search --label --set ~a"
  257. (file-system-label->string label)))
  258. ((or #f (? string?))
  259. #~(format #f "search --file --set ~a" #$file)))))
  260. (define* (grub-configuration-file config entries
  261. #:key
  262. (system (%current-system))
  263. (old-entries '()))
  264. "Return the GRUB configuration file corresponding to CONFIG, a
  265. <bootloader-configuration> object, and where the store is available at
  266. STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
  267. entries corresponding to old generations of the system."
  268. (define all-entries
  269. (append entries (bootloader-configuration-menu-entries config)))
  270. (define (menu-entry->gexp entry)
  271. (let ((device (menu-entry-device entry))
  272. (device-mount-point (menu-entry-device-mount-point entry))
  273. (label (menu-entry-label entry))
  274. (kernel (menu-entry-linux entry))
  275. (arguments (menu-entry-linux-arguments entry))
  276. (initrd (menu-entry-initrd entry)))
  277. ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
  278. ;; Use the right file names for KERNEL and INITRD in case
  279. ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
  280. ;; separate partition.
  281. (let ((kernel (strip-mount-point device-mount-point kernel))
  282. (initrd (strip-mount-point device-mount-point initrd)))
  283. #~(format port "menuentry ~s {
  284. ~a
  285. linux ~a ~a
  286. initrd ~a
  287. }~%"
  288. #$label
  289. #$(grub-root-search device kernel)
  290. #$kernel (string-join (list #$@arguments))
  291. #$initrd))))
  292. (define sugar
  293. (eye-candy config
  294. (menu-entry-device (first all-entries))
  295. (menu-entry-device-mount-point (first all-entries))
  296. #:system system
  297. #:port #~port))
  298. (define builder
  299. #~(call-with-output-file #$output
  300. (lambda (port)
  301. (format port
  302. "# This file was generated from your Guix configuration. Any changes
  303. # will be lost upon reconfiguration.
  304. ")
  305. #$sugar
  306. (format port "
  307. set default=~a
  308. set timeout=~a~%"
  309. #$(bootloader-configuration-default-entry config)
  310. #$(bootloader-configuration-timeout config))
  311. #$@(map menu-entry->gexp all-entries)
  312. #$@(if (pair? old-entries)
  313. #~((format port "
  314. submenu \"GNU system, old configurations...\" {~%")
  315. #$@(map menu-entry->gexp old-entries)
  316. (format port "}~%"))
  317. #~()))))
  318. (computed-file "grub.cfg" builder))
  319. ;;;
  320. ;;; Install procedures.
  321. ;;;
  322. (define install-grub
  323. #~(lambda (bootloader device mount-point)
  324. ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT.
  325. (let ((grub (string-append bootloader "/sbin/grub-install"))
  326. (install-dir (string-append mount-point "/boot")))
  327. ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
  328. ;; root partition.
  329. (setenv "GRUB_ENABLE_CRYPTODISK" "y")
  330. (unless (zero? (system* grub "--no-floppy" "--target=i386-pc"
  331. "--boot-directory" install-dir
  332. device))
  333. (error "failed to install GRUB (BIOS)")))))
  334. (define install-grub-efi
  335. #~(lambda (bootloader efi-dir mount-point)
  336. ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
  337. ;; system whose root is mounted at MOUNT-POINT.
  338. (let ((grub-install (string-append bootloader "/sbin/grub-install"))
  339. (install-dir (string-append mount-point "/boot"))
  340. ;; When installing Guix, it's common to mount EFI-DIR below
  341. ;; MOUNT-POINT rather than /boot/efi on the live image.
  342. (target-esp (if (file-exists? (string-append mount-point efi-dir))
  343. (string-append mount-point efi-dir)
  344. efi-dir)))
  345. ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
  346. ;; root partition.
  347. (setenv "GRUB_ENABLE_CRYPTODISK" "y")
  348. (unless (zero? (system* grub-install "--boot-directory" install-dir
  349. "--bootloader-id=Guix"
  350. "--efi-directory" target-esp))
  351. (error "failed to install GRUB (EFI)")))))
  352. ;;;
  353. ;;; Bootloader definitions.
  354. ;;;
  355. (define grub-bootloader
  356. (bootloader
  357. (name 'grub)
  358. (package grub)
  359. (installer install-grub)
  360. (configuration-file "/boot/grub/grub.cfg")
  361. (configuration-file-generator grub-configuration-file)))
  362. (define* grub-efi-bootloader
  363. (bootloader
  364. (inherit grub-bootloader)
  365. (installer install-grub-efi)
  366. (name 'grub-efi)
  367. (package grub-efi)))
  368. (define* grub-mkrescue-bootloader
  369. (bootloader
  370. (inherit grub-efi-bootloader)
  371. (package grub-hybrid)))
  372. ;;;
  373. ;;; Compatibility macros.
  374. ;;;
  375. (define-syntax grub-configuration
  376. (syntax-rules (grub)
  377. ((_ (grub package) fields ...)
  378. (if (eq? package grub)
  379. (bootloader-configuration
  380. (bootloader grub-bootloader)
  381. fields ...)
  382. (bootloader-configuration
  383. (bootloader grub-efi-bootloader)
  384. fields ...)))
  385. ((_ fields ...)
  386. (bootloader-configuration
  387. (bootloader grub-bootloader)
  388. fields ...))))
  389. ;;; grub.scm ends here