From mboxrd@z Thu Jan 1 00:00:00 1970 From: Danny Milosavljevic Subject: wip u-boot support Date: Mon, 5 Sep 2016 21:58:03 +0200 Message-ID: <20160905215803.3d6c0189@scratchpost.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/+i6jriCw7YJvb.nnEzrxX90" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:59522) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bh025-0005ul-0Y for guix-devel@gnu.org; Mon, 05 Sep 2016 15:58:19 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bh01z-0004Vl-WB for guix-devel@gnu.org; Mon, 05 Sep 2016 15:58:16 -0400 Received: from dd1012.kasserver.com ([85.13.128.8]:51085) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bh01z-0004Uw-Hv for guix-devel@gnu.org; Mon, 05 Sep 2016 15:58:11 -0400 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_/+i6jriCw7YJvb.nnEzrxX90 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline 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_/+i6jriCw7YJvb.nnEzrxX90 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_/+i6jriCw7YJvb.nnEzrxX90 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 2016 Danny Milosavljevic ;;; Copyright =C2=A9 2016 David Craven ;;; ;;; 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 packages u-boot) #:use-module (guix build-system gnu) #:use-module (guix download) #:use-module (guix packages) #:use-module ((guix licenses) #:prefix license:) #:use-module (gnu packages) #:use-module ((gnu packages algebra) #:select (bc)) #:use-module (gnu packages bison) #:use-module (gnu packages cross-base) #:use-module (gnu packages flex) #:use-module (gnu packages python)) (define-public dtc (package (name "dtc") (version "1.4.2") (source (origin (method url-fetch) (uri (string-append "https://www.kernel.org/pub/software/utils/dtc/" "dtc-" version ".tar.xz")) (sha256 (base32 "1b7si8niyca4wxbfah3qw4p4wli81mc1qwfhaswvrfqahklnwi8k")))) (build-system gnu-build-system) (native-inputs `(("bison" ,bison) ("flex" ,flex))) (arguments `(#:make-flags (list "CC=3Dgcc" (string-append "PREFIX=3D" (assoc-ref %outputs "out= "))) #:phases (modify-phases %standard-phases (add-after 'unpack 'patch-paths (lambda _ (substitute* "Makefile" (("/usr/bin/install") "install")) (substitute* "Makefile" (("PREFIX =3D \\$\\(HOME\\)") "")))) (delete 'configure)))) (home-page "https://www.devicetree.org") (synopsis "Compiles device tree source files") (description "@command{dtc} compiles device tree source files to device tree binary files. These are board description files used by Linux and BSD.= ") (license license:gpl2+))) (define u-boot (package (name "u-boot") (version "2016.07") (source (origin (method url-fetch) (uri (string-append "ftp://ftp.denx.de/pub/u-boot/" "u-boot-" version ".tar.bz2")) (sha256 (base32 "0lqj4ckmfqiap8mc6z2d5albs3g2h5mzccbn60hsgxhabhibfkwp")))) (native-inputs `(("bc" ,bc) ("dtc" ,dtc) ("python-2" ,python-2))) (build-system gnu-build-system) (home-page "http://www.denx.de/wiki/U-Boot/") (synopsis "ARM bootloader") (description "U-Boot is a bootloader used mostly for ARM boards. It also initializes the boards (RAM etc).") (license license:gpl2+))) (define (make-u-boot-package board triplet) "Returns a u-boot package for BOARD cross-compiled for TRIPLET." (package (inherit u-boot) (name (string-append "u-boot-" (string-downcase board))) (native-inputs `(("cross-gcc" ,(cross-gcc triplet)) ("cross-binutils" ,(cross-binutils triplet)) ,@(package-native-inputs u-boot))) (arguments `(#:test-target "test" #:make-flags (list "HOSTCC=3Dgcc" (string-append "CROSS_COMPILE=3D" ,triplet "-")) #:phases (modify-phases %standard-phases (replace 'configure (lambda* (#:key outputs make-flags #:allow-other-keys) (let ((config-name (string-append ,board "_defconfig"))) (if (file-exists? (string-append "configs/" config-name)) (zero? (apply system* "make" `(,@make-flags ,config-name= ))) (begin (display "Invalid board name. Valid board names are:") (let ((dir (opendir "configs")) (suffix-length (string-length "_defconfig"))) (do ((file-name (readdir dir) (readdir dir))) ((eof-object? file-name)) (when (string-suffix? "_defconfig" file-name) (format #t "- ~A\n" (string-drop-right file-name suffix-leng= th)))) (closedir dir)) #f))))) (replace 'install (lambda* (#:key outputs make-flags #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (libexec (string-append out "/libexec")) (uboot-files (find-files "." ".*\\.(bin|efi|spl)$"))) (mkdir-p libexec) (for-each (lambda (file) (let ((target-file (string-append libexec "/" file))) (mkdir-p (dirname target-file)) (copy-file file target-file))) uboot-files))))))))) (define-public u-boot-vexpress_ca9x4 (make-u-boot-package "vexpress_ca9x4" "arm-linux-gnueabihf")) (define-public u-boot-malta (make-u-boot-package "malta" "mips64el-linux-gnuabi64")) --MP_/+i6jriCw7YJvb.nnEzrxX90--