gnu: linux: Add a 'customize-linux' procedure.

* gnu/packages/linux.scm (linux-srcarch): New procedure.
(customize-linux): Likewise.
(make-defconfig): New procedure.

Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Modified-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>

gnu/packages/linux.scm

@@ -190,11 +190,31 @@ (define-module (gnu packages linux)
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 regex))
+  #:use-module (ice-9 regex)
+  #:export (customize-linux
+            make-defconfig))
+
+(define (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
+defconfig.  Return the appropriate Make target if applicable, otherwise return
 \"defconfig\"."
   (cond ((string-prefix? "powerpc-" system) "pmac32_defconfig")
         ((string-prefix? "powerpc64-" system) "ppc64_defconfig")
@@ -1247,6 +1267,110 @@ (define-public linux-libre-with-bpf
       (inputs (modify-inputs (package-inputs base-linux-libre)
                 (prepend cpio))))))
 
+
+;;;
+;;; Linux kernel customization functions.
+;;;
+
+(define* (customize-linux #:key name
+                          (linux linux-libre)
+                          source
+                          defconfig
+                          (configs "")
+                          extra-version)
+  "Make a customized Linux package NAME derived from the 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 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 follows an extension to unset a configuration:
+CONFIG_CMDLINE_EXTEND\")
+
+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 (make-defconfig uri sha256-as-base32)
+  (origin (method url-fetch)
+          (uri uri)
+          (sha256 (base32 sha256-as-base32))))
 
 
 ;;;