summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/linux-module.scm2
-rw-r--r--guix/build/kconfig.scm183
-rw-r--r--guix/gnu-maintenance.scm4
-rw-r--r--guix/import/cran.scm1
-rw-r--r--guix/packages.scm35
-rw-r--r--guix/pki.scm8
-rwxr-xr-xguix/scripts/substitute.scm2
-rw-r--r--guix/ui.scm1
8 files changed, 228 insertions, 8 deletions
diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index d6c369d65d..e46195b53c 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -66,7 +66,7 @@
(replace 'build
(lambda _
(invoke "make" "modules_prepare")))
- (delete 'strip) ; faster
+ (delete 'strip) ;faster
(replace 'install
(lambda* (#:key inputs #:allow-other-keys)
(let ((out-lib-build (string-append #$output "/lib/modules/build")))
diff --git a/guix/build/kconfig.scm b/guix/build/kconfig.scm
new file mode 100644
index 0000000000..d0189f558f
--- /dev/null
+++ b/guix/build/kconfig.scm
@@ -0,0 +1,183 @@
+;;; 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
+ verify-config))
+
+;; Commentary:
+;;
+;; Builder-side code to modify configurations for the Kconfig build system as
+;; used by Linux and U-Boot.
+;;
+;; Code:
+
+(define (config-string->pair config-string)
+ "Parse a configuration string like \"CONFIG_EXAMPLE=m\" into a key-value pair.
+An error is thrown for invalid configurations.
+
+\"CONFIG_A=y\" -> '(\"CONFIG_A\" . \"y\")
+\"CONFIG_B=\\\"\\\"\" -> '(\"CONFIG_B\" . \"\\\"\\\"\")
+\"CONFIG_C=\" -> '(\"CONFIG_C\" . \"\")
+\"# CONFIG_E is not set\" -> '(\"CONFIG_E\" . #f)
+\"CONFIG_D\" -> '(\"CONFIG_D\" . #f)
+\"# Any comment\" -> '(#f . \"# Any comment\")
+\"\" -> '(#f . \"\")
+\"# CONFIG_E=y\" -> (error \"Invalid configuration\")
+\"CONFIG_E is not set\" -> (error \"Invalid configuration\")
+\"Anything else\" -> (error \"Invalid configuration\")"
+ (define config-regexp
+ (make-regexp
+ ;; (match:substring (string-match "=(.*)" "=") 1) returns "", but the
+ ;; pattern "=(.+)?" makes it return #f instead. From a "CONFIG_A=" we like
+ ;; to get "", which later emits "CONFIG_A=" again.
+ (string-append "^ *(#[\\t ]*)?(CONFIG_[a-zA-Z0-9_]+)([\\t ]*="
+ "[\\t ]*(.*)|([\\t ]+is[\\t ]+not[\\t ]+set))?$")))
+
+ (define config-comment-regexp
+ (make-regexp "^([\\t ]*(#.*)?)$"))
+
+ (let ((match (regexp-exec config-regexp (string-trim-right config-string))))
+ (if match
+ (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 (eq? (not comment) (not unset))
+ ;; The key is uncommented and set or commented and unset.
+ (cons key value)
+ ;; The key is set or unset ambigiously.
+ (error (format #f "invalid configuration, did you mean \"~a\"?"
+ (pair->config-string (cons key #f)))
+ config-string)))
+ ;; This is not a valid or ambigious config-string, but maybe a
+ ;; comment.
+ (if (regexp-exec config-comment-regexp config-string)
+ (cons #f config-string) ;keep valid comments
+ (error "Invalid configuration" config-string)))))
+
+(define (pair->config-string pair)
+ "Convert a PAIR back to a config-string."
+ (let* ((key (first pair))
+ (value (cdr pair)))
+ (if (string? key)
+ (if (string? value)
+ (string-append key "=" value)
+ (string-append "# " key " is not set"))
+ value)))
+
+(define (defconfig->alist defconfig)
+ "Convert the content of a DEFCONFIG (or .config) file into an alist."
+ (with-input-from-file defconfig
+ (lambda ()
+ (let loop ((alist '())
+ (line (read-line)))
+ (if (eof-object? line)
+ ;; Building the alist is done, now check for duplicates.
+ ;; Note: the filter invocation is used to remove comments.
+ (let loop ((keys (map first (filter first alist)))
+ (duplicates '()))
+ (if (null? keys)
+ ;; The search for duplicates is done.
+ ;; Return the alist or throw an error on duplicates.
+ (if (null? duplicates)
+ alist
+ (error
+ (format #f "duplicate configurations in ~a" defconfig)
+ duplicates))
+ ;; Continue the search for duplicates.
+ (loop (cdr keys)
+ (if (member (first keys) (cdr keys))
+ (cons (first keys) duplicates)
+ duplicates))))
+ ;; Build the alist.
+ (loop (cons (config-string->pair line) alist)
+ (read-line)))))))
+
+(define (modify-defconfig defconfig configs)
+ "This function can modify a given DEFCONFIG (or .config) file by adding,
+changing or removing the list of strings in CONFIGS. This allows customization
+of Kconfig based projects like the kernel Linux or the bootloader 'Das U-Boot'.
+
+These are examples for CONFIGS to add, change or remove configurations to/from
+DEFCONFIG:
+
+'(\"CONFIG_A=\\\"a\\\"\"
+ \"CONFIG_B=0\"
+ \"CONFIG_C=y\"
+ \"CONFIG_D=m\"
+ \"CONFIG_E=\"
+ \"# CONFIG_G is not set\"
+ ;; For convenience this abbrevation can be used for not set configurations.
+ \"CONFIG_F\")
+
+Instead of a list, CONFIGS can be a string with one configuration per line."
+ (let* (;; Split the configs into a list of single configurations. Both a
+ ;; string and or a list of strings is supported, each with newlines
+ ;; to separate configurations.
+ (config-pairs (map config-string->pair
+ (append-map (cut string-split <> #\newline)
+ (if (string? configs)
+ (list configs)
+ configs))))
+ ;; Generate a blocklist from all valid keys in config-pairs.
+ (blocklist (delete #f (map first config-pairs)))
+ ;; Generate an alist from the defconfig without the keys in blocklist.
+ (filtered-defconfig-pairs (remove (lambda (pair)
+ (member (first pair) blocklist))
+ (defconfig->alist defconfig))))
+ (with-output-to-file defconfig
+ (lambda ()
+ (for-each (lambda (pair)
+ (display (pair->config-string pair))
+ (newline))
+ (append filtered-defconfig-pairs config-pairs))))))
+
+(define (verify-config config defconfig)
+ "Verify that the CONFIG file contains all configurations from the DEFCONFIG
+file. When the verification fails, raise an error with the mismatching keys
+and their values."
+ (let* ((config-pairs (defconfig->alist config))
+ (defconfig-pairs (defconfig->alist defconfig))
+ (mismatching-pairs
+ (remove (lambda (pair)
+ ;; Remove all configurations, whose values are #f and
+ ;; whose keys are not in config-pairs, as not in
+ ;; config-pairs means unset, ...
+ (and (not (cdr pair))
+ (not (assoc-ref config-pairs (first pair)))))
+ ;; ... from the defconfig-pairs different to config-pairs.
+ (lset-difference equal?
+ ;; Remove comments by filtering with first.
+ (filter first defconfig-pairs)
+ config-pairs))))
+ (unless (null? mismatching-pairs)
+ (error (format #f "Mismatching configurations in ~a and ~a"
+ config defconfig)
+ (map (lambda (mismatching-pair)
+ (let* ((key (first mismatching-pair))
+ (defconfig-value (cdr mismatching-pair))
+ (config-value (assoc-ref config-pairs key)))
+ (cons key (list (list config-value defconfig-value)))))
+ mismatching-pairs)))))
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 1142c53d3d..2881a6be43 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2010-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
@@ -837,7 +837,7 @@ the directory containing its source tarball."
;; Return false and move on upon connection failures and bogus HTTP
;; servers.
(unless (memq key '(gnutls-error tls-certificate-error
- system-error
+ system-error getaddrinfo-error
bad-header bad-header-component))
(apply throw key args))
#f))))
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 286a4c21b9..a02e746417 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -410,6 +410,7 @@ empty list when the FIELD cannot be found."
("tcl/tk" "tcl")
("booktabs" "texlive-booktabs")
("freetype2" "freetype")
+ ("sqlite3" "sqlite")
(_ sysname)))
(define cran-guix-name (cut guix-name "r-" <>))
diff --git a/guix/packages.scm b/guix/packages.scm
index 502df7fdd1..6e61e16aa4 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -89,6 +89,7 @@
this-package
package-name
package-upstream-name
+ package-upstream-name*
package-version
package-full-name
package-source
@@ -423,7 +424,7 @@ from forcing GEXP-PROMISE."
(define %hurd-systems
;; The GNU/Hurd systems for which support is being developed.
- '("i586-gnu" "i686-gnu"))
+ '("i586-gnu"))
(define %cuirass-supported-systems
;; This is the list of system types for which build machines are available.
@@ -691,6 +692,38 @@ it has in Guix."
(or (assq-ref (package-properties package) 'upstream-name)
(package-name package)))
+(define (package-upstream-name* package)
+ "Return the upstream name of PACKAGE, accounting for commonly-used
+package name prefixes in addition to the @code{upstream-name} property."
+ (let ((namespaces (list "cl-"
+ "ecl-"
+ "emacs-"
+ "ghc-"
+ "go-"
+ "guile-"
+ "java-"
+ "julia-"
+ "lua-"
+ "minetest-"
+ "node-"
+ "ocaml-"
+ "perl-"
+ "python-"
+ "r-"
+ "ruby-"
+ "rust-"
+ "sbcl-"
+ "texlive-"))
+ (name (package-name package)))
+ (or (assq-ref (package-properties package) 'upstream-name)
+ (let loop ((prefixes namespaces))
+ (match prefixes
+ (() name)
+ ((prefix rest ...)
+ (if (string-prefix? prefix name)
+ (substring name (string-length prefix))
+ (loop rest))))))))
+
(define (hidden-package p)
"Return a \"hidden\" version of P--i.e., one that 'fold-packages' and thus,
user interfaces, ignores."
diff --git a/guix/pki.scm b/guix/pki.scm
index 6326e065e9..c5b2fb9634 100644
--- a/guix/pki.scm
+++ b/guix/pki.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2016, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,6 +21,7 @@
#:use-module (gcrypt pk-crypto)
#:use-module ((guix utils) #:select (with-atomic-file-output))
#:use-module ((guix build utils) #:select (mkdir-p))
+ #:autoload (srfi srfi-1) (delete-duplicates)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 binary-ports)
@@ -61,9 +62,10 @@ element in KEYS must be a canonical sexp with type 'public-key'."
;; want to have name certificates and to use subject names instead of
;; complete keys.
`(acl ,@(map (lambda (key)
- `(entry ,(canonical-sexp->sexp key)
+ `(entry ,key
(tag (guix import))))
- keys)))
+ (delete-duplicates
+ (map canonical-sexp->sexp keys)))))
(define %acl-file
(string-append %config-directory "/acl"))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index cf59db4315..0efa61b0d7 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -366,7 +366,7 @@ authorized substitutes."
When FRESH? is true, delete any cached connections for URI and open a new one.
Return #f if URI's scheme is 'file' or #f.
-When true, TIMEOUT is the maximum number of milliseconds to wait for
+When true, TIMEOUT is the maximum number of seconds to wait for
connection establishment. When VERIFY-CERTIFICATE? is true, verify HTTPS
server certificates."
(define host (uri-host uri))
diff --git a/guix/ui.scm b/guix/ui.scm
index 45eccb7335..3bca3b1e40 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1668,6 +1668,7 @@ score, the more relevant OBJ is to REGEXPS."
;; Metrics used to compute the "relevance score" of a package against a set
;; of regexps.
`((,package-name . 4)
+ (,package-upstream-name* . 2)
;; Match against uncommon outputs.
(,(lambda (package)
generated by cgit v1.2.3 (git 2.50.1) at 2025-10-28 10:07:57 +0000