nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

system: grub: Rewrite using gexps. 

* gnu/system/grub.scm (grub-configuration-file): Rewrite using
  'gexp->derivation'.
* gnu/system.scm (operating-system-derivation): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2014-04-28 23:40:24 +02:00
parent 23f6056b50
commit f6a7b21df7
2 changed files with 31 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gnu/system.scm
View File

@ -282,26 +282,25 @@ we're running in the final root."
((profile (operating-system-profile os)) ((profile (operating-system-profile os))
(etc (operating-system-etc-directory os)) (etc (operating-system-etc-directory os))
(services (sequence %store-monad (operating-system-services os))) (services (sequence %store-monad (operating-system-services os)))
(boot-drv (operating-system-boot-script os)) (boot (operating-system-boot-script os))
(boot -> (derivation->output-path boot-drv))
(kernel -> (operating-system-kernel os)) (kernel -> (operating-system-kernel os))
(initrd (operating-system-initrd os)) (initrd (operating-system-initrd os))
(initrd-file -> (string-append (derivation->output-path initrd) (initrd-file -> #~(string-append #$initrd "/initrd"))
"/initrd"))
(entries -> (list (menu-entry (entries -> (list (menu-entry
(label (string-append (label (string-append
"GNU system with " "GNU system with "
(package-full-name kernel) (package-full-name kernel)
" (technology preview)")) " (technology preview)"))
(linux kernel) (linux kernel)
(linux-arguments `("--root=/dev/sda1" (linux-arguments
,(string-append "--load=" boot))) (list "--root=/dev/sda1"
#~(string-append "--load=" #$boot)))
(initrd initrd-file)))) (initrd initrd-file))))
(grub.cfg (grub-configuration-file entries))) (grub.cfg (grub-configuration-file entries)))
(file-union "system" (file-union "system"
`(("boot" ,#~#$boot-drv) `(("boot" ,#~#$boot)
("kernel" ,#~#$kernel) ("kernel" ,#~#$kernel)
("initrd" ,#~(string-append #$initrd "/initrd")) ("initrd" ,initrd-file)
("profile" ,#~#$profile) ("profile" ,#~#$profile)
("grub.cfg" ,#~#$grub.cfg) ("grub.cfg" ,#~#$grub.cfg)
("etc" ,#~#$etc))))) ("etc" ,#~#$etc)))))

53
gnu/system/grub.scm
View File

@ -22,6 +22,7 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (menu-entry #:export (menu-entry
@ -40,45 +41,39 @@
(label menu-entry-label) (label menu-entry-label)
(linux menu-entry-linux) (linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments (linux-arguments menu-entry-linux-arguments
(default '())) (default '())) ; list of string-valued gexps
(initrd menu-entry-initrd)) ; file name of the initrd (initrd menu-entry-initrd)) ; file name of the initrd as a gexp
(define* (grub-configuration-file entries (define* (grub-configuration-file entries
#:key (default-entry 1) (timeout 5) #:key (default-entry 1) (timeout 5)
(system (%current-system))) (system (%current-system)))
"Return the GRUB configuration file for ENTRIES, a list of "Return the GRUB configuration file for ENTRIES, a list of
<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT." <menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
(define (prologue kernel) (define entry->gexp
(format #f "
set default=~a
set timeout=~a
search.file ~a~%"
default-entry timeout kernel))
(define (bzImage)
(any (match-lambda
(($ <menu-entry> _ linux)
(package-file linux "bzImage"
#:system system)))
entries))
(define entry->text
(match-lambda (match-lambda
(($ <menu-entry> label linux arguments initrd) (($ <menu-entry> label linux arguments initrd)
(mlet %store-monad ((linux (package-file linux "bzImage" #~(format port "menuentry ~s {
#:system system))) linux ~a/bzImage ~a
(return (format #f "menuentry ~s {
linux ~a ~a
initrd ~a initrd ~a
}~%" }~%"
label #$label
linux (string-join arguments) initrd)))))) #$linux (string-join (list #$@arguments))
#$initrd))))
(mlet %store-monad ((kernel (bzImage)) (define builder
(body (sequence %store-monad #~(call-with-output-file #$output
(map entry->text entries)))) (lambda (port)
(text-file "grub.cfg" (format port "
(string-append (prologue kernel) set default=~a
(string-concatenate body))))) set timeout=~a
search.file ~a/bzImage~%"
#$default-entry #$timeout
#$(any (match-lambda
(($ <menu-entry> _ linux)
linux))
entries))
#$@(map entry->gexp entries))))
(gexp->derivation "grub.cfg" builder))
;;; grub.scm ends here ;;; grub.scm ends here