build: kconfig: Add new module to modify a defconfig file.

From: Stefan <stefan-guix@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 |   87 +++++++++++--------------
 guix/build/kconfig.scm       |  148 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 186 insertions(+), 50 deletions(-)
 create mode 100644 guix/build/kconfig.scm

diff --git a/Makefile.am b/Makefile.am
index 0129011ebf..c17a417703 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -217,6 +217,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 32dae92531..38cf933c22 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -717,8 +717,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)))))
@@ -736,8 +737,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"
@@ -748,9 +752,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))
@@ -801,7 +814,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\""))))
     (package
       (inherit base)
       (name "u-boot-am335x-boneblack")
@@ -810,25 +827,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
@@ -858,20 +863,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"))
@@ -895,25 +890,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..09ddf59dd0
--- /dev/null
+++ b/guix/build/kconfig.scm
@@ -0,0 +1,148 @@
+;;; 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))
+
+;; 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)))
