From a235d7564715cca1cec774d9d515caf1bccb4856 Mon Sep 17 00:00:00 2001 From: Petr Hodina Date: Wed, 13 Apr 2022 21:10:19 +0200 Subject: [PATCH v3 2/8] build: kconfig: Add new module to modify a defconfig file. From: Stefan * 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. diff --git a/Makefile.am b/Makefile.am index fecce7c6f7..7f69aacbd1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -223,6 +223,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 6876ab17b9..10f2dd5fad 100644 --- a/gnu/packages/bootloaders.scm +++ b/gnu/packages/bootloaders.scm @@ -16,6 +16,7 @@ ;;; Copyright © 2021 Vincent Legoll ;;; Copyright © 2021 Brice Waegeneire ;;; Copyright © 2021 Stefan +;;; Copyright © 2022 Petr Hodina ;;; ;;; This file is part of GNU Guix. ;;; @@ -747,8 +748,9 @@ (define-public u-boot-tools 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))))) @@ -766,8 +768,11 @@ (define-public (make-u-boot-package board triplet) (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" @@ -778,9 +783,18 @@ (define-public (make-u-boot-package board triplet) (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)) @@ -834,7 +848,11 @@ (define-public u-boot-malta (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\"")))) (package (inherit base) (name "u-boot-am335x-boneblack") @@ -843,25 +861,13 @@ (define-public u-boot-am335x-boneblack 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 @@ -891,20 +897,10 @@ (define-public u-boot-pine64-lts (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")) @@ -955,25 +951,17 @@ (define-public u-boot-mx6cuboxi (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..09ddf59dd0 --- /dev/null +++ b/guix/build/kconfig.scm @@ -0,0 +1,148 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Stefan +;;; +;;; 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 (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)) + +;; 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 or remove +configurations to/from DEFCONFIG: + +'(\"CONFIG_A=\\\"a\\\"\" + \"CONFIG_B=0\" + \"CONFIG_C=y\" + \"CONFIG_D=m\" + \"CONFIG_E=\" + \"CONFIG_F\" + \"# CONFIG_G is not set\") + +Instead of a list, CONFGIS can be a string with one configuration per line." + (define config-rx + (make-regexp + ;; (match:substring (string-match "=(.*)" "=") 1) returns "", but the + ;; pattern "=(.+)?" makes it return #f instead. For a "CONFIG_A=" we like + ;; to get #f, which as a value emits "# … is not set". + "^(#[\\t ]*)?(CONFIG_[A-Z0-9_]+)([\\t ]*=[\\t ]*(.+)?|([\\t ]+is[\\t ]+not[\\t ]+set))?$")) + + (define (config-string->pair config-string) + "Parse a config-string like \"CONFIG_EXAMPLE=y\" into a key-value pair. +Spaces get trimmed. +\"CONFIG_A=y\" -> '(\"CONFIG_A\" . \"y\") +\"CONFIG_B=\\\"\\\"\" -> '(\"CONFIG_B\" . \"\\\"\\\"\") +\"CONFIG_C=\" -> '(\"CONFIG_C\" . #f) +\"CONFIG_D\" -> '(\"CONFIG_D\" . #f) +\"# CONFIG_E is not set\" -> '(\"CONFIG_E\" . #f) +\"# Anything else\" -> '(\"# Anything else\" . \"\")" + (let ((match (regexp-exec config-rx (string-trim-both config-string)))) + (if (not match) + ;; This is some unparsable config-string. + ;; We keep it as it is. + (cons config-string "") + (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 (or (and comment (not unset)) + (and (not comment) unset)) + ;; This is just some comment or strange line, which we keep as is. + (cons config-string "") + (cons key value)))))) + + (define (pair->config-string pair) + "Convert a PAIR back to a config-string." + (let* ((key (car pair)) + (value (cdr pair))) + (if (string? value) + (if (string-null? value) + key + (string-append key "=" value)) + (string-append "# " key " is not set")))) + + (define (remove-pair pair blacklist) + "Turn a key-value PAIR into '("" . ""), if its key is listed in BLACKLIST." + (let* ((key (first pair))) + (if (member key blacklist) + '("" . "") + pair))) + + (define (remove-config-string config-string blacklist) + "Remove the CONFIG-STRING, if its key is listed in BLACKLIST." + (pair->config-string (remove-pair (config-string->pair config-string) + blacklist))) + + (define* (write-lines input #:key (line-modifier identity)) + "Write all lines from the INPUT after applying the LINE-MODIFIER to the + current-output-port." + (let loop ((line (read-line input))) + (when (not (eof-object? line)) + (display (line-modifier line)) + (newline) + (loop (read-line input))))) + + (let* ((modified-defconfig (string-append defconfig ".mod")) + ;; Split the configs into a list of single configuations. + ;; To minimize mistakes, we support a string and a list of strings, + ;; each with newlines to separate configurations. + (config-list (fold-right append '() + (map (lambda (s) + (string-split s #\newline)) + (if (string? configs) + (list configs) + configs)))) + ;; Generate key-value pairs from the config-list. + (pairs (map (lambda (config-string) + (config-string->pair config-string)) + config-list)) + ;; Generate a blacklist of config keys from pairs. + (blacklist (map (lambda (config-pair) + (first config-pair)) + pairs)) + (remove-config-string (cut remove-config-string <> blacklist))) + ;; Write to the modified-defconfig file first the content of the defconfig + ;; file with removed lines, and afterwards the configs. + (call-with-output-file modified-defconfig + (lambda (output) + (with-output-to-port output + (lambda () + (call-with-input-file defconfig + (lambda (input) + (write-lines input #: line-modifier remove-config-string))) + (call-with-input-string + (string-join (map pair->config-string pairs) "\n") + (lambda (input) + (write-lines input))))))) + ;; Ensure the modified-defconfig file is used. + (delete-file defconfig) + (rename-file modified-defconfig defconfig))) -- 2.35.1