(address . guix-patches@gnu.org)
8DAC4983-25B2-4919-89F2-F08B5C781EC1@vodafonemail.de
* guix/build/kconfig.scm (modify-defconfig): New file with a new function.
* gnu/packages/bootloaders.scm (make-u-boot-package,
make-u-boot-sunxi64-package): Adding new key arguments to pass and/or modify
a defconfig file.
(u-boot-am335x-boneblack, u-boot-pinebook, u-boot-novena): Simplify functions
by using the new key arguments of the former functions.
* Makefile.am: Adding guix/build/kconfig.scm to MODULES.
---
Makefile.am | 1 +
gnu/packages/bootloaders.scm | 89 +++++++++++-------------
guix/build/kconfig.scm | 127 +++++++++++++++++++++++++++++++++++
3 files changed, 167 insertions(+), 50 deletions(-)
create mode 100644 guix/build/kconfig.scm
Toggle diff (313 lines)
diff --git a/Makefile.am b/Makefile.am
index 1a3ca227a4..c08e7be3a2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -210,6 +210,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 75ae8d919b..e72c1d41e8 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -13,6 +13,7 @@
;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
;;; Copyright © 2018, 2019, 2020 Vagrant Cascadian <vagrant@debian.org>
;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
+;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -70,6 +71,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
@@ -602,8 +604,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)))))
@@ -621,8 +624,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"
@@ -633,9 +639,18 @@ 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)))
(begin
(display "Invalid board name. Valid board names are:"
(current-error-port))
@@ -686,7 +701,11 @@ 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 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\"\n"))))
(package
(inherit base)
(name "u-boot-am335x-boneblack")
@@ -695,25 +714,13 @@ 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
@@ -743,20 +750,10 @@ 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"))
@@ -780,25 +777,17 @@ it fits within common partitioning schemes.")
(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="))))
(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"))
diff --git a/guix/build/kconfig.scm b/guix/build/kconfig.scm
new file mode 100644
index 0000000000..7554b76171
--- /dev/null
+++ b/guix/build/kconfig.scm
@@ -0,0 +1,127 @@
+;;; 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 (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:export (modify-defconfig))
+
+;; Commentary:
+;;
+;; Builder-side code to modify configurations for the Kconfig build system as
+;; used by Linux and U-Boot.
+;;
+;; Code:
+
+(define (modify-defconfig defconfig configs)
+ "This function can modify a given DEFCONFIG file by adding, changing or
+removing the list of strings in CONFIGS. This allows an easy customization of
+Kconfig based projects like the kernel Linux or the bootloader 'Das U-Boot'.
+
+These are examples for CONFIGS to add (or change) and remove
+configurations to/from DEFCONFIG:
+
+'(\"CONFIG_A=\\\"a\\\"\"
+ \"CONFIG_B=0\"
+ \"CONFIG_C=y\"
+ \"CONFIG_D=m\"
+ \"CONFIG_E=\"
+ \"CONFIG_F\")"
+
+ (define (config-string->pair config-string)
+ "Parse a config-string like \"CONFIG_NET=y\" into a key-value pair.
+Spaces get trimmed.
+\"CONFIG_EXAMPLE=y\" -> '(\"CONFIG_EXAMPLE\" . \"y\")
+\"CONFIG_EXAMPLE=\\\"\\\"\" -> '(\"CONFIG_EXAMPLE\" . \"\").
+\"CONFIG_EXAMPLE=\" -> '(\"CONFIG_EXAMPLE\" . #f).
+\"CONFIG_EXAMPLE\" -> '(\"CONFIG_EXAMPLE\" . #f)."
+ (let ((pair (map string-trim-both (string-split config-string #\=))))
+ (case (length pair)
+ ((2)
+ (cons (string-append (first pair))
+ (if (string-null? (second pair))
+ #f
+ (second pair))))
+ (else (cons (first pair) #f)))))
+
+ (define (pair->config-string pair)
+ "Convert a PAIR back to a config-string."
+ (let* ((key (car pair))
+ (value (cdr pair)))
+ (if value
+ (string-append key "=" value)
+ key)))
+
+ (define (disable-pair pair blacklist)
+ "Turn the key of a key-value PAIR into an disabled key, if listed in
+BLACKLIST."
+ (let* ((key (car pair)))
+ (if (member key blacklist)
+ (cons (string-append "# disabled " key)
+ (cdr pair))
+ pair)))
+
+ (define (disable-config-string config-string blacklist)
+ "Turn the CONFIG-STRING into a disabled one, if listed in BLACKLIST."
+ (pair->config-string (disable-pair (config-string->pair config-string)
+ blacklist)))
+
+ (define (unset-pair pair)
+ "Turn the key of a key-value PAIR into an unset key, if its value is #f."
+ (let* ((key (car pair))
+ (value (cdr pair)))
+ (if value
+ pair
+ (cons (string-append "# unset " key) value))))
+
+ (define (unset-config-string config-string)
+ "Turn the CONFIG-STRING into a proper unset one, if there is no assignment"
+ (pair->config-string (unset-pair (config-string->pair config-string))))
+
+ (define (write-modified-lines input modify-line)
+ "Write all lines from the INPUT after applying MODIFY-LINE to the
+ current-output-port."
+ (let loop ((line (read-line input)))
+ (when (not (eof-object? line))
+ (display (modify-line line))
+ (newline)
+ (loop (read-line input)))))
+
+ (let* ((modified-defconfig (string-append defconfig ".mod"))
+ ;; Generate a blacklist of config keys from configs.
+ (blacklist (map (lambda (config-string)
+ (first (config-string->pair config-string)))
+ configs))
+ (disable-config-string (cut disable-config-string <> blacklist)))
+ ;; Write to modified-defconfig file first the configs, and second
+ ;; the content of the defconfig file with disabled lines.
+ (call-with-output-file modified-defconfig
+ (lambda (output)
+ (with-output-to-port output
+ (lambda ()
+ (call-with-input-string (string-join configs "\n")
+ (lambda (input)
+ (write-modified-lines input unset-config-string)))
+ (false-if-exception
+ (call-with-input-file defconfig
+ (lambda (input)
+ (write-modified-lines input disable-config-string))))))))
+ ;; Ensure the modified-defconfig file is used.
+ (false-if-exception (delete-file defconfig))
+ (rename-file modified-defconfig defconfig)))
--
2.29.2