From mboxrd@z Thu Jan 1 00:00:00 1970 From: Danny Milosavljevic Subject: guix bootloader selection - wip patch Date: Wed, 27 Jul 2016 22:29:24 +0200 Message-ID: <20160727222924.07209026@scratchpost.org> References: <20160721223501.3a989d55@scratchpost.org> <877fc815wg.fsf@gnu.org> <20160727113248.2ee9087c@scratchpost.org> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:57503) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bSVSW-0001uo-PX for guix-devel@gnu.org; Wed, 27 Jul 2016 16:29:43 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bSVSR-0001y4-MS for guix-devel@gnu.org; Wed, 27 Jul 2016 16:29:40 -0400 In-Reply-To: <20160727113248.2ee9087c@scratchpost.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: Ludovic =?UTF-8?B?Q291cnTDqHM=?= Cc: guix-devel Hi, so far I came up with the patch to Guix below for the actual bootloader sel= ection. Some places are still broken. Search for "FIXME" below. For example I need a way to find out what the bootloader config file is sup= posed to be called in the new routine 'install-bootloader . It will get (de= rivation->output-path bootloader-configuration-file) as argument. Given it,= can I still find out whether the filename is "grub.cfg" or "extlinux.conf"= ? Is that safe enough? diff --git a/gnu.scm b/gnu.scm index 932e4cd..9207e38 100644 --- a/gnu.scm +++ b/gnu.scm @@ -35,6 +35,7 @@ (gnu system mapped-devices) (gnu system file-systems) (gnu system grub) ; 'grub-configuration' + (gnu system u-boot) ; 'u-boot-configuration' (gnu system pam) (gnu system shadow) ; 'user-account' (gnu system linux-initrd) diff --git a/gnu/build/install.scm b/gnu/build/install.scm index aebf38c..b799e00 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -21,7 +21,7 @@ #:use-module (guix build store-copy) #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:export (install-grub + #:export (install-bootloader populate-root-file-system reset-timestamps register-closure @@ -36,27 +36,48 @@ ;;; ;;; Code: =20 -(define* (install-grub grub.cfg device mount-point) - "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on -MOUNT-POINT. - -Note that the caller must make sure that GRUB.CFG is registered as a GC ro= ot -so that the fonts, background images, etc. referred to by GRUB.CFG are not -GC'd." - (let* ((target (string-append mount-point "/boot/grub/grub.cfg")) - (pivot (string-append target ".new"))) +(define* (install-bootloader-config source target) + (let* ((pivot (string-append target ".new"))) (mkdir-p (dirname target)) =20 - ;; Copy GRUB.CFG instead of just symlinking it, because symlinks won't + ;; Copy bootloader config file instead of just symlinking it, because = symlinks won't ;; work when /boot is on a separate partition. Do that atomically. - (copy-file grub.cfg pivot) - (rename-file pivot target) + (copy-file source pivot) + (rename-file pivot target))) =20 - (unless (zero? (system* "grub-install" "--no-floppy" +;; TODO split install-bootloader-config off completely? +(define* (install-grub grub.cfg device mount-point) + "Install bootloader with GRUB.CFG on DEVICE, which is assumed to be +mounted on MOUNT-POINT. + +Note that the caller must make sure that GRUB.CFG is registered as a GC ro= ot so that +the fonts, background images, etc. referred to by GRUB.CFG are not GC'd." + (install-bootloader-config grub.cfg + (string-append mount-point + "/boot/grub/grub.cfg")) + (unless (zero? (system* "grub-install" + "--no-floppy" "--boot-directory" (string-append mount-point "/boot") device)) - (error "failed to install GRUB")))) + (error "failed to install GRUB"))) + +(define* (install-u-boot extlinux.conf device mount-point) + "Install U-Boot with EXTLINUX.CONF on DEVICE, which is assumed to be mou= nted on +MOUNT-POINT. FIXME is that correct?" + (install-bootloader-config extlinux.conf + (string-append mount-point + "/extlinux.conf")) + (unless (zero? (system* "u-boot-install" + (string-append "--boot-directory=3D" mount-poi= nt) + device)) + (error "failed to install U-Boot"))) + +(define* (install-bootloader config-filename device mount-point) + "Install bootloader with CONFIG-FILENAME on DEVICE, which is assumed to = be +mounted on MOUNT-POINT." + ; FIXME install-u-boot match + (install-grub config-filename device mount-point)) =20 (define (evaluate-populate-directive directive target) "Evaluate DIRECTIVE, an sexp describing a file or directory to create un= der diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index cc5cf45..c81e437 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -287,18 +287,20 @@ SYSTEM-DIRECTORY is the name of the directory of the = 'system' derivation." (unless register-closures? (reset-timestamps target)))) =20 -(define (register-grub.cfg-root target grub.cfg) - "On file system TARGET, register GRUB.CFG as a GC root." +(define (register-bootloader-configuration-file-root target bootloader-con= figuration-filename) + "On file system TARGET, register BOOTLOADER-CONFIGURATION-FILENAME as a = GC root." (let ((directory (string-append target "/var/guix/gcroots"))) (mkdir-p directory) - (symlink grub.cfg (string-append directory "/grub.cfg")))) + ; FIXME fix grub.cfg + (symlink bootloader-configuration-filename (string-append directory "/= grub.cfg")))) =20 (define* (initialize-hard-disk device #:key - grub.cfg + bootloader-configuration-filename (partitions '())) "Initialize DEVICE as a disk containing all the objects list= ed -in PARTITIONS, and using GRUB.CFG as its bootloader configuration file. +in PARTITIONS, and using BOOTLOADER-CONFIGURATION-FILENAME +as its bootloader configuration file. =20 Each partition is initialized by calling its 'initializer' procedure, passing it a directory name where it is mounted." @@ -313,10 +315,10 @@ passing it a directory name where it is mounted." (display "mounting root partition...\n") (mkdir-p target) (mount (partition-device root) target (partition-file-system root)) - (install-grub grub.cfg device target) + (install-bootloader bootloader-configuration-filename device target) =20 - ;; Register GRUB.CFG as a GC root. - (register-grub.cfg-root target grub.cfg) + ;; Register BOOTLOADER-CONFIGURATION-FILENAME as a GC root. + (register-bootloader-configuration-file-root target bootloader-configu= ration-filename) =20 (umount target))) =20 diff --git a/gnu/system.scm b/gnu/system.scm index 476720b..3cee2f7 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -47,6 +47,7 @@ #:use-module (gnu services shepherd) #:use-module (gnu services base) #:use-module (gnu system grub) + #:use-module (gnu system u-boot) #:use-module (gnu system shadow) #:use-module (gnu system nss) #:use-module (gnu system locale) @@ -89,11 +90,13 @@ =20 operating-system-derivation operating-system-profile - operating-system-grub.cfg + operating-system-bootloader-configuration-file operating-system-etc-directory operating-system-locale-directory operating-system-boot-script =20 + bootloader-configuration-device + boot-parameters boot-parameters? boot-parameters-label @@ -122,7 +125,7 @@ (default linux-libre)) (kernel-arguments operating-system-kernel-arguments (default '())) ; list of gexps/strings - (bootloader operating-system-bootloader) ; + (bootloader operating-system-bootloader) ; o= r =20 (initrd operating-system-initrd ; (list fs) -> M derivat= ion (default base-initrd)) @@ -695,8 +698,15 @@ listed in OS. The C library expects to find it under "Return the file system that contains the store of OS." (store-file-system (operating-system-file-systems os))) =20 -(define* (operating-system-grub.cfg os #:optional (old-entries '())) - "Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate= the +(define (bootloader-configuration-device bootloader-configuration) + (match bootloader-configuration + (($ config) + (grub-configuration-device config)) + (($ config) + (u-boot-configuration-device config)))) + +(define* (operating-system-bootloader-configuration-file os #:optional (ol= d-entries '())) + "Return the bootloader configuration file for OS. Use OLD-ENTRIES to po= pulate the \"old entries\" menu." (mlet* %store-monad ((system (operating-system-derivation os)) @@ -716,13 +726,19 @@ listed in OS. The C library expects to find it under "/boot") (operating-system-kernel-arguments os))) (initrd #~(string-append #$system "/initrd"))))= )) - (grub-configuration-file (operating-system-bootloader os) - store-fs entries - #:old-entries old-entries))) + (match (operating-system-bootloader os) + (($ config) + (grub-configuration-file config + store-fs entries + #:old-entries old-entries)) + (($ config) + (u-boot-configuration-file config + store-fs entries + #:old-entries old-entries))))) =20 (define (operating-system-parameters-file os) "Return a file that describes the boot parameters of OS. The primary us= e of -this file is the reconstruction of GRUB menu entries for old configuration= s." +this file is the reconstruction of bootloader menu entries for old configu= rations." (mlet %store-monad ((initrd (operating-system-initrd-file os)) (root -> (operating-system-root-file-system os)) (label -> (kernel->grub-label diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 45b46ca..a38bcca 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -47,6 +47,7 @@ %background-image %default-theme =20 + grub-configuration grub-configuration? grub-configuration-device diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index c31e3a8..a615855 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -188,7 +188,7 @@ made available under the /xchg CIFS share." (file-system-type "ext4") file-system-label os-derivation - grub-configuration + bootloader-configuration-filename (register-closures? #t) (inputs '()) copy-inputs?) @@ -196,8 +196,9 @@ made available under the /xchg CIFS share." 'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE. Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the = root partition. The returned image is a full disk image that runs OS-DERIVATIO= N, -with a GRUB installation that uses GRUB-CONFIGURATION as its configuration -file (GRUB-CONFIGURATION must be the name of a file in the VM.) +with a bootloader installation that uses BOOTLOADER-CONFIGURATION-FILENAME= as its +configuration file (BOOTLOADER-CONFIGURATION-FILENAME must be the name of a +file in the VM.) =20 INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, = copy all of INPUTS into the image being built. When REGISTER-CLOSURES? is true, @@ -243,7 +244,8 @@ the image." (initializer initialize))))) (initialize-hard-disk "/dev/vda" #:partitions partitions - #:grub.cfg #$grub-configuration) + #:bootloader-configuration-filename + #$bootloader-configuration-filename) (reboot))))) #:system system #:make-disk-image? #t @@ -295,10 +297,10 @@ to USB sticks meant to be read-only." file-systems-to-keep))))) =20 (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (grub.cfg (operating-system-grub.cfg os))) + (bootloader-configuration-filename (operating-sys= tem-bootloader-configuration-file os))) (qemu-image #:name name #:os-derivation os-drv - #:grub-configuration grub.cfg + #:bootloader-configuration-filename bootloader-configura= tion-filename #:disk-image-size disk-image-size #:disk-image-format "raw" #:file-system-type file-system-type @@ -306,7 +308,7 @@ to USB sticks meant to be read-only." #:copy-inputs? #t #:register-closures? #t #:inputs `(("system" ,os-drv) - ("grub.cfg" ,grub.cfg)))))) + ("grub.cfg" ,bootloader-configuration-filenam= e)))))) =20 (define* (system-qemu-image os #:key @@ -340,13 +342,13 @@ of the GNU system as described by OS." file-systems-to-keep))))) (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (grub.cfg (operating-system-grub.cfg os))) + (bootloader-configuration-filename (operating-system-bootloade= r-configuration-file os))) (qemu-image #:os-derivation os-drv - #:grub-configuration grub.cfg + #:bootloader-configuration-filename bootloader-configur= ation-filename #:disk-image-size disk-image-size #:file-system-type file-system-type #:inputs `(("system" ,os-drv) - ("grub.cfg" ,grub.cfg)) + ("grub.cfg" ,bootloader-configuration-filena= me)) #:copy-inputs? #t)))) =20 =0C @@ -428,16 +430,16 @@ When FULL-BOOT? is true, return an image that does a = complete boot sequence, bootloaded included; thus, make a disk image that contains everything the bootloader refers to: OS kernel, initrd, bootloader data, etc." (mlet* %store-monad ((os-drv (operating-system-derivation os)) - (grub.cfg (operating-system-grub.cfg os))) + (bootloader-configuration-file (operating-system-bo= otloader-configuration-file os))) ;; XXX: When FULL-BOOT? is true, we end up creating an image that cont= ains - ;; GRUB.CFG and all its dependencies, including the output of OS-DRV. - ;; This is more than needed (we only need the kernel, initrd, GRUB for= its + ;; BOOTLOADER-CONFIGURATION-FILENAME and all its dependencies, includi= ng the output of OS-DRV. + ;; This is more than needed (we only need the kernel, initrd, the boot= loader for its ;; font, and the background image), but it's hard to filter that. (qemu-image #:os-derivation os-drv - #:grub-configuration grub.cfg + #:bootloader-configuration-filename bootloader-configurati= on-file #:disk-image-size disk-image-size #:inputs (if full-boot? - `(("grub.cfg" ,grub.cfg)) + `(("grub.cfg" ,bootloader-configuration-file)) '()) =20 ;; XXX: Passing #t here is too slow, so let it off by defa= ult. diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index e2c6b2e..7214a36 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -125,9 +125,10 @@ TARGET, and register them." (map (cut copy-item <> target #:log-port log-port) to-copy)))) =20 -(define (install-grub* grub.cfg device target) - "This is a variant of 'install-grub' with error handling, lifted in +(define (install-bootloader* cfg device target) + "This is a variant of 'install-bootloader' with error handling, lifted in %STORE-MONAD" +; FIXME name (let* ((gc-root (string-append target %gc-roots-directory "/grub.cfg")) (temp-gc-root (string-append gc-root ".new")) @@ -135,26 +136,27 @@ TARGET, and register them." (make-symlink (lift2 switch-symlinks %store-monad)) (rename (lift2 rename-file %store-monad))) (mbegin %store-monad - ;; Prepare the symlink to GRUB.CFG to make sure that it's a GC root = when - ;; 'install-grub' completes (being a bit paranoid.) - (make-symlink temp-gc-root grub.cfg) + ;; Prepare the symlink to CFG to make sure that it's a GC root when + ;; 'install-bootloader' completes (being a bit paranoid.) + (make-symlink temp-gc-root cfg) =20 - (munless (false-if-exception (install-grub grub.cfg device target)) + (munless (false-if-exception (install-bootloader cfg device target)) (delete-file temp-gc-root) - (leave (_ "failed to install GRUB on device '~a'~%") device)) + (leave (_ "failed to install bootloader on device '~a'~%") device)) =20 - ;; Register GRUB.CFG as a GC root so that its dependencies (backgrou= nd + ;; Register CFG as a GC root so that its dependencies (background ;; image, font, etc.) are not reclaimed. (rename temp-gc-root gc-root)))) =20 (define* (install os-drv target #:key (log-port (current-output-port)) - grub? grub.cfg device) - "Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to -directory TARGET. TARGET must be an absolute directory name since that's = what -'guix-register' expects. + bootloader? bootloader-configuration-filename device) + "Copy the closure of BOOTLOADER-CONFIGURATION-FILENAME, which includes t= he +output of OS-DRV, to directory TARGET. TARGET must be an absolute directo= ry +name since that's what 'guix-register' expects. =20 -When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG." +When BOOTLOADER? is true, install bootloader on DEVICE, using +BOOTLOADER-CONFIGURATION-FILENAME." (define (maybe-copy to-copy) (with-monad %store-monad (if (string=3D? target "/") @@ -183,16 +185,16 @@ the ownership of '~a' may be incorrect!~%") (populate (lift2 populate-root-file-system %store-monad))) =20 (mbegin %store-monad - ;; Copy the closure of GRUB.CFG, which includes OS-DIR, GRUB's - ;; background image and so on. - (maybe-copy grub.cfg) + ;; Copy the closure of BOOTLOADER-CONFIGURATION-FILENAME, + ;; which includes OS-DIR, the background image and so on. + (maybe-copy bootloader-configuration-filename) =20 ;; Create a bunch of additional files. (format log-port "populating '~a'...~%" target) (populate os-dir target) =20 - (mwhen grub? - (install-grub* grub.cfg device target))))) + (mwhen bootloader? + (install-bootloader* bootloader-configuration-filename device targ= et))))) =20 =0C ;;; @@ -384,7 +386,7 @@ it atomically, and then run OS's activation script." (date->string (time-utc->date time) "~Y-~m-~d ~H:~M"))) =20 -(define* (previous-grub-entries #:optional (profile %system-profile)) +(define* (previous-bootloader-entries #:optional (profile %system-profile)) "Return a list of 'menu-entry' for the generations of PROFILE." (define (system->grub-entry system number time) (unless-file-not-found @@ -543,13 +545,13 @@ PATTERN, a string. When PATTERN is #f, display all t= he system generations." (warning (_ "Failing to do that may downgrade your system!~%")))) =20 (define* (perform-action action os - #:key grub? dry-run? derivations-only? + #:key bootloader? dry-run? derivations-only? use-substitutes? device target image-size full-boot? (mappings '())) - "Perform ACTION for OS. GRUB? specifies whether to install GRUB; DEVICE= is -the target devices for GRUB; TARGET is the target root directory; IMAGE-SI= ZE -is the size of the image to be built, for the 'vm-image' and 'disk-image' + "Perform ACTION for OS. BOOTLOADER? specifies whether to install the bo= otloade; +DEVICE is the target device for the bootloader; TARGET is the target root = directory; +IMAGE-SIZE is the size of the image to be built, for the 'vm-image' and 'd= isk-image' actions. FULL-BOOT? is used for the 'vm' action; it determines whether to boot directly to the kernel or to the bootloader. =20 @@ -566,21 +568,21 @@ building anything." #:image-size image-size #:full-boot? full-boot? #:mappings mappings)) - (grub (package->derivation grub)) - (grub.cfg (if (eq? 'container action) + (grub (package->derivation grub)) ; FIXME U-Boot + (bootloader-configuration-file (if (eq? 'container action) (return #f) - (operating-system-grub.cfg os + (operating-system-bootloader-configuration-file os (if (eq? 'init action) '() - (previous-grub-entrie= s))))) + (previous-bootloader-= entries))))) =20 - ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if - ;; --no-grub is passed, because GRUB.CFG because we then use it as = a GC - ;; root. See . + ;; For 'init' and 'reconfigure', always build BOOTLOADER-CONFIGURAT= ION-FILE, + ;; even if --no-bootloader is passed, because we then use + ;; it as a GC root. See . (drvs -> (if (memq action '(init reconfigure)) - (if grub? - (list sys grub.cfg grub) - (list sys grub.cfg)) + (if bootloader? + (list sys bootloader-configuration-file grub) ; = FIXME U-Boot + (list sys bootloader-configuration-file)) (list sys))) (% (if derivations-only? (return (for-each (compose println derivation-file-n= ame) @@ -595,8 +597,8 @@ building anything." drvs) =20 ;; Make sure GRUB is accessible. - (when grub? - (let ((prefix (derivation->output-path grub))) + (when bootloader? + (let ((prefix (derivation->output-path grub))) ; FIXME bootloa= der (setenv "PATH" (string-append prefix "/bin:" prefix "/sbin:" (getenv "PATH"))))) @@ -605,16 +607,16 @@ building anything." ((reconfigure) (mbegin %store-monad (switch-to-system os) - (mwhen grub? - (install-grub* (derivation->output-path grub.cfg) + (mwhen bootloader? + (install-bootloader* (derivation->output-path bootloader-= configuration-file) device "/")))) ((init) (newline) (format #t (_ "initializing operating system under '~a'...~%") target) (install sys (canonicalize-path target) - #:grub? grub? - #:grub.cfg (derivation->output-path grub.cfg) + #:bootloader? bootloader? + #:bootloader-configuration-filename (derivation->out= put-path bootloader-configuration-file) #:device device)) (else ;; All we had to do was to build SYS. @@ -684,7 +686,7 @@ Build the operating system declared in FILE according t= o ACTION.\n")) (display (_ " --image-size=3DSIZE for 'vm-image', produce an image of SIZE")) (display (_ " - --no-grub for 'init', do not install GRUB")) + --no-bootloader for 'init', do not install bootloader")) (display (_ " --share=3DSPEC for 'vm', share host file system according to S= PEC")) (display (_ " @@ -719,9 +721,9 @@ Build the operating system declared in FILE according t= o ACTION.\n")) (lambda (opt name arg result) (alist-cons 'image-size (size->number arg) result))) - (option '("no-grub") #f #f + (option '("no-bootloader") #f #f (lambda (opt name arg result) - (alist-cons 'install-grub? #f result))) + (alist-cons 'install-bootloader? #f result))) (option '("full-boot") #f #f (lambda (opt name arg result) (alist-cons 'full-boot? #t result))) @@ -755,7 +757,7 @@ Build the operating system declared in FILE according t= o ACTION.\n")) (max-silent-time . 3600) (verbosity . 0) (image-size . ,(* 900 (expt 2 20))) - (install-grub? . #t))) + (install-bootloader? . #t))) =20 =0C ;;; @@ -777,12 +779,12 @@ resulting from command-line parsing." (leave (_ "no configuration file specified~%")))) =20 (dry? (assoc-ref opts 'dry-run?)) - (grub? (assoc-ref opts 'install-grub?)) + (bootloader? (assoc-ref opts 'install-bootloader?)) (target (match args ((first second) second) (_ #f))) - (device (and grub? - (grub-configuration-device + (device (and bootloader? + (bootloader-configuration-device (operating-system-bootloader os))))) =20 (with-store store @@ -809,7 +811,7 @@ resulting from command-line parsing." m) (_ #f)) opts) - #:grub? grub? + #:bootloader? bootloader? #:target target #:device device)))) #:system system)))) =20