Commit | Line | Data |
---|---|---|
0ded70f3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
735c6dd7 | 2 | ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> |
0ded70f3 LC |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (gnu system grub) | |
20 | #:use-module (guix store) | |
21 | #:use-module (guix packages) | |
22 | #:use-module (guix derivations) | |
23 | #:use-module (guix records) | |
d9f0a237 | 24 | #:use-module (guix monads) |
f6a7b21d | 25 | #:use-module (guix gexp) |
0ded70f3 LC |
26 | #:use-module (ice-9 match) |
27 | #:use-module (srfi srfi-1) | |
d5b429ab LC |
28 | #:export (grub-configuration |
29 | grub-configuration? | |
30 | grub-configuration-device | |
31 | ||
32 | menu-entry | |
0ded70f3 | 33 | menu-entry? |
d5b429ab | 34 | |
0ded70f3 LC |
35 | grub-configuration-file)) |
36 | ||
37 | ;;; Commentary: | |
38 | ;;; | |
39 | ;;; Configuration of GNU GRUB. | |
40 | ;;; | |
41 | ;;; Code: | |
42 | ||
d5b429ab LC |
43 | (define-record-type* <grub-configuration> |
44 | grub-configuration make-grub-configuration | |
45 | grub-configuration? | |
46 | (grub grub-configuration-grub ; package | |
47 | (default (@ (gnu packages grub) grub))) | |
48 | (device grub-configuration-device) ; string | |
49 | (menu-entries grub-configuration-menu-entries ; list | |
50 | (default '())) | |
51 | (default-entry grub-configuration-default-entry ; integer | |
2f7f3200 | 52 | (default 0)) |
d5b429ab LC |
53 | (timeout grub-configuration-timeout ; integer |
54 | (default 5))) | |
55 | ||
0ded70f3 LC |
56 | (define-record-type* <menu-entry> |
57 | menu-entry make-menu-entry | |
58 | menu-entry? | |
59 | (label menu-entry-label) | |
60 | (linux menu-entry-linux) | |
61 | (linux-arguments menu-entry-linux-arguments | |
f6a7b21d LC |
62 | (default '())) ; list of string-valued gexps |
63 | (initrd menu-entry-initrd)) ; file name of the initrd as a gexp | |
0ded70f3 | 64 | |
d5b429ab | 65 | (define* (grub-configuration-file config entries |
fe6e3fe2 LC |
66 | #:key |
67 | (system (%current-system)) | |
68 | (old-entries '())) | |
d5b429ab | 69 | "Return the GRUB configuration file corresponding to CONFIG, a |
fe6e3fe2 LC |
70 | <grub-configuration> object. OLD-ENTRIES is taken to be a list of menu |
71 | entries corresponding to old generations of the system." | |
d5b429ab LC |
72 | (define all-entries |
73 | (append entries (grub-configuration-menu-entries config))) | |
74 | ||
f6a7b21d | 75 | (define entry->gexp |
0ded70f3 LC |
76 | (match-lambda |
77 | (($ <menu-entry> label linux arguments initrd) | |
f6a7b21d LC |
78 | #~(format port "menuentry ~s { |
79 | linux ~a/bzImage ~a | |
d9f0a237 | 80 | initrd ~a |
0ded70f3 | 81 | }~%" |
f6a7b21d LC |
82 | #$label |
83 | #$linux (string-join (list #$@arguments)) | |
84 | #$initrd)))) | |
85 | ||
86 | (define builder | |
87 | #~(call-with-output-file #$output | |
88 | (lambda (port) | |
89 | (format port " | |
90 | set default=~a | |
91 | set timeout=~a | |
92 | search.file ~a/bzImage~%" | |
d5b429ab LC |
93 | #$(grub-configuration-default-entry config) |
94 | #$(grub-configuration-timeout config) | |
f6a7b21d LC |
95 | #$(any (match-lambda |
96 | (($ <menu-entry> _ linux) | |
97 | linux)) | |
d5b429ab | 98 | all-entries)) |
fe6e3fe2 LC |
99 | #$@(map entry->gexp all-entries) |
100 | ||
101 | #$@(if (pair? old-entries) | |
102 | #~((format port " | |
103 | submenu \"GNU system, old configurations...\" {~%") | |
104 | #$@(map entry->gexp old-entries) | |
105 | (format port "}~%")) | |
106 | #~())))) | |
0ded70f3 | 107 | |
f6a7b21d | 108 | (gexp->derivation "grub.cfg" builder)) |
0ded70f3 LC |
109 | |
110 | ;;; grub.scm ends here |