From mboxrd@z Thu Jan 1 00:00:00 1970 From: Danny Milosavljevic Subject: wip v2 u-boot support Date: Mon, 5 Sep 2016 22:29:11 +0200 Message-ID: <20160905222911.7ee7a4a5@scratchpost.org> References: <20160905215803.3d6c0189@scratchpost.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/KWgGadWTeJN9ha/PcmekjqO" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:44741) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bh0W9-0001hb-4U for guix-devel@gnu.org; Mon, 05 Sep 2016 16:29:24 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bh0W4-0002HF-SQ for guix-devel@gnu.org; Mon, 05 Sep 2016 16:29:20 -0400 Received: from dd1012.kasserver.com ([85.13.128.8]:53258) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bh0W4-0002Gy-E5 for guix-devel@gnu.org; Mon, 05 Sep 2016 16:29:16 -0400 In-Reply-To: <20160905215803.3d6c0189@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: David Craven Cc: guix-devel@gnu.org --MP_/KWgGadWTeJN9ha/PcmekjqO Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline Whoops, now with the correct u-boot.scm On Mon, 5 Sep 2016 21:58:03 +0200 Danny Milosavljevic wrote: > Hi David, > > I thought I'd post a minimal version for U-Boot support without any renames that aren't absolutely necessary. In this way, the patch is quite small. > > I think I also figured out how to pass the name of the bootloader installation executable - that's also included. > > Let's see whether it works. > > See attachement... > > I assume that gnu/system/u-boot.scm already exists. > > If it doesn't, I've also attached the latest version of it. > > As you can see it's no big deal. > > Note that the only reasons is distinct from are: > - The field "board" which contains the board name is necessary in but not . > - The system config's "operating-system" definition contains a "bootloader" field that is actually a bootloader-configuration (rather than the actual bootloader package or similar). Hence there would be no way to find out which bootloader to install if the configuration wasn't a different data structure. > > I'm not sure those are good enough reasons to justify distinguishing them. > > It would also be possible to change the system config to something like > > (operating-system > (bootloader grub (bootloader-configuration ...))) > > and > > (operating-system > (bootloader (make-u-boot-package "my_great_system") (bootloader-configuration ...))) > > and then drop "board". In that case, would be the same as - but grub-configuration supports theming which u-boot-configuration doesn't. We could just ignore the theme parts in that case, though. --MP_/KWgGadWTeJN9ha/PcmekjqO Content-Type: text/x-scheme Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=u-boot.scm ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2013, 2014, 2015, 2016 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2016 Danny Milosavljevic ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu system u-boot) #:use-module (guix store) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix records) #:use-module (guix monads) #:use-module (guix gexp) #:use-module (guix download) #:use-module (gnu artwork) #:use-module (gnu system file-systems) #:autoload (gnu packages u-boot) (make-u-boot-package) #:use-module (gnu system grub) ; #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:export (u-boot-configuration u-boot-configuration? u-boot-configuration-board u-boot-configuration-package u-boot-configuration-device u-boot-configuration-file)) ;;; Commentary: ;;; ;;; Configuration of U-Boot. ;;; ;;; Code: (define-record-type* u-boot-configuration make-u-boot-configuration u-boot-configuration? (board u-boot-configuration-board) ; string ; not opt= ional! (u-boot u-boot-configuration-u-boot ; package (default #f)) ; will actually default to (make-u-boot-pa= ckage board) (device u-boot-configuration-device) ; string (menu-entries u-boot-configuration-menu-entries ; list (default '())) (default-entry u-boot-configuration-default-entry ; integer (default 0)) (timeout u-boot-configuration-timeout ; integer (default 5))) =0C (define (u-boot-configuration-package config) (or (u-boot-configuration-u-boot config) (make-u-boot-package (u-boot-configuration-board config)))) ;;; ;;; Configuration file. ;;; (define* (u-boot-configuration-file config store-fs entries #:key (system (%current-system)) (old-entries '())) "Return the U-Boot configuration file corresponding to CONFIG, a object, and where the store is available at STORE-FS= , a object. OLD-ENTRIES is taken to be a list of menu entries corresponding to old generations of the system." (define linux-image-name (if (string-prefix? "mips" system) "vmlinuz" "bzImage")) (define all-entries (append entries (u-boot-configuration-menu-entries config))) (define entry->gexp (match-lambda (($ label linux arguments initrd) ;; TODO MENU LABEL hotkeys (using caret) #~(format port "LABEL ~s MENU LABEL ~a KERNEL ~a/~a ~a INITRD ~a FDTDIR . APPEND ~a ~%" #$label #$linux #$linux-image-name #$initrd (string-join (list #$@arguments)))))) (define builder #~(call-with-output-file #$output (lambda (port) (let ((timeout #$(u-boot-configuration-timeout config))) (format port " DEFAULT ~a PROMPT ~d TIMEOUT ~a~%" #$(u-boot-configuration-default-entry config) (if (< timeout 0) 1 0) (* 10 timeout)) #$@(map entry->gexp all-entries) #$@(if (pair? old-entries) #~((format port "~%") #$@(map entry->gexp old-entries) (format port "~%")) #~()))))) (gexp->derivation "extlinux.conf" builder)) ;;; u-boot.scm ends here --MP_/KWgGadWTeJN9ha/PcmekjqO Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=wip-uboot-support.patch 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 7431a09..92740d5 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,28 +36,49 @@ ;;; ;;; Code: -(define* (install-grub grub.cfg device mount-point) +(define* (install-bootloader-config source target) + (let* ((pivot (string-append target ".new"))) + (mkdir-p (dirname target)) + + ;; 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 source pivot) + (rename-file pivot target))) + +(define* (install-grub grub-name grub.cfg device mount-point) "Install GRUB with GRUB.CFG on DEVICE, which is assumed to be mounted on -MOUNT-POINT. +MOUNT-POINT. FIXME is that correct? Note that the caller must make sure that GRUB.CFG is registered as a GC root 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"))) - (mkdir-p (dirname target)) - - ;; Copy GRUB.CFG 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) - + (let ((target (string-append mount-point "/boot/grub/grub.cfg"))) + (install-bootloader-config grub.cfg target) (unless (zero? (system* "grub-install" "--no-floppy" "--boot-directory" (string-append mount-point "/boot") device)) (error "failed to install GRUB")))) +(define* (install-u-boot u-boot-name extlinux.conf device mount-point) + "Install U-Boot with EXTLINUX.CONF on DEVICE, which is assumed to be mounted on +MOUNT-POINT. FIXME is that correct?" + (install-bootloader-config extlinux.conf + (string-append mount-point + "/extlinux.conf")) + (unless (zero? (system* (string-append u-boot-name "/bin/u-boot-install") + (string-append "--boot-directory=" mount-point) + device)) + (error "failed to install U-Boot"))) + +(define* (install-bootloader package-output-name config-filename device mount-point) + "Install bootloader with CONFIG-FILENAME on DEVICE, which is assumed to be +mounted on MOUNT-POINT." + (let* ((grub? (string-contains package-output-name "grub")) + (bootloader-installer (if grub? install-grub + install-u-boot))) + (bootloader-installer package-output-name config-filename device mount-point))) + (define (evaluate-populate-directive directive target) "Evaluate DIRECTIVE, an sexp describing a file or directory to create under directory TARGET." diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index cc5cf45..2e2079e 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -295,6 +295,7 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." (define* (initialize-hard-disk device #:key + grub grub.cfg (partitions '())) "Initialize DEVICE as a disk containing all the objects listed @@ -313,7 +314,7 @@ 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 grub grub.cfg device target) ;; Register GRUB.CFG as a GC root. (register-grub.cfg-root target grub.cfg) diff --git a/gnu/system.scm b/gnu/system.scm index 0802010..24e4e15 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,6 +90,7 @@ operating-system-derivation operating-system-profile + operating-system-grub operating-system-grub.cfg operating-system-etc-directory operating-system-locale-directory @@ -703,6 +705,13 @@ 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))) +(define (operating-system-grub os) + (match (operating-system-bootloader os) + ((? grub-configuration? config) + (grub-configuration-package config)) + ((? u-boot-configuration? config) + (u-boot-configuration-package config)))) + (define* (operating-system-grub.cfg os #:optional (old-entries '())) "Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the \"old entries\" menu." diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 45b46ca..4c9da8c 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -49,6 +49,7 @@ grub-configuration grub-configuration? + grub-configuration-package grub-configuration-device menu-entry @@ -141,6 +142,9 @@ (system* (string-append #$imagemagick "/bin/convert") "-resize" #$size #$image #$output))))) +(define (grub-configuration-package config) + grub) + (define* (grub-background-image config #:key (width 1024) (height 768)) "Return the GRUB background image defined in CONFIG with a ratio of WIDTH/HEIGHT, or #f if none was found." diff --git a/gnu/system/u-boot.scm b/gnu/system/u-boot.scm index acc529a..00a0165 100644 --- a/gnu/system/u-boot.scm +++ b/gnu/system/u-boot.scm @@ -35,7 +35,7 @@ #:export (u-boot-configuration u-boot-configuration? u-boot-configuration-board - u-boot-configuration-u-boot + u-boot-configuration-package u-boot-configuration-device u-boot-configuration-file)) @@ -61,6 +61,10 @@ +(define (u-boot-configuration-package config) + (or (u-boot-configuration-u-boot config) + (make-u-boot-package (u-boot-configuration-board config)))) + ;;; ;;; Configuration file. ;;; diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 4c53edc..e04d8fc 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -175,6 +175,7 @@ made available under the /xchg CIFS share." (file-system-type "ext4") file-system-label os-derivation + grub grub-configuration (register-closures? #t) (inputs '()) @@ -231,6 +232,7 @@ the image." (initializer initialize))))) (initialize-hard-disk "/dev/vda" #:partitions partitions + #:grub #$grub #:grub.cfg #$grub-configuration) (reboot))))) #:system system @@ -283,9 +285,11 @@ to USB sticks meant to be read-only." file-systems-to-keep))))) (mlet* %store-monad ((os-drv (operating-system-derivation os)) + (grub (operating-system-grub os)) (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:name name #:os-derivation os-drv + #:grub grub #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:disk-image-format "raw" @@ -330,6 +334,7 @@ of the GNU system as described by OS." ((os-drv (operating-system-derivation os)) (grub.cfg (operating-system-grub.cfg os))) (qemu-image #:os-derivation os-drv + #:grub grub #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:file-system-type file-system-type @@ -416,12 +421,14 @@ 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 (operating-system-grub os)) (grub.cfg (operating-system-grub.cfg os))) ;; XXX: When FULL-BOOT? is true, we end up creating an image that contains ;; 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 ;; font, and the background image), but it's hard to filter that. (qemu-image #:os-derivation os-drv + #:grub grub #:grub-configuration grub.cfg #:disk-image-size disk-image-size #:inputs (if full-boot? diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 953c624..738fa6b 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -126,7 +126,7 @@ TARGET, and register them." (map (cut copy-item <> target #:log-port log-port) to-copy)))) -(define (install-grub* grub.cfg device target) +(define (install-bootloader* grub grub.cfg device target) "This is a variant of 'install-grub' with error handling, lifted in %STORE-MONAD" (let* ((gc-root (string-append target %gc-roots-directory @@ -140,7 +140,7 @@ TARGET, and register them." ;; 'install-grub' completes (being a bit paranoid.) (make-symlink temp-gc-root grub.cfg) - (munless (false-if-exception (install-grub grub.cfg device target)) + (munless (false-if-exception (install-bootloader grub grub.cfg device target)) (delete-file temp-gc-root) (leave (_ "failed to install GRUB on device '~a'~%") device)) @@ -150,7 +150,7 @@ TARGET, and register them." (define* (install os-drv target #:key (log-port (current-output-port)) - grub? grub.cfg device) + grub 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. @@ -193,7 +193,7 @@ the ownership of '~a' may be incorrect!~%") (populate os-dir target) (mwhen grub? - (install-grub* grub.cfg device target))))) + (install-bootloader* grub grub.cfg device target))))) ;;; @@ -598,13 +598,15 @@ building anything." (mbegin %store-monad (switch-to-system os) (mwhen grub? - (install-grub* (derivation->output-path grub.cfg) - device "/")))) + (install-bootloader* (derivation->output-path grub) + (derivation->output-path grub.cfg) + device "/")))) ((init) (newline) (format #t (_ "initializing operating system under '~a'...~%") target) (install sys (canonicalize-path target) + #:grub grub #:grub? grub? #:grub.cfg (derivation->output-path grub.cfg) #:device device)) --MP_/KWgGadWTeJN9ha/PcmekjqO--