diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | gnu/packages/bootloaders.scm | 142 | ||||
| -rw-r--r-- | guix/build/kconfig.scm | 183 |
3 files changed, 248 insertions, 78 deletions
diff --git a/Makefile.am b/Makefile.am index c3af23b68e..75c9df573c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -237,6 +237,7 @@ MODULES = \ guix/build/waf-build-system.scm \ guix/build/haskell-build-system.scm \ guix/build/julia-build-system.scm \ + guix/build/kconfig.scm \ guix/build/linux-module-build-system.scm \ guix/build/store-copy.scm \ guix/build/json.scm \ diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm index 210bc30536..d8fe481abc 100644 --- a/gnu/packages/bootloaders.scm +++ b/gnu/packages/bootloaders.scm @@ -74,6 +74,7 @@ #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (ice-9 optargs) #:use-module (ice-9 regex)) (define unifont @@ -688,8 +689,9 @@ def test_ctrl_c")) also initializes the boards (RAM etc). This package provides its board-independent tools."))) -(define-public (make-u-boot-package board triplet) - "Returns a u-boot package for BOARD cross-compiled for TRIPLET." +(define*-public (make-u-boot-package board triplet #:key defconfig configs) + "Returns a u-boot package for BOARD cross-compiled for TRIPLET with the +optional DEFCONFIG file and optional configuration changes from CONFIGS." (let ((same-arch? (lambda () (string=? (%current-system) (gnu-triplet->nix-system triplet))))) @@ -707,8 +709,11 @@ board-independent tools."))) (arguments `(#:modules ((ice-9 ftw) (srfi srfi-1) - (guix build utils) - (guix build gnu-build-system)) + (guix build gnu-build-system) + (guix build kconfig) + (guix build utils)) + #:imported-modules (,@%gnu-build-system-modules + (guix build kconfig)) #:test-target "test" #:make-flags (list "HOSTCC=gcc" @@ -719,9 +724,19 @@ board-independent tools."))) (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)) - (apply invoke "make" `(,@make-flags ,config-name)) + (let* ((config-name (string-append ,board "_defconfig")) + (config-file (string-append "configs/" config-name)) + (defconfig ,defconfig) + (configs ',configs)) + (when defconfig + ;; Replace the board-specific defconfig with the given one. + (copy-file defconfig config-file)) + (if (file-exists? config-file) + (begin + (when configs + (modify-defconfig config-file configs)) + (apply invoke "make" `(,@make-flags ,config-name)) + (verify-config ".config" config-file)) (begin (display "Invalid board name. Valid board names are:" (current-error-port)) @@ -775,7 +790,12 @@ board-independent tools."))) (make-u-boot-package "malta" "mips64el-linux-gnuabi64")) (define-public u-boot-am335x-boneblack - (let ((base (make-u-boot-package "am335x_evm" "arm-linux-gnueabihf"))) + (let ((base (make-u-boot-package + "am335x_evm" "arm-linux-gnueabihf" + ;; Patch out other device trees to build an image small enough + ;; to fit within typical partitioning schemes where the first + ;; partition begins at sector 2048. + #:configs '("CONFIG_OF_LIST=\"am335x-evm am335x-boneblack\"")))) (package (inherit base) (name "u-boot-am335x-boneblack") @@ -784,43 +804,28 @@ also initializes the boards (RAM etc). This U-Boot is built for the BeagleBone Black, which was removed upstream, adjusted from the am335x_evm build with several device trees removed so that -it fits within common partitioning schemes.") - (arguments - (substitute-keyword-arguments (package-arguments base) - ((#:phases phases) - `(modify-phases ,phases - (add-after 'unpack 'patch-defconfig - ;; Patch out other devicetrees to build image small enough to - ;; fit within typical partitioning schemes where the first - ;; partition begins at sector 2048. - (lambda _ - (substitute* "configs/am335x_evm_defconfig" - (("CONFIG_OF_LIST=.*$") "CONFIG_OF_LIST=\"am335x-evm am335x-boneblack\"\n")) - #t))))))))) +it fits within common partitioning schemes.")))) (define-public u-boot-am335x-evm (make-u-boot-package "am335x_evm" "arm-linux-gnueabihf")) -(define-public (make-u-boot-sunxi64-package board triplet) - (let ((base (make-u-boot-package board triplet))) +(define*-public (make-u-boot-sunxi64-package board triplet + #:key defconfig configs) + (let ((base (make-u-boot-package + board triplet #:defconfig defconfig #:configs configs))) (package (inherit base) (arguments - (substitute-keyword-arguments (package-arguments base) - ((#:phases phases) - `(modify-phases ,phases - (add-after 'unpack 'set-environment - (lambda* (#:key native-inputs inputs #:allow-other-keys) - (let ((bl31 - (string-append - (assoc-ref (or native-inputs inputs) "firmware") - "/bl31.bin"))) - (setenv "BL31" bl31) - ;; This is necessary when we're using the bundled dtc. - ;(setenv "PATH" (string-append (getenv "PATH") ":" - ; "scripts/dtc")) - ) - #t)))))) + (substitute-keyword-arguments (package-arguments base) + ((#:phases phases) + `(modify-phases ,phases + (add-after 'unpack 'set-environment + (lambda* (#:key native-inputs inputs #:allow-other-keys) + (let ((bl31 + (string-append + (assoc-ref (or native-inputs inputs) "firmware") + "/bl31.bin"))) + (setenv "BL31" bl31)))))))) (native-inputs `(("firmware" ,arm-trusted-firmware-sun50i-a64) ,@(package-native-inputs base)))))) @@ -832,20 +837,11 @@ it fits within common partitioning schemes.") (make-u-boot-sunxi64-package "pine64-lts" "aarch64-linux-gnu")) (define-public u-boot-pinebook - (let ((base (make-u-boot-sunxi64-package "pinebook" "aarch64-linux-gnu"))) - (package - (inherit base) - (arguments - (substitute-keyword-arguments (package-arguments base) - ((#:phases phases) - `(modify-phases ,phases - (add-after 'unpack 'patch-pinebook-config - ;; Fix regression with LCD video output introduced in 2020.01 - ;; https://patchwork.ozlabs.org/patch/1225130/ - (lambda _ - (substitute* "configs/pinebook_defconfig" - (("CONFIG_VIDEO_BRIDGE_ANALOGIX_ANX6345=y") "CONFIG_VIDEO_BRIDGE_ANALOGIX_ANX6345=y\nCONFIG_VIDEO_BPP32=y")) - #t))))))))) + (make-u-boot-sunxi64-package + "pinebook" "aarch64-linux-gnu" + ;; Fix regression with LCD video output introduced in 2020.01 + ;; https://patchwork.ozlabs.org/patch/1225130/ + #:configs '("CONFIG_VIDEO_BPP32=y"))) (define-public u-boot-bananapi-m2-ultra (make-u-boot-package "Bananapi_M2_Ultra" "arm-linux-gnueabihf")) @@ -896,25 +892,18 @@ device while it's being turned on (and a while longer).") (make-u-boot-package "mx6cuboxi" "arm-linux-gnueabihf")) (define-public u-boot-novena - (let ((base (make-u-boot-package "novena" "arm-linux-gnueabihf"))) + (let ((base (make-u-boot-package + "novena" "arm-linux-gnueabihf" + ;; Patch configuration to disable loading u-boot.img from FAT + ;; partition, allowing it to be installed at a device offset. + #:configs '("# CONFIG_SPL_FS_FAT is not set")))) (package (inherit base) (description "U-Boot is a bootloader used mostly for ARM boards. It also initializes the boards (RAM etc). This U-Boot is built for Novena. Be advised that this version, contrary -to Novena upstream, does not load u-boot.img from the first partition.") - (arguments - (substitute-keyword-arguments (package-arguments base) - ((#:phases phases) - `(modify-phases ,phases - (add-after 'unpack 'patch-novena-defconfig - ;; Patch configuration to disable loading u-boot.img from FAT partition, - ;; allowing it to be installed at a device offset. - (lambda _ - (substitute* "configs/novena_defconfig" - (("CONFIG_SPL_FS_FAT=y") "# CONFIG_SPL_FS_FAT is not set")) - #t))))))))) +to Novena upstream, does not load u-boot.img from the first partition.")))) (define-public u-boot-cubieboard (make-u-boot-package "Cubieboard" "arm-linux-gnueabihf")) @@ -1002,7 +991,15 @@ to Novena upstream, does not load u-boot.img from the first partition.") ,@(package-native-inputs base)))))) (define-public u-boot-rockpro64-rk3399 - (let ((base (make-u-boot-package "rockpro64-rk3399" "aarch64-linux-gnu"))) + (let ((base (make-u-boot-package "rockpro64-rk3399" "aarch64-linux-gnu" + #:configs '("CONFIG_USB=y" + "CONFIG_AHCI=y" + "CONFIG_AHCI_PCI=y" + "CONFIG_SATA=y" + "CONFIG_SATA_SIL=y" + "CONFIG_SCSI=y" + "CONFIG_SCSI_AHCI=y" + "CONFIG_DM_SCSI=y")))) (package (inherit base) (arguments @@ -1013,19 +1010,8 @@ to Novena upstream, does not load u-boot.img from the first partition.") (lambda* (#:key inputs #:allow-other-keys) (setenv "BL31" (search-input-file inputs "/bl31.elf")))) - (add-after 'unpack 'patch-config + (add-after 'unpack 'patch-header (lambda _ - (substitute* "configs/rockpro64-rk3399_defconfig" - (("CONFIG_USB=y") "\ -CONFIG_USB=y -CONFIG_AHCI=y -CONFIG_AHCI_PCI=y -CONFIG_SATA=y -CONFIG_SATA_SIL=y -CONFIG_SCSI=y -CONFIG_SCSI_AHCI=y -CONFIG_DM_SCSI=y -")) (substitute* "include/config_distro_bootcmd.h" (("\"scsi_need_init=false") "\"setenv scsi_need_init false") diff --git a/guix/build/kconfig.scm b/guix/build/kconfig.scm new file mode 100644 index 0000000000..d0189f558f --- /dev/null +++ b/guix/build/kconfig.scm @@ -0,0 +1,183 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (guix build kconfig) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (modify-defconfig + verify-config)) + +;; Commentary: +;; +;; Builder-side code to modify configurations for the Kconfig build system as +;; used by Linux and U-Boot. +;; +;; Code: + +(define (config-string->pair config-string) + "Parse a configuration string like \"CONFIG_EXAMPLE=m\" into a key-value pair. +An error is thrown for invalid configurations. + +\"CONFIG_A=y\" -> '(\"CONFIG_A\" . \"y\") +\"CONFIG_B=\\\"\\\"\" -> '(\"CONFIG_B\" . \"\\\"\\\"\") +\"CONFIG_C=\" -> '(\"CONFIG_C\" . \"\") +\"# CONFIG_E is not set\" -> '(\"CONFIG_E\" . #f) +\"CONFIG_D\" -> '(\"CONFIG_D\" . #f) +\"# Any comment\" -> '(#f . \"# Any comment\") +\"\" -> '(#f . \"\") +\"# CONFIG_E=y\" -> (error \"Invalid configuration\") +\"CONFIG_E is not set\" -> (error \"Invalid configuration\") +\"Anything else\" -> (error \"Invalid configuration\")" + (define config-regexp + (make-regexp + ;; (match:substring (string-match "=(.*)" "=") 1) returns "", but the + ;; pattern "=(.+)?" makes it return #f instead. From a "CONFIG_A=" we like + ;; to get "", which later emits "CONFIG_A=" again. + (string-append "^ *(#[\\t ]*)?(CONFIG_[a-zA-Z0-9_]+)([\\t ]*=" + "[\\t ]*(.*)|([\\t ]+is[\\t ]+not[\\t ]+set))?$"))) + + (define config-comment-regexp + (make-regexp "^([\\t ]*(#.*)?)$")) + + (let ((match (regexp-exec config-regexp (string-trim-right config-string)))) + (if match + (let* ((comment (match:substring match 1)) + (key (match:substring match 2)) + (unset (match:substring match 5)) + (value (and (not comment) + (not unset) + (match:substring match 4)))) + (if (eq? (not comment) (not unset)) + ;; The key is uncommented and set or commented and unset. + (cons key value) + ;; The key is set or unset ambigiously. + (error (format #f "invalid configuration, did you mean \"~a\"?" + (pair->config-string (cons key #f))) + config-string))) + ;; This is not a valid or ambigious config-string, but maybe a + ;; comment. + (if (regexp-exec config-comment-regexp config-string) + (cons #f config-string) ;keep valid comments + (error "Invalid configuration" config-string))))) + +(define (pair->config-string pair) + "Convert a PAIR back to a config-string." + (let* ((key (first pair)) + (value (cdr pair))) + (if (string? key) + (if (string? value) + (string-append key "=" value) + (string-append "# " key " is not set")) + value))) + +(define (defconfig->alist defconfig) + "Convert the content of a DEFCONFIG (or .config) file into an alist." + (with-input-from-file defconfig + (lambda () + (let loop ((alist '()) + (line (read-line))) + (if (eof-object? line) + ;; Building the alist is done, now check for duplicates. + ;; Note: the filter invocation is used to remove comments. + (let loop ((keys (map first (filter first alist))) + (duplicates '())) + (if (null? keys) + ;; The search for duplicates is done. + ;; Return the alist or throw an error on duplicates. + (if (null? duplicates) + alist + (error + (format #f "duplicate configurations in ~a" defconfig) + duplicates)) + ;; Continue the search for duplicates. + (loop (cdr keys) + (if (member (first keys) (cdr keys)) + (cons (first keys) duplicates) + duplicates)))) + ;; Build the alist. + (loop (cons (config-string->pair line) alist) + (read-line))))))) + +(define (modify-defconfig defconfig configs) + "This function can modify a given DEFCONFIG (or .config) file by adding, +changing or removing the list of strings in CONFIGS. This allows customization +of Kconfig based projects like the kernel Linux or the bootloader 'Das U-Boot'. + +These are examples for CONFIGS to add, change or remove configurations to/from +DEFCONFIG: + +'(\"CONFIG_A=\\\"a\\\"\" + \"CONFIG_B=0\" + \"CONFIG_C=y\" + \"CONFIG_D=m\" + \"CONFIG_E=\" + \"# CONFIG_G is not set\" + ;; For convenience this abbrevation can be used for not set configurations. + \"CONFIG_F\") + +Instead of a list, CONFIGS can be a string with one configuration per line." + (let* (;; Split the configs into a list of single configurations. Both a + ;; string and or a list of strings is supported, each with newlines + ;; to separate configurations. + (config-pairs (map config-string->pair + (append-map (cut string-split <> #\newline) + (if (string? configs) + (list configs) + configs)))) + ;; Generate a blocklist from all valid keys in config-pairs. + (blocklist (delete #f (map first config-pairs))) + ;; Generate an alist from the defconfig without the keys in blocklist. + (filtered-defconfig-pairs (remove (lambda (pair) + (member (first pair) blocklist)) + (defconfig->alist defconfig)))) + (with-output-to-file defconfig + (lambda () + (for-each (lambda (pair) + (display (pair->config-string pair)) + (newline)) + (append filtered-defconfig-pairs config-pairs)))))) + +(define (verify-config config defconfig) + "Verify that the CONFIG file contains all configurations from the DEFCONFIG +file. When the verification fails, raise an error with the mismatching keys +and their values." + (let* ((config-pairs (defconfig->alist config)) + (defconfig-pairs (defconfig->alist defconfig)) + (mismatching-pairs + (remove (lambda (pair) + ;; Remove all configurations, whose values are #f and + ;; whose keys are not in config-pairs, as not in + ;; config-pairs means unset, ... + (and (not (cdr pair)) + (not (assoc-ref config-pairs (first pair))))) + ;; ... from the defconfig-pairs different to config-pairs. + (lset-difference equal? + ;; Remove comments by filtering with first. + (filter first defconfig-pairs) + config-pairs)))) + (unless (null? mismatching-pairs) + (error (format #f "Mismatching configurations in ~a and ~a" + config defconfig) + (map (lambda (mismatching-pair) + (let* ((key (first mismatching-pair)) + (defconfig-value (cdr mismatching-pair)) + (config-value (assoc-ref config-pairs key))) + (cons key (list (list config-value defconfig-value))))) + mismatching-pairs))))) |