gnu: linux: New function to modify the configuration of a Linux kernel.

From: Stefan <stefan-guix@vodafonemail.de>

* gnu/packages/linux.scm (system->linux-srcarch): New function to return the
relevent folder name below arch/ in the Linux source code.
(make-linux-libre*) ['set-environment]: Splitted this new phase out of and
adding it before …
['configure]: … to allow a replacement and reuse from (modify-linux).
(modify-linux): New function to make a customized Linux package inherited
from another Linux package, which will be build with an own defconfig or
configuration changes.
(make-defconfig): Function to get a defconfig from an uri.
---
 gnu/packages/linux.scm |  124 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 124 insertions(+)

diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index b00b46be47..4febdbdece 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -185,8 +185,27 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
   #:use-module (ice-9 regex))
 
+(define-public (linux-srcarch)
+  "Return the linux SRCARCH name, which is set in the toplevel Makefile of
+Linux and denotes the architecture specific directory name below arch/ in its
+source code.  Some few architectures share a common folder.  It resembles the
+definition of SRCARCH based on ARCH in the Makefile and may be used to place a
+defconfig file in the proper path."
+  (let ((linux-arch (platform-linux-architecture
+                      (lookup-platform-by-target-or-system
+                        (or (%current-target-system)
+                            (%current-system))))))
+    (match linux-arch
+      ("i386"    "x86")
+      ("x86_64"  "x86")
+      ("sparc32" "sparc")
+      ("sparc64" "sparc")
+      ("sh64"    "sh")
+      (_         linux-arch))))
+
 (define-public (system->defconfig system)
   "Some systems (notably powerpc-linux) require a special target for kernel
 defconfig.  Return the appropriate make target if applicable, otherwise return
@@ -1180,6 +1199,111 @@ It has been modified to remove all non-free binary blobs.")
       (inputs (modify-inputs (package-inputs base-linux-libre)
                 (prepend cpio))))))
 
+
+;;;
+;;; Linux kernel customization functions.
+;;;
+
+(define*-public (modify-linux #:key name
+                                    (linux linux-libre)
+                                    source
+                                    defconfig
+                                    (configs "")
+                                    extra-version)
+  "Make a Linux package NAME as a modification of another LINUX package.
+
+If NAME is not given, then it defaults to the same name as the LINUX package.
+
+Unless SOURCE is given the source of LINUX is used.
+
+A DEFCONFIG file to be used can be given as an origin, as a file like object
+(file-append, local-file etc.), or as a string with the name of a defconfig file
+available in the Linux sources.  If DEFCONFIG is not given, then a defconfig
+file will be saved from the LINUX package configuration.
+
+Additional CONFIGS will be used to modify the given or saved defconfig, which
+will finally be used to build Linux.
+
+CONFIGS can be a list of strings, with one configuration per line.  The usual
+defconfig syntax has to be used, but there is a special extension to ease the
+removal of configurations.  Comment lines are supported as well.
+
+Here is an explaining usage example:
+
+  '(;; This string defines the version tail in 'uname -r'.
+    \"CONFIG_LOCALVERSION=\\\"-handcrafted\\\"
+    ;; This '# CONFIG_… is not set' syntax has to match exactly!
+    \"# CONFIG_BOOT_CONFIG is not set\"
+    \"CONFIG_NFS_SWAP=y\"
+    ;; This is a multiline configuration:
+    \"CONFIG_E1000=y
+# This is a comment, below follow two special removal extensions:
+CONFIG_CMDLINE_EXTEND
+CONFIG_CMDLINE_FORCE=\")
+
+A string of configurations instead of a list of configuration strings is also
+possible.
+
+EXTRA-VERSION can be a string overwriting the EXTRAVERSION setting of the LINUX
+package, after being prepended by a hyphen.  It will be visible in the output
+of 'uname -r' behind the Linux version numbers."
+  (package
+    (inherit linux)
+    (name (or name (package-name linux)))
+    (source (or source (package-source linux)))
+    (arguments
+     (substitute-keyword-arguments
+         (package-arguments linux)
+       ((#:imported-modules imported-modules %gnu-build-system-modules)
+        `((guix build kconfig) ,@imported-modules))
+       ((#:modules modules)
+        `((guix build kconfig) ,@modules))
+       ((#:phases phases)
+        #~(modify-phases #$phases
+            (replace 'configure
+              (lambda* (#:key inputs #:allow-other-keys #:rest arguments)
+                (setenv "EXTRAVERSION"
+                        #$(and extra-version
+                               (not (string-null? extra-version))
+                               (string-append "-" extra-version)))
+                (let* ((configs
+                        (string-append "arch/" #$(linux-srcarch) "/configs/"))
+                       (guix_defconfig
+                        (string-append configs "guix_defconfig")))
+                  #$(cond
+                     ((not defconfig)
+                      #~(begin
+                         ;; Call the original 'configure phase.
+                         (apply (assoc-ref #$phases 'configure) arguments)
+                         ;; Save a defconfig file.
+                         (invoke "make" "savedefconfig")
+                         ;; Move the saved defconfig to the proper location.
+                         (rename-file "defconfig"
+                                      guix_defconfig)))
+                     ((string? defconfig)
+                      ;; Use another existing defconfig from the Linux sources.
+                      #~(rename-file (string-append configs #$defconfig)
+                                     guix_defconfig))
+                     (else
+                      ;; Copy the defconfig input to the proper location.
+                      #~(copy-file (assoc-ref inputs "guix_defconfig")
+                                   guix_defconfig)))
+                  (chmod guix_defconfig #o644)
+                  (modify-defconfig guix_defconfig '#$configs)
+                  (invoke "make" "guix_defconfig")
+                  (verify-config ".config" guix_defconfig))))))))
+    (native-inputs
+     (append (if (or (not defconfig)
+                     (string? defconfig))
+                 '()
+                 ;; The defconfig should be an origin or file-like object.
+                 `(("guix_defconfig" ,defconfig)))
+             (package-native-inputs linux)))))
+
+(define-public (make-defconfig uri sha256-as-base32)
+  (origin (method url-fetch)
+          (uri uri)
+          (sha256 (base32 sha256-as-base32))))
 
 
 ;;;
