From 0ccafddca9d9fea971c5baeabf03d8e5123cc4bd Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Thu, 22 Jun 2023 20:33:17 +0100 Subject: gnu: shared-mime-info: Move to (gnu packages freedesktop). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gnome.scm (shared-mime-info): Move to … * gnu/packages/freedesktop.scm: … here. * gnu/packages/gnuzilla.scm: Use (gnu packages freedesktop). * gnu/packages/kde-games.scm: Ditto. * gnu/packages/kde-multimedia.scm: Ditto. * gnu/packages/kde-pim.scm: Ditto. * gnu/packages/kde-utils.scm: Ditto. * gnu/packages/maths.scm: Ditto. * gnu/packages/mp3.scm: Ditto. * gnu/packages/ruby.scm: Ditto. * guix/profiles.scm (xdg-mime-database): Adjust to new location. Signed-off-by: Liliana Marie Prikler --- guix/profiles.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index 6467e464c8..2e2466ccbc 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1562,7 +1562,7 @@ (define (xdg-mime-database manifest) "Return a derivation that builds the @file{mime.cache} database from manifest entries. It's used to query the MIME type of a given file." (define shared-mime-info ; lazy reference - (module-ref (resolve-interface '(gnu packages gnome)) 'shared-mime-info)) + (module-ref (resolve-interface '(gnu packages freedesktop)) 'shared-mime-info)) (mlet %store-monad ((glib (manifest-lookup-package manifest "glib"))) (define build -- cgit v1.2.3 From 5de8779ad933faf883348f6cab09671f1e081a67 Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Thu, 19 Oct 2023 06:06:48 +0200 Subject: guix: emacs-build-system: Process package source in build tree. * guix/build/emacs-build-system.scm (ensure-package-description) (patch-el-files, make-autoloads): Operate on the current working directory, either implicitly, or through (getcwd). (enable-autoloads-compilation): Deleted variable, logic moved into make-autoloads. (%standard-phases): Adjust accordingly. --- guix/build/emacs-build-system.scm | 85 ++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 51 deletions(-) (limited to 'guix') diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm index 3808b60445..aa083c6409 100644 --- a/guix/build/emacs-build-system.scm +++ b/guix/build/emacs-build-system.scm @@ -132,29 +132,25 @@ (define* (build #:key outputs inputs #:allow-other-keys) (parameterize ((%emacs emacs)) (emacs-compile-directory (elpa-directory out))))) -(define* (patch-el-files #:key outputs #:allow-other-keys) - "Substitute the absolute \"/bin/\" directory with the right location in the -store in '.el' files." - - (let* ((out (assoc-ref outputs "out")) - (elpa-name-ver (store-directory->elpa-name-version out)) - (el-dir (string-append out %install-dir "/" elpa-name-ver)) - (el-files (find-files (getcwd) "\\.el$"))) - (define (substitute-program-names) - (substitute* el-files - (("\"/bin/([^.]\\S*)\"" _ cmd-name) - (let ((cmd (which cmd-name))) - (unless cmd - (error "patch-el-files: unable to locate " cmd-name)) - (string-append "\"" cmd "\""))))) - - (with-directory-excursion el-dir - ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still - ;; ISO-8859-1-encoded. - (unless (false-if-exception (substitute-program-names)) - (with-fluids ((%default-port-encoding "ISO-8859-1")) - (substitute-program-names)))) - #t)) +(define* (patch-el-files #:key inputs outputs #:allow-other-keys) + "Substitute the absolute \"/bin/\" and \"/sbin\" directories with the right +locations in the store in '.el' files." + + (define substitute-program-names + (let ((el-files (find-files (getcwd) "\\.el$"))) + (lambda () + (substitute* el-files + (("\"/(s?bin/[^.]\\S*)\"" _ cmd) + (let ((cmd (search-input-file inputs cmd))) + (unless cmd + (error "patch-el-files: unable to locate " (basename cmd))) + (string-append "\"" cmd "\""))))))) + + (unless (false-if-exception (substitute-program-names)) + ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still + ;; ISO-8859-1-encoded. + (with-fluids ((%default-port-encoding "ISO-8859-1")) + (substitute-program-names)))) (define (find-root-library-file name) (let loop ((parts (string-split @@ -224,10 +220,8 @@ (define %write-pkg-file-form (emacs-batch-edit-file (string-append name ".el") %write-pkg-file-form))) - (let* ((out (assoc-ref outputs "out")) - (elpa-name-ver (store-directory->elpa-name-version out))) - (with-directory-excursion (elpa-directory out) - (and=> (find-root-library-file elpa-name-ver) write-pkg-file)))) + (let ((name (store-directory->elpa-name-version (assoc-ref outputs "out")))) + (and=> (find-root-library-file name) write-pkg-file))) (define* (check #:key tests? (test-command '("make" "check")) (parallel-tests? #t) #:allow-other-keys) @@ -306,24 +300,15 @@ (define* (move-doc #:key outputs #:allow-other-keys) info-files))) #t)) -(define* (make-autoloads #:key outputs inputs #:allow-other-keys) +(define* (make-autoloads #:key outputs #:allow-other-keys) "Generate the autoloads file." - (let* ((emacs (search-input-file inputs "/bin/emacs")) - (out (assoc-ref outputs "out")) - (elpa-name-ver (store-directory->elpa-name-version out)) - (elpa-name (package-name->name+version elpa-name-ver)) - (el-dir (elpa-directory out))) - (parameterize ((%emacs emacs)) - (emacs-generate-autoloads elpa-name el-dir)))) - -(define* (enable-autoloads-compilation #:key outputs #:allow-other-keys) - "Remove the NO-BYTE-COMPILATION local variable embedded in the generated -autoload files." - (let* ((out (assoc-ref outputs "out")) - (autoloads (find-files out "-autoloads.el$"))) - (substitute* autoloads - ((";; no-byte-compile.*") "")) - #t)) + (emacs-generate-autoloads + (package-name->name+version (store-directory->elpa-name-version + (assoc-ref outputs "out"))) + (getcwd)) + ;; Ensure that autoloads can be byte-compiled. + (substitute* (find-files "." "-autoloads\\.el$") + ((";; no-byte-compile.*") ""))) (define* (validate-compiled-autoloads #:key outputs #:allow-other-keys) "Verify whether the byte compiled autoloads load fine." @@ -358,7 +343,11 @@ (define (elpa-directory store-dir) (define %standard-phases (modify-phases gnu:%standard-phases (replace 'unpack unpack) + (add-after 'unpack 'ensure-package-description + ensure-package-description) (add-after 'unpack 'expand-load-path expand-load-path) + (add-after 'unpack 'patch-el-files patch-el-files) + (add-after 'expand-load-path 'make-autoloads make-autoloads) (add-after 'expand-load-path 'add-install-to-native-load-path add-install-to-native-load-path) (delete 'bootstrap) @@ -366,14 +355,8 @@ (define %standard-phases (delete 'build) (replace 'check check) (replace 'install install) - (add-after 'install 'make-autoloads make-autoloads) - (add-after 'make-autoloads 'enable-autoloads-compilation - enable-autoloads-compilation) - (add-after 'enable-autoloads-compilation 'patch-el-files patch-el-files) - (add-after 'patch-el-files 'ensure-package-description - ensure-package-description) ;; The .el files are byte compiled directly in the store. - (add-after 'ensure-package-description 'build build) + (add-after 'install 'build build) (add-after 'build 'validate-compiled-autoloads validate-compiled-autoloads) (add-after 'validate-compiled-autoloads 'move-doc move-doc))) -- cgit v1.2.3 From 56a7c1308a1f1601299b8c7706fb4d00d5c185d0 Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Tue, 13 Feb 2024 19:30:50 +0100 Subject: build-system: emacs: Compute relative file names. With the previous commit, relative file names are expanded relative to ELN_DIR -- more or less. To make use of this in emacs-build-system, we must also pass relative file names. * guix/build/emacs-build-system.scm (emacs-compile-directory): Compute the relative file names of the files to compile. Change-Id: I8983f80fb0fe1573e46748222403ba8873f1599f --- guix/build/emacs-utils.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm index 8e12b5b6d4..eca42bf305 100644 --- a/guix/build/emacs-utils.scm +++ b/guix/build/emacs-utils.scm @@ -146,7 +146,9 @@ (define* (emacs-compile-directory dir) (cadr native-comp-eln-load-path)))) (if byte+native-compile (native-compile file - (comp-el-to-eln-filename file eln-dir)) + (comp-el-to-eln-filename + (file-relative-name file ,dir) + eln-dir)) (byte-compile-file file)) ;; After native compilation, write the bytecode file. (unless (null byte-to-native-output-buffer-file) -- cgit v1.2.3 From 7f3f70eedbbec74481a0ca9fea4c19250961685e Mon Sep 17 00:00:00 2001 From: Liliana Marie Prikler Date: Sat, 2 Mar 2024 16:56:13 +0100 Subject: guix: emacs-utils: Make emacs-compile-directory forwards-compatible. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Newer (development) builds of Emacs 30 mark a number of functions related to native compilation as ‘internal’. Since we rely on such functions and there does not appear to be a high-level replacement at the moment, let's work around this case. * guix/build/emacs-utils.scm (emacs-compile-directory): Require comp early and check if ‘comp-write-bytecode-file’ is available. Fixes: Upstream renamed comp-write-bytecode-file --- guix/build/emacs-utils.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm index eca42bf305..aeb364133a 100644 --- a/guix/build/emacs-utils.scm +++ b/guix/build/emacs-utils.scm @@ -136,7 +136,14 @@ (define* (emacs-compile-directory dir) (emacs-batch-eval `(let ((byte-compile-debug t) ; for proper exit status (byte+native-compile (native-comp-available-p)) - (files (directory-files-recursively ,dir "\\.el$"))) + (files (directory-files-recursively ,dir "\\.el$")) + (write-bytecode + (and (native-comp-available-p) + (progn + (require 'comp) + (if (fboundp 'comp-write-bytecode-file) + 'comp-write-bytecode-file + 'comp--write-bytecode-file))))) (mapc (lambda (file) (let (byte-to-native-output-buffer-file @@ -152,7 +159,7 @@ (define* (emacs-compile-directory dir) (byte-compile-file file)) ;; After native compilation, write the bytecode file. (unless (null byte-to-native-output-buffer-file) - (comp-write-bytecode-file nil)))) + (funcall write-bytecode nil)))) files)) #:dynamic? #t)) -- cgit v1.2.3 From 80a135d64bcf0b4fc567077ec35cf4275085114f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 29 Mar 2024 15:36:50 +0100 Subject: channels: Autoload several modules. * guix/channels.scm: Autoload several Git-related modules. Change-Id: I23e46eabdbfa9db340e26006419b4b87bb446853 --- guix/channels.scm | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index 1b07eb5221..66f3122f79 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018-2023 Ludovic Courtès +;;; Copyright © 2018-2024 Ludovic Courtès ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2021 Brice Waegeneire @@ -20,12 +20,14 @@ ;;; along with GNU Guix. If not, see . (define-module (guix channels) - #:use-module (git) - #:use-module (guix git) - #:use-module (guix git-authenticate) - #:use-module ((guix openpgp) - #:select (openpgp-public-key-fingerprint - openpgp-format-fingerprint)) + #:use-module (git) ;TODO: autoload + #:autoload (guix git) (update-cached-checkout + url+commit->name + commit-difference + with-repository) + #:autoload (guix git-authenticate) (authenticate-repository) + #:autoload (guix openpgp) (openpgp-public-key-fingerprint + openpgp-format-fingerprint) #:use-module (guix base16) #:use-module (guix records) #:use-module (guix gexp) -- cgit v1.2.3 From ddc9d66f2b00f62eb35c3da819dc684ec4a50227 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 29 Mar 2024 15:58:42 +0100 Subject: substitute: Retry nar download upon networking error. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This allows ‘guix substitute’ to gracefully handle errors like: TLS error in procedure 'write_to_session_record_port': Error in the push function instead of exiting (“`guix substitute' died unexpectedly”). * guix/scripts/substitute.scm (download-nar)[try-fetch]: Catch ‘network-error?’ too. Reported-by: Ada Stevenson Change-Id: I91b92183b0165832645ee37d50c13445f9322525 --- guix/scripts/substitute.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 37cd08e289..3af0bf0019 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2023 Ludovic Courtès +;;; Copyright © 2013-2024 Ludovic Courtès ;;; Copyright © 2014 Nikita Karetnikov ;;; Copyright © 2018 Kyle Meyer ;;; Copyright © 2020 Christopher Baines @@ -494,7 +494,9 @@ (define (fetch uri) (define (try-fetch choices) (match choices (((uri compression file-size) rest ...) - (guard (c ((and (pair? rest) (http-get-error? c)) + (guard (c ((and (pair? rest) + (or (http-get-error? c) + (network-error? c))) (warning (G_ "download from '~a' failed, trying next URL~%") (uri->string uri)) (try-fetch rest))) -- cgit v1.2.3 From 7bc1f7be62a061a9d9333386a65725ace2323659 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 30 Mar 2024 15:57:55 +0100 Subject: ui: Autoload some more. * guix/ui.scm: Autoload a number of modules. Change-Id: I22d4f719dae73594499522ce6dc8464948f564ec --- guix/ui.scm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 962d291d2e..34ff210930 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -47,13 +47,15 @@ (define-module (guix ui) #:use-module (guix packages) #:use-module (guix profiles) #:use-module (guix derivations) - #:use-module (guix build-system) + #:autoload (guix build-system) (build-system-name) #:use-module (guix serialization) - #:use-module ((guix licenses) - #:select (license? license-name license-uri)) - #:use-module ((guix build syscalls) - #:select (free-disk-space terminal-columns terminal-rows - with-file-lock/no-wait)) + #:autoload (guix licenses) (license? + license-name + license-uri) + #:autoload (guix build syscalls) (free-disk-space + terminal-columns + terminal-rows + with-file-lock/no-wait) #:use-module ((guix build utils) ;; XXX: All we need are the bindings related to ;; '&invoke-error'. However, to work around the bug described -- cgit v1.2.3 From ac19e038b457d0585812091200005befd9b29259 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 27 Mar 2024 13:43:43 +0000 Subject: Switch order of the default substitute servers. The aim here is to improve the user experience. There's anecdotal evidence that the network performance for bordeaux is better compared to ci at least for some users, and I don't know of any issues with rate limiting or access restriction for bordeaux compared to ci. It also has IPv6 support. Additionally, bordeaux generally had more substitutes than ci, particularly for aarch64-linux and armhf-linux. This change will offer a very slight speedup for those substitutes that only bordeaux has. Bordeaux has been a default substitute server for nearly 3 years now and I think this change is overdue. I'm also hopeful that we'll be able to build on the testing regarding mirrors for bordeaux, and that'll allow potentially improving the hosting setup (through providing more redundancy) and further improving substitute fetching for users who currently have issues with substitute access. * config-daemon.ac: Switch substitute urls order. * doc/guix.texi: Ditto. * etc/guix-install.sh: Ditto. * gnu/installer/newt/network.scm (wait-service-online): Ditto. * guix/store.scm (%default-substitute-urls): Ditto. Change-Id: I4f6d93ae1fc8b03d80b47b18b5749a51f1fde17b Signed-off-by: Christopher Baines --- config-daemon.ac | 2 +- doc/guix.texi | 4 ++-- etc/guix-install.sh | 2 +- gnu/installer/newt/network.scm | 4 ++-- guix/scripts/substitute.scm | 4 ++-- guix/store.scm | 4 ++-- 6 files changed, 10 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/config-daemon.ac b/config-daemon.ac index 86306effe1..9188f93bda 100644 --- a/config-daemon.ac +++ b/config-daemon.ac @@ -106,7 +106,7 @@ if test "x$guix_build_daemon" = "xyes"; then dnl Determine the appropriate default list of substitute URLs (GnuTLS dnl is required so we can default to 'https'.) - guix_substitute_urls="https://ci.guix.gnu.org https://bordeaux.guix.gnu.org" + guix_substitute_urls="https://bordeaux.guix.gnu.org https://ci.guix.gnu.org" AC_MSG_CHECKING([for default substitute URLs]) AC_MSG_RESULT([$guix_substitute_urls]) diff --git a/doc/guix.texi b/doc/guix.texi index 69a904473c..ef9e4216b4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17,8 +17,8 @@ @set BASE-URL https://ftp.gnu.org/gnu/guix @c The official substitute server used by default. -@set SUBSTITUTE-SERVER-1 ci.guix.gnu.org -@set SUBSTITUTE-SERVER-2 bordeaux.guix.gnu.org +@set SUBSTITUTE-SERVER-1 bordeaux.guix.gnu.org +@set SUBSTITUTE-SERVER-2 ci.guix.gnu.org @set SUBSTITUTE-URLS https://@value{SUBSTITUTE-SERVER-1} https://@value{SUBSTITUTE-SERVER-2} @copying diff --git a/etc/guix-install.sh b/etc/guix-install.sh index 982fb0a266..dde35e6d39 100755 --- a/etc/guix-install.sh +++ b/etc/guix-install.sh @@ -503,8 +503,8 @@ sys_enable_guix_daemon() sys_authorize_build_farms() { # authorize the public key(s) of the build farm(s) local hosts=( - ci.guix.gnu.org bordeaux.guix.gnu.org + ci.guix.gnu.org ) if prompt_yes_no "Permit downloading pre-built package binaries from the \ diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm index ba26fc7c76..b22cc71305 100644 --- a/gnu/installer/newt/network.scm +++ b/gnu/installer/newt/network.scm @@ -127,8 +127,8 @@ (define (ci-available?) (lambda _ #f)) (alarm 3)) (lambda () - (or (url-alive? "https://ci.guix.gnu.org") - (url-alive? "https://bordeaux.guix.gnu.org"))) + (or (url-alive? "https://bordeaux.guix.gnu.org") + (url-alive? "https://ci.guix.gnu.org"))) (lambda () (alarm 0)))) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 3af0bf0019..1b2d735d68 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -751,8 +751,8 @@ (define %default-substitute-urls (#f ;; This can only happen when this script is not invoked by the ;; daemon. - '("http://ci.guix.gnu.org" - "http://bordeaux.guix.gnu.org")))) + '("http://bordeaux.guix.gnu.org" + "http://ci.guix.gnu.org")))) ;; In order to prevent using large number of discovered local substitute ;; servers, limit the local substitute urls list size. diff --git a/guix/store.scm b/guix/store.scm index 97c4f32a5b..1229198b09 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -767,8 +767,8 @@ (define %default-substitute-urls (map (if (false-if-exception (resolve-interface '(gnutls))) (cut string-append "https://" <>) (cut string-append "http://" <>)) - '("ci.guix.gnu.org" - "bordeaux.guix.gnu.org"))) + '("bordeaux.guix.gnu.org" + "ci.guix.gnu.org"))) (define (current-user-name) "Return the name of the calling user." -- cgit v1.2.3 From d9276a46bf103b2d56770d6a69a900cc21219b96 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 10 Feb 2024 16:56:33 +0000 Subject: scripts: substitute: Remove side effect warning from network-error?. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Instead, display the warning from process-substitution and process-substitution/fallback in the relevant places. I'm looking at this because I want to make the substitute code less tied to the script and usable in the Guile guix-daemon. * guix/scripts/substitute.scm (network-error?): Move warning to… (process-substitution/fallback, process-substitution): here. Change-Id: I082b482c0e6ec7e02a8d437ba22dcefca5c40787 --- guix/scripts/substitute.scm | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 1b2d735d68..9726a80753 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -615,13 +615,7 @@ (define network-error? (and (kind-and-args? exception) (memq (exception-kind exception) '(gnutls-error getaddrinfo-error))) - (and (http-get-error? exception) - (begin - (warning (G_ "download from '~a' failed: ~a, ~s~%") - (uri->string (http-get-error-uri exception)) - (http-get-error-code exception) - (http-get-error-reason exception)) - #t)))))) + (http-get-error? exception))))) (define* (process-substitution/fallback port narinfo destination #:key cache-urls acl @@ -649,7 +643,13 @@ (define* (process-substitution/fallback port narinfo destination (if (or (equivalent-narinfo? narinfo alternate) (valid-narinfo? alternate acl) (%allow-unauthenticated-substitutes?)) - (guard (c ((network-error? c) (loop rest))) + (guard (c ((network-error? c) + (when (http-get-error? c) + (warning (G_ "download from '~a' failed: ~a, ~s~%") + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c))) + (loop rest))) (download-nar alternate destination #:status-port port #:deduplicate? deduplicate? @@ -677,6 +677,11 @@ (define narinfo store-item)) (guard (c ((network-error? c) + (when (http-get-error? c) + (warning (G_ "download from '~a' failed: ~a, ~s~%") + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c))) (format (current-error-port) (G_ "retrying download of '~a' with other substitute URLs...~%") store-item) -- cgit v1.2.3 From dcf0cca8d7d9771f0337e8a3b28653b9a459755d Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 10 Feb 2024 17:09:25 +0000 Subject: scripts: substitute: Allow not using with-timeout in download-nar. I don't think the approach of using SIGALARM here for the timeout will work well in all cases (e.g. when using Guile Fibers), so make it possible to avoid this. * guix/scripts/substitute.scm (download-nar): Pass the fetch timeout in as an option. Change-Id: I8cbe6cdfa10cdaa7d41974cbea56a95f5efecfe6 --- guix/scripts/substitute.scm | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) (limited to 'guix') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 9726a80753..aae6eddf3f 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -452,7 +452,8 @@ (define-syntax-rule (catch-system-error exp) (define* (download-nar narinfo destination #:key status-port - deduplicate? print-build-trace?) + deduplicate? print-build-trace? + (fetch-timeout %fetch-timeout)) "Download the nar prescribed in NARINFO, which is assumed to be authentic and authorized, and write it to DESTINATION. When DEDUPLICATE? is true, and if DESTINATION is in the store, deduplicate its files. Print a status line to @@ -473,20 +474,26 @@ (define (fetch uri) (let ((port (open-file (uri-path uri) "r0b"))) (values port (stat:size (stat port))))) ((http https) - ;; Test this with: - ;; sudo tc qdisc add dev eth0 root netem delay 1500ms - ;; and then cancel with: - ;; sudo tc qdisc del dev eth0 root - (with-timeout %fetch-timeout - (begin - (warning (G_ "while fetching ~a: server is somewhat slow~%") - (uri->string uri)) - (warning (G_ "try `--no-substitutes' if the problem persists~%"))) - (with-cached-connection uri port - (http-fetch uri #:text? #f - #:port port - #:keep-alive? #t - #:buffered? #f)))) + (if fetch-timeout + ;; Test this with: + ;; sudo tc qdisc add dev eth0 root netem delay 1500ms + ;; and then cancel with: + ;; sudo tc qdisc del dev eth0 root + (with-timeout %fetch-timeout + (begin + (warning (G_ "while fetching ~a: server is somewhat slow~%") + (uri->string uri)) + (warning (G_ "try `--no-substitutes' if the problem persists~%"))) + (with-cached-connection uri port + (http-fetch uri #:text? #f + #:port port + #:keep-alive? #t + #:buffered? #f))) + (with-cached-connection uri port + (http-fetch uri #:text? #f + #:port port + #:keep-alive? #t + #:buffered? #f)))) (else (leave (G_ "unsupported substitute URI scheme: ~a~%") (uri->string uri))))) -- cgit v1.2.3 From ecbab97f0732d6979642078a7164d4032b2102b8 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 10 Feb 2024 17:25:08 +0000 Subject: scripts: substitute: Replace some leave calls with raise. These calls happen inside of with-error-handling, so the effect should be the same, but this opens up the possibility of using this code in a program that doesn't want to exit when one of these error conditions is met. Change-Id: I15d963615d85d419559fa0f4333fa4dc1dfbfd3b * guix/scripts/substitute.scm (download-nar, process-substitution): Use raise formatted-message rather than leave. Change-Id: Idd0880206b69e3903e19e0536b87d65a52c200d5 --- guix/scripts/substitute.scm | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index aae6eddf3f..a7ad56dbcd 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -495,8 +495,10 @@ (define (fetch uri) #:keep-alive? #t #:buffered? #f)))) (else - (leave (G_ "unsupported substitute URI scheme: ~a~%") - (uri->string uri))))) + (raise + (formatted-message + (G_ "unsupported substitute URI scheme: ~a~%") + (uri->string uri)))))) (define (try-fetch choices) (match choices @@ -513,9 +515,11 @@ (define (try-fetch choices) (G_ "Downloading ~a...~%") (uri->string uri))) (values port uri compression download-size)))) (() - (leave (G_ "no valid nar URLs for ~a at ~a~%") - (narinfo-path narinfo) - (narinfo-uri-base narinfo))))) + (raise + (formatted-message + (G_ "no valid nar URLs for ~a at ~a~%") + (narinfo-path narinfo) + (narinfo-uri-base narinfo)))))) ;; Delete DESTINATION first--necessary when starting over after a failed ;; download. @@ -680,8 +684,10 @@ (define narinfo (cut valid-narinfo? <> acl)))) (unless narinfo - (leave (G_ "no valid substitute for '~a'~%") - store-item)) + (raise + (formatted-message + (G_ "no valid substitute for '~a'~%") + store-item))) (guard (c ((network-error? c) (when (http-get-error? c) -- cgit v1.2.3 From 22fa92cf282d8fc966628f06901b14b676b98478 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 18 Feb 2024 12:40:13 +0000 Subject: store: database: Remove call-with-savepoint and associated code. While care does need to be taken with making updates or inserts to the ValidPaths table, I think that trying to ensure this within update-or-insert is the wrong approach. Instead, when working with the store database, only one connection should be used to make changes to the database and those changes should happen in transactions that ideally begin immediately. This reverts commit 37545de4a3bf59611c184b31506fe9a16abe4c8b. * .dir-locals.el (scheme-mode): Remove entries for call-with-savepoint and call-with-retrying-savepoint. * guix/store/database.scm (call-with-savepoint, call-with-retrying-savepoint): Remove procedures. (update-or-insert): Remove use of call-with-savepoint. Change-Id: I2f986e8623d8235a90c40d5f219c1292c1ab157b --- .dir-locals.el | 2 -- guix/store/database.scm | 75 +++++++++---------------------------------------- 2 files changed, 13 insertions(+), 64 deletions(-) (limited to 'guix') diff --git a/.dir-locals.el b/.dir-locals.el index d18e6ba760..f135eb69a5 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -133,8 +133,6 @@ (eval . (put 'call-with-transaction 'scheme-indent-function 1)) (eval . (put 'with-statement 'scheme-indent-function 3)) (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1)) - (eval . (put 'call-with-savepoint 'scheme-indent-function 1)) - (eval . (put 'call-with-retrying-savepoint 'scheme-indent-function 1)) (eval . (put 'call-with-container 'scheme-indent-function 1)) (eval . (put 'container-excursion 'scheme-indent-function 1)) diff --git a/guix/store/database.scm b/guix/store/database.scm index 2968f13492..3093fd816a 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -151,39 +151,11 @@ (define (exec sql) (false-if-exception (exec "rollback;")) (apply throw args)))) -(define* (call-with-savepoint db proc - #:optional (savepoint-name "SomeSavepoint")) - "Call PROC after creating a savepoint named SAVEPOINT-NAME. If PROC exits -abnormally, rollback to that savepoint. In all cases, remove the savepoint -prior to returning." - (define (exec sql) - (with-statement db sql stmt - (sqlite-fold cons '() stmt))) - - (dynamic-wind - (lambda () - (exec (string-append "SAVEPOINT " savepoint-name ";"))) - (lambda () - (catch #t - proc - (lambda args - (exec (string-append "ROLLBACK TO " savepoint-name ";")) - (apply throw args)))) - (lambda () - (exec (string-append "RELEASE " savepoint-name ";"))))) - (define* (call-with-retrying-transaction db proc #:key restartable?) (call-with-SQLITE_BUSY-retrying (lambda () (call-with-transaction db proc #:restartable? restartable?)))) -(define* (call-with-retrying-savepoint db proc - #:optional (savepoint-name - "SomeSavepoint")) - (call-with-SQLITE_BUSY-retrying - (lambda () - (call-with-savepoint db proc savepoint-name)))) - (define %default-database-file ;; Default location of the store database. (string-append %store-database-directory "/db.sqlite")) @@ -261,40 +233,19 @@ (define* (update-or-insert db #:key path deriver hash nar-size time) (assert-integer "update-or-insert" positive? #:nar-size nar-size) (assert-integer "update-or-insert" (cut >= <> 0) #:time time) - ;; It's important that querying the path-id and the insert/update operation - ;; take place in the same transaction, as otherwise some other - ;; process/thread/fiber could register the same path between when we check - ;; whether it's already registered and when we register it, resulting in - ;; duplicate paths (which, due to a 'unique' constraint, would cause an - ;; exception to be thrown). With the default journaling mode this will - ;; prevent writes from occurring during that sensitive time, but with WAL - ;; mode it will instead arrange to return SQLITE_BUSY when a write occurs - ;; between the start of a read transaction and its upgrading to a write - ;; transaction (see https://sqlite.org/rescode.html#busy_snapshot). - ;; Experimentally, it seems this SQLITE_BUSY will ignore a busy_timeout and - ;; immediately return (makes sense, since waiting won't change anything). - - ;; Note that when that kind of SQLITE_BUSY error is returned, it will keep - ;; being returned every time we try to upgrade the same outermost - ;; transaction to a write transaction. So when retrying, we have to restart - ;; the *outermost* write transaction. We can't inherently tell whether - ;; we're the outermost write transaction, so we leave the retry-handling to - ;; the caller. - (call-with-savepoint db - (lambda () - (let ((id (path-id db path))) - (if id - (with-statement db update-sql stmt - (sqlite-bind-arguments stmt #:id id - #:deriver deriver - #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt)) - (with-statement db insert-sql stmt - (sqlite-bind-arguments stmt - #:path path #:deriver deriver - #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt))) - (last-insert-row-id db))))) + (let ((id (path-id db path))) + (if id + (with-statement db update-sql stmt + (sqlite-bind-arguments stmt #:id id + #:deriver deriver + #:hash hash #:size nar-size #:time time) + (sqlite-fold cons '() stmt)) + (with-statement db insert-sql stmt + (sqlite-bind-arguments stmt + #:path path #:deriver deriver + #:hash hash #:size nar-size #:time time) + (sqlite-fold cons '() stmt))) + (last-insert-row-id db))) (define add-reference-sql "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") -- cgit v1.2.3 From b914fb9b701cecd99add14fc8040f78a0712058e Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 18 Feb 2024 13:19:54 +0000 Subject: store: database: Remove with-statement and associated code. I think using dynamic-wind to finalize all statements is the wrong approach. Firstly it would be good to allow reseting statements rather than finalizing them. Then for the problem of handling errors, the approach I've settled on in the build coordinator is to close the database connection, since that'll trigger guile-sqlite3 to finalize all the cached statements. This reverts commit 5d6e2255286e591def122ec2f4a3cbda497fea21. * .dir-locals.el (scheme-mode): Remove with-statement. * guix/store/database.scm (call-with-statement): Remove procedure. (with-statement): Remove syntax rule. (call-with-transaction, last-insert-row-id, path-id, update-or-insert, add-references): Don't use with-statement. Change-Id: I2fd976b3f12ec8105cc56350933a953cf53647e8 --- .dir-locals.el | 1 - guix/store/database.scm | 62 +++++++++++++++++++++---------------------------- 2 files changed, 27 insertions(+), 36 deletions(-) (limited to 'guix') diff --git a/.dir-locals.el b/.dir-locals.el index f135eb69a5..2d1a03c313 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -131,7 +131,6 @@ (eval . (put 'with-database 'scheme-indent-function 2)) (eval . (put 'call-with-database 'scheme-indent-function 1)) (eval . (put 'call-with-transaction 'scheme-indent-function 1)) - (eval . (put 'with-statement 'scheme-indent-function 3)) (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1)) (eval . (put 'call-with-container 'scheme-indent-function 1)) diff --git a/guix/store/database.scm b/guix/store/database.scm index 3093fd816a..de72b79860 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -130,25 +130,22 @@ (define* (call-with-transaction db proc #:key restartable?) the transaction, otherwise commit the transaction after it finishes. RESTARTABLE? may be set to a non-#f value when it is safe to run PROC multiple times. This may reduce contention for the database somewhat." - (define (exec sql) - (with-statement db sql stmt - (sqlite-fold cons '() stmt))) ;; We might use begin immediate here so that if we need to retry, we figure ;; that out immediately rather than because some SQLITE_BUSY exception gets ;; thrown partway through PROC - in which case the part already executed ;; (which may contain side-effects!) might have to be executed again for ;; every retry. - (exec (if restartable? "begin;" "begin immediate;")) + (sqlite-exec db (if restartable? "begin;" "begin immediate;")) (catch #t (lambda () (let-values ((result (proc))) - (exec "commit;") + (sqlite-exec db "commit;") (apply values result))) (lambda args ;; The roll back may or may not have occurred automatically when the ;; error was generated. If it has occurred, this does nothing but signal ;; an error. If it hasn't occurred, this needs to be done. - (false-if-exception (exec "rollback;")) + (false-if-exception (sqlite-exec db "rollback;")) (apply throw args)))) (define* (call-with-retrying-transaction db proc #:key restartable?) @@ -170,26 +167,14 @@ (define-syntax with-database ((_ file db exp ...) (call-with-database file (lambda (db) exp ...))))) -(define (call-with-statement db sql proc) - (let ((stmt (sqlite-prepare db sql #:cache? #t))) - (dynamic-wind - (const #t) - (lambda () - (proc stmt)) - (lambda () - (sqlite-finalize stmt))))) - -(define-syntax-rule (with-statement db sql stmt exp ...) - "Run EXP... with STMT bound to a prepared statement corresponding to the sql -string SQL for DB." - (call-with-statement db sql - (lambda (stmt) exp ...))) - (define (last-insert-row-id db) ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. ;; Work around that. - (with-statement db "SELECT last_insert_rowid();" stmt - (match (sqlite-fold cons '() stmt) + (let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();" + #:cache? #t)) + (result (sqlite-fold cons '() stmt))) + (sqlite-finalize stmt) + (match result ((#(id)) id) (_ #f)))) @@ -199,11 +184,13 @@ (define path-id-sql (define* (path-id db path) "If PATH exists in the 'ValidPaths' table, return its numerical identifier. Otherwise, return #f." - (with-statement db path-id-sql stmt + (let ((stmt (sqlite-prepare db path-id-sql #:cache? #t))) (sqlite-bind-arguments stmt #:path path) - (match (sqlite-fold cons '() stmt) - ((#(id) . _) id) - (_ #f)))) + (let ((result (sqlite-fold cons '() stmt))) + (sqlite-finalize stmt) + (match result + ((#(id) . _) id) + (_ #f))))) (define update-sql "UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver = @@ -235,17 +222,20 @@ (define* (update-or-insert db #:key path deriver hash nar-size time) (let ((id (path-id db path))) (if id - (with-statement db update-sql stmt + (let ((stmt (sqlite-prepare db update-sql #:cache? #t))) (sqlite-bind-arguments stmt #:id id #:deriver deriver #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt)) - (with-statement db insert-sql stmt + (sqlite-fold cons '() stmt) + (sqlite-finalize stmt) + (last-insert-row-id db)) + (let ((stmt (sqlite-prepare db insert-sql #:cache? #t))) (sqlite-bind-arguments stmt #:path path #:deriver deriver #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt))) - (last-insert-row-id db))) + (sqlite-fold cons '() stmt) ;execute it + (sqlite-finalize stmt) + (last-insert-row-id db))))) (define add-reference-sql "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") @@ -253,13 +243,15 @@ (define add-reference-sql (define (add-references db referrer references) "REFERRER is the id of the referring store item, REFERENCES is a list ids of items referred to." - (with-statement db add-reference-sql stmt + (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t))) (for-each (lambda (reference) (sqlite-reset stmt) (sqlite-bind-arguments stmt #:referrer referrer #:reference reference) - (sqlite-fold cons '() stmt)) - references))) + (sqlite-fold cons '() stmt) ;execute it + (last-insert-row-id db)) + references) + (sqlite-finalize stmt))) (define (timestamp) "Return a timestamp, either the current time of SOURCE_DATE_EPOCH." -- cgit v1.2.3 From cdd4a0c3c952c207ec9460c0a693cb7b30f2085a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 18 Feb 2024 12:56:51 +0000 Subject: store: database: Inline SQL to where it's used. This makes the code easier to read, as you don't have to keep jumping between the two places. * guix/store/database.scm (path-id-sql, update-sql, insert-sql, add-reference-sql): Remove variables. (path-id, update-or-insert, add-references): Include SQL. Change-Id: I53b4ab973be8d0cd10a0f35ba25972f1c9680353 --- guix/store/database.scm | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/guix/store/database.scm b/guix/store/database.scm index de72b79860..e958ef4d36 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -178,13 +178,14 @@ (define (last-insert-row-id db) ((#(id)) id) (_ #f)))) -(define path-id-sql - "SELECT id FROM ValidPaths WHERE path = :path") - (define* (path-id db path) "If PATH exists in the 'ValidPaths' table, return its numerical identifier. Otherwise, return #f." - (let ((stmt (sqlite-prepare db path-id-sql #:cache? #t))) + (let ((stmt (sqlite-prepare + db + " +SELECT id FROM ValidPaths WHERE path = :path" + #:cache? #t))) (sqlite-bind-arguments stmt #:path path) (let ((result (sqlite-fold cons '() stmt))) (sqlite-finalize stmt) @@ -192,14 +193,6 @@ (define* (path-id db path) ((#(id) . _) id) (_ #f))))) -(define update-sql - "UPDATE ValidPaths SET hash = :hash, registrationTime = :time, deriver = -:deriver, narSize = :size WHERE id = :id") - -(define insert-sql - "INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) -VALUES (:path, :hash, :time, :deriver, :size)") - (define-inlinable (assert-integer proc in-range? key number) (unless (integer? number) (throw 'wrong-type-arg proc @@ -222,14 +215,25 @@ (define* (update-or-insert db #:key path deriver hash nar-size time) (let ((id (path-id db path))) (if id - (let ((stmt (sqlite-prepare db update-sql #:cache? #t))) + (let ((stmt (sqlite-prepare + db + " +UPDATE ValidPaths +SET hash = :hash, registrationTime = :time, deriver = :deriver, narSize = :size +WHERE id = :id" + #:cache? #t))) (sqlite-bind-arguments stmt #:id id #:deriver deriver #:hash hash #:size nar-size #:time time) (sqlite-fold cons '() stmt) (sqlite-finalize stmt) (last-insert-row-id db)) - (let ((stmt (sqlite-prepare db insert-sql #:cache? #t))) + (let ((stmt (sqlite-prepare + db + " +INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) +VALUES (:path, :hash, :time, :deriver, :size)" + #:cache? #t))) (sqlite-bind-arguments stmt #:path path #:deriver deriver #:hash hash #:size nar-size #:time time) @@ -237,13 +241,15 @@ (define* (update-or-insert db #:key path deriver hash nar-size time) (sqlite-finalize stmt) (last-insert-row-id db))))) -(define add-reference-sql - "INSERT OR REPLACE INTO Refs (referrer, reference) VALUES (:referrer, :reference);") - (define (add-references db referrer references) "REFERRER is the id of the referring store item, REFERENCES is a list ids of items referred to." - (let ((stmt (sqlite-prepare db add-reference-sql #:cache? #t))) + (let ((stmt (sqlite-prepare + db + " +INSERT OR REPLACE INTO Refs (referrer, reference) +VALUES (:referrer, :reference)" + #:cache? #t))) (for-each (lambda (reference) (sqlite-reset stmt) (sqlite-bind-arguments stmt #:referrer referrer -- cgit v1.2.3 From 511d68c71d9c676aeb3a97936a984fb95a75f5a2 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 18 Feb 2024 13:38:17 +0000 Subject: store: database: Stop finalizing prepared statements. Especially since we're asking for these to be cached. Management of prepared statements isn't trivial, since you don't want to keep them forever as this can lead to poor query performance, but I don't think that finalizing them immediately is the right solution. Change-Id: I61706b4d09d771835bb8f074b8f6a6ee871f5e2d * guix/store/database.scm (sqlite-step-and-reset): New procedure. (last-insert-row, path-id, update-or-insert, add-references): Don't finalize prepared statements. Change-Id: I2a2c6deb43935d67df9e43000a5105343d72b3e6 --- guix/store/database.scm | 40 ++++++++++++++++++---------------------- 1 file changed, 18 insertions(+), 22 deletions(-) (limited to 'guix') diff --git a/guix/store/database.scm b/guix/store/database.scm index e958ef4d36..178f46e405 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -167,16 +167,19 @@ (define-syntax with-database ((_ file db exp ...) (call-with-database file (lambda (db) exp ...))))) +(define (sqlite-step-and-reset statement) + (let ((val (sqlite-step statement))) + (sqlite-reset statement) + val)) + (define (last-insert-row-id db) ;; XXX: (sqlite3) currently lacks bindings for 'sqlite3_last_insert_rowid'. ;; Work around that. - (let* ((stmt (sqlite-prepare db "SELECT last_insert_rowid();" - #:cache? #t)) - (result (sqlite-fold cons '() stmt))) - (sqlite-finalize stmt) - (match result - ((#(id)) id) - (_ #f)))) + (let ((stmt (sqlite-prepare db + "SELECT last_insert_rowid();" + #:cache? #t))) + (vector-ref (sqlite-step-and-reset stmt) + 0))) (define* (path-id db path) "If PATH exists in the 'ValidPaths' table, return its numerical @@ -187,11 +190,9 @@ (define* (path-id db path) SELECT id FROM ValidPaths WHERE path = :path" #:cache? #t))) (sqlite-bind-arguments stmt #:path path) - (let ((result (sqlite-fold cons '() stmt))) - (sqlite-finalize stmt) - (match result - ((#(id) . _) id) - (_ #f))))) + (match (sqlite-step-and-reset stmt) + (#(id) id) + (#f #f)))) (define-inlinable (assert-integer proc in-range? key number) (unless (integer? number) @@ -225,9 +226,8 @@ (define* (update-or-insert db #:key path deriver hash nar-size time) (sqlite-bind-arguments stmt #:id id #:deriver deriver #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt) - (sqlite-finalize stmt) - (last-insert-row-id db)) + (sqlite-step-and-reset stmt) + id) (let ((stmt (sqlite-prepare db " @@ -237,8 +237,7 @@ (define* (update-or-insert db #:key path deriver hash nar-size time) (sqlite-bind-arguments stmt #:path path #:deriver deriver #:hash hash #:size nar-size #:time time) - (sqlite-fold cons '() stmt) ;execute it - (sqlite-finalize stmt) + (sqlite-step-and-reset stmt) (last-insert-row-id db))))) (define (add-references db referrer references) @@ -251,13 +250,10 @@ (define (add-references db referrer references) VALUES (:referrer, :reference)" #:cache? #t))) (for-each (lambda (reference) - (sqlite-reset stmt) (sqlite-bind-arguments stmt #:referrer referrer #:reference reference) - (sqlite-fold cons '() stmt) ;execute it - (last-insert-row-id db)) - references) - (sqlite-finalize stmt))) + (sqlite-step-and-reset stmt)) + references))) (define (timestamp) "Return a timestamp, either the current time of SOURCE_DATE_EPOCH." -- cgit v1.2.3 From c6cc9aeb87014cfb8f1eabb525e28ac633bf7af4 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 18 Feb 2024 13:03:42 +0000 Subject: store: database: Refactor sqlite-register. The update-or-insert procedure name was unhelpfully generic, and these changes should improve the code readability. * guix/store/database.scm (update-or-insert): Remove procedure and inline functionality in to sqlite-register. Change-Id: Ifab0cdb7972d095460cc1f79b8b2f0e9b958059c --- guix/store/database.scm | 96 ++++++++++++++++++++++++------------------------- 1 file changed, 48 insertions(+), 48 deletions(-) (limited to 'guix') diff --git a/guix/store/database.scm b/guix/store/database.scm index 178f46e405..dea690ec76 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -204,42 +204,6 @@ (define-inlinable (assert-integer proc in-range? key number) "Integer ~A out of range: ~S" (list key number) (list number)))) -(define* (update-or-insert db #:key path deriver hash nar-size time) - "The classic update-if-exists and insert-if-doesn't feature that sqlite -doesn't exactly have... they've got something close, but it involves deleting -and re-inserting instead of updating, which causes problems with foreign keys, -of course. Returns the row id of the row that was modified or inserted." - - ;; Make sure NAR-SIZE is valid. - (assert-integer "update-or-insert" positive? #:nar-size nar-size) - (assert-integer "update-or-insert" (cut >= <> 0) #:time time) - - (let ((id (path-id db path))) - (if id - (let ((stmt (sqlite-prepare - db - " -UPDATE ValidPaths -SET hash = :hash, registrationTime = :time, deriver = :deriver, narSize = :size -WHERE id = :id" - #:cache? #t))) - (sqlite-bind-arguments stmt #:id id - #:deriver deriver - #:hash hash #:size nar-size #:time time) - (sqlite-step-and-reset stmt) - id) - (let ((stmt (sqlite-prepare - db - " -INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) -VALUES (:path, :hash, :time, :deriver, :size)" - #:cache? #t))) - (sqlite-bind-arguments stmt - #:path path #:deriver deriver - #:hash hash #:size nar-size #:time time) - (sqlite-step-and-reset stmt) - (last-insert-row-id db))))) - (define (add-references db referrer references) "REFERRER is the id of the referring store item, REFERENCES is a list ids of items referred to." @@ -265,9 +229,9 @@ (define (timestamp) (make-time time-utc 0 seconds) (current-time time-utc))))) -(define* (sqlite-register db #:key path (references '()) - deriver hash nar-size - (time (timestamp))) +(define* (register-valid-path db #:key path (references '()) + deriver hash nar-size + (time (timestamp))) "Registers this stuff in DB. PATH is the store item to register and REFERENCES is the list of store items PATH refers to; DERIVER is the '.drv' that produced PATH, HASH is the base16-encoded Nix sha256 hash of @@ -276,15 +240,51 @@ (define* (sqlite-register db #:key path (references '()) the database or #f, meaning \"right now\". Every store item in REFERENCES must already be registered." - (let ((id (update-or-insert db #:path path - #:deriver deriver - #:hash hash - #:nar-size nar-size - #:time (time-second time)))) - ;; Call 'path-id' on each of REFERENCES. This ensures we get a - ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. - (add-references db id - (map (cut path-id db <>) references)))) + + (define registration-time + (time-second time)) + + ;; Make sure NAR-SIZE is valid. + (assert-integer "sqlite-register" positive? #:nar-size nar-size) + (assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time) + + (define id + (let ((existing-id (path-id db path))) + (if existing-id + (let ((stmt (sqlite-prepare + db + " +UPDATE ValidPaths +SET hash = :hash, registrationTime = :time, deriver = :deriver, narSize = :size +WHERE id = :id" + #:cache? #t))) + (sqlite-bind-arguments stmt + #:id existing-id + #:deriver deriver + #:hash hash + #:size nar-size + #:time registration-time) + (sqlite-step-and-reset stmt) + existing-id) + (let ((stmt (sqlite-prepare + db + " +INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) +VALUES (:path, :hash, :time, :deriver, :size)" + #:cache? #t))) + (sqlite-bind-arguments stmt + #:path path + #:deriver deriver + #:hash hash + #:size nar-size + #:time registration-time) + (sqlite-step-and-reset stmt) + (last-insert-row-id db))))) + + ;; Call 'path-id' on each of REFERENCES. This ensures we get a + ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. + (add-references db id + (map (cut path-id db <>) references))) ;;; -- cgit v1.2.3 From c9cd16c630ccba655b93ff32fd9a99570b4f5373 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 19 Feb 2024 15:44:15 +0000 Subject: store: database: Rename a couple of procedures. These names should be more descriptive. * guix/store/database.scm (path-id): Rename to select-valid-path-id. (sqlite-register): Rename to register-valid-path. (register-items): Update accordingly. Change-Id: I6d4a14d4cde9d71ab34d6ffdbfbfde51b2c0e1db --- guix/store/database.scm | 35 +++++++++++++++++--------------- tests/pack.scm | 2 +- tests/store-database.scm | 53 ++++++++++++++++++++++++------------------------ 3 files changed, 46 insertions(+), 44 deletions(-) (limited to 'guix') diff --git a/guix/store/database.scm b/guix/store/database.scm index dea690ec76..58d3871e85 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -40,8 +40,10 @@ (define-module (guix store database) store-database-file call-with-database with-database - path-id - sqlite-register + + valid-path-id + + register-valid-path register-items %epoch reset-timestamps @@ -181,9 +183,9 @@ (define (last-insert-row-id db) (vector-ref (sqlite-step-and-reset stmt) 0))) -(define* (path-id db path) - "If PATH exists in the 'ValidPaths' table, return its numerical -identifier. Otherwise, return #f." +(define (valid-path-id db path) + "If PATH exists in the 'ValidPaths' table, return its numerical identifier. +Otherwise, return #f." (let ((stmt (sqlite-prepare db " @@ -249,7 +251,7 @@ (define registration-time (assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time) (define id - (let ((existing-id (path-id db path))) + (let ((existing-id (valid-path-id db path))) (if existing-id (let ((stmt (sqlite-prepare db @@ -284,7 +286,8 @@ (define id ;; Call 'path-id' on each of REFERENCES. This ensures we get a ;; "non-NULL constraint" failure if one of REFERENCES is unregistered. (add-references db id - (map (cut path-id db <>) references))) + (map (cut valid-path-id db <>) references))) + ;;; @@ -361,18 +364,18 @@ (define real-file-name ;; When TO-REGISTER is already registered, skip it. This makes a ;; significant differences when 'register-closures' is called ;; consecutively for overlapping closures such as 'system' and 'bootcfg'. - (unless (path-id db to-register) + (unless (valid-path-id db to-register) (let-values (((hash nar-size) (nar-sha256 real-file-name))) (call-with-retrying-transaction db (lambda () - (sqlite-register db #:path to-register - #:references (store-info-references item) - #:deriver (store-info-deriver item) - #:hash (string-append - "sha256:" - (bytevector->base16-string hash)) - #:nar-size nar-size - #:time registration-time)))))) + (register-valid-path db #:path to-register + #:references (store-info-references item) + #:deriver (store-info-deriver item) + #:hash (string-append + "sha256:" + (bytevector->base16-string hash)) + #:nar-size nar-size + #:time registration-time)))))) (let* ((prefix (format #f "registering ~a items" (length items))) (progress (progress-reporter/bar (length items) diff --git a/tests/pack.scm b/tests/pack.scm index 55445ea1e9..40897a5589 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -209,7 +209,7 @@ (define file (and (every valid-file? '("α" "λ") '("alpha" "lambda")) - (integer? (path-id db #$tree))))))))))) + (integer? (valid-path-id db #$tree))))))))))) (built-derivations (list check)))) (unless store (test-skip 1)) diff --git a/tests/store-database.scm b/tests/store-database.scm index d8f3ce8070..67d464386d 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -87,23 +87,22 @@ (define %store (lambda (db-file port) (delete-file db-file) (with-database db-file db - (sqlite-register db - #:path "/gnu/foo" - #:references '() - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size 1234) - (sqlite-register db - #:path "/gnu/bar" - #:references '("/gnu/foo") - #:deriver "/gnu/bar.drv" - #:hash (string-append "sha256:" (make-string 64 #\a)) - #:nar-size 4321) - (let ((path-id (@@ (guix store database) path-id))) - (list (path-id db "/gnu/foo") - (path-id db "/gnu/bar"))))))) + (register-valid-path db + #:path "/gnu/foo" + #:references '() + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size 1234) + (register-valid-path db + #:path "/gnu/bar" + #:references '("/gnu/foo") + #:deriver "/gnu/bar.drv" + #:hash (string-append "sha256:" (make-string 64 #\a)) + #:nar-size 4321) + (list (valid-path-id db "/gnu/foo") + (valid-path-id db "/gnu/bar")))))) -(test-assert "sqlite-register with unregistered references" +(test-assert "register-valid-path with unregistered references" ;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error ;; when we try to add references that are not registered yet. Better safe ;; than sorry. @@ -113,17 +112,17 @@ (define %store (catch 'sqlite-error (lambda () (with-database db-file db - (sqlite-register db #:path "/gnu/foo" - #:references '("/gnu/bar") - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size 1234)) + (register-valid-path db #:path "/gnu/foo" + #:references '("/gnu/bar") + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size 1234)) #f) (lambda args (pk 'welcome-exception! args) #t))))) -(test-equal "sqlite-register with incorrect size" +(test-equal "register-valid-path with incorrect size" 'out-of-range (call-with-temporary-output-file (lambda (db-file port) @@ -131,11 +130,11 @@ (define %store (catch #t (lambda () (with-database db-file db - (sqlite-register db #:path "/gnu/foo" - #:references '("/gnu/bar") - #:deriver "/gnu/foo.drv" - #:hash (string-append "sha256:" (make-string 64 #\e)) - #:nar-size -1234)) + (register-valid-path db #:path "/gnu/foo" + #:references '("/gnu/bar") + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size -1234)) #f) (lambda (key . _) key))))) -- cgit v1.2.3 From a499d1772df63784e7df1767e58ca1dd5a4b1124 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sat, 23 Mar 2024 00:31:25 -0400 Subject: build: qt-utils: Use QML_IMPORT_PATH for Qt 6. * guix/build/qt-utils.scm (variables-for-wrapping): Use QML_IMPORT_PATH instead of QML2_IMPORT_PATH when the major version is greater or equal to 6. Change-Id: I3480b540d3c0caafd3cc3d6574442dc97f540953 --- guix/build/qt-utils.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm index 7d1b0e0e23..8962c0edb8 100644 --- a/guix/build/qt-utils.scm +++ b/guix/build/qt-utils.scm @@ -3,8 +3,7 @@ ;;; Copyright © 2019, 2020, 2021 Hartmut Goebel ;;; Copyright © 2020 Jakub Kądziołka ;;; Copyright © 2021 Ludovic Courtès -;;; Copyright © 2021, 2022 Maxim Cournoyer -;;; Copyright © 2021, 2022, 2023 Maxim Cournoyer +;;; Copyright © 2021, 2022, 2023, 2024 Maxim Cournoyer ;;; Copyright © 2021 Brendan Tildesley ;;; ;;; This file is part of GNU Guix. @@ -90,8 +89,10 @@ (define exists? (match file-type '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg") `("QT_PLUGIN_PATH" prefix directory ,(format #f "/lib/qt~a/plugins" qt-major-version)) - `("QML2_IMPORT_PATH" prefix directory - ,(format #f "/lib/qt~a/qml" qt-major-version)) + `(,(if (>= 6 (string->number qt-major-version)) + "QML_IMPORT_PATH" + "QML2_IMPORT_PATH") + prefix directory ,(format #f "/lib/qt~a/qml" qt-major-version)) ;; QTWEBENGINEPROCESS_PATH accepts a single value, which makes 'exact the ;; most suitable environment variable type for it. `("QTWEBENGINEPROCESS_PATH" = regular -- cgit v1.2.3 From 96802f490d3ba5d9ad7c43bc37d683e43540e3c0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 2 Apr 2024 14:17:25 +0200 Subject: ssh: ‘open-ssh-session’ displays the port number upon error. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/ssh.scm (open-ssh-session): Show the port number in error message. Change-Id: I18a3dc54223bb29782dcdd43d3252c720525c31d --- guix/ssh.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/ssh.scm b/guix/ssh.scm index c4617d2c74..ae506df14c 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016-2021, 2023 Ludovic Courtès +;;; Copyright © 2016-2021, 2023-2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -180,8 +180,8 @@ (define* (open-ssh-session host #:key user port identity (get-error session))))))))))) (x ;; Connection failed or timeout expired. - (raise (formatted-message (G_ "SSH connection to '~a' failed: ~a~%") - host (get-error session))))))) + (raise (formatted-message (G_ "SSH connection to '~a' port ~a failed: ~a~%") + host (or port 22) (get-error session))))))) (define* (remote-inferior session #:optional become-command) "Return a remote inferior for the given SESSION. If BECOME-COMMAND is -- cgit v1.2.3 From d6a3818761736449a27eb44938537798f6f4e85b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 21 Mar 2024 23:38:04 +0100 Subject: build-system/channel: Add support for additional channels. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Until now, ‘channel-build-system’ would assume a single channel, the ‘guix’ channel. This change lets users specify additional channels using the #:channels parameter. * guix/build-system/channel.scm (build-channels): Add #:channels and honor it. (channel-build-system): In ‘lower’, add #:channels and honor it. * doc/guix.texi (Build Systems): Document it. Change-Id: I36c1d19cbeee02a4d1144de089b78df0390774a0 --- doc/guix.texi | 5 ++++- guix/build-system/channel.scm | 7 +++++-- 2 files changed, 9 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 6f95270fa0..e2d578751b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10466,7 +10466,10 @@ field (@pxref{Channels}); alternatively, its source can be a directory name, in which case an additional @code{#:commit} argument must be supplied to specify the commit being built (a hexadecimal string). -The resulting package is a Guix instance of the given channel, similar +Optionally, a @code{#:channels} argument specifying additional channels +can be provided. + +The resulting package is a Guix instance of the given channel(s), similar to how @command{guix time-machine} would build it. @end defvar diff --git a/guix/build-system/channel.scm b/guix/build-system/channel.scm index 6ad377f930..0607dcf4d7 100644 --- a/guix/build-system/channel.scm +++ b/guix/build-system/channel.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019-2022 Ludovic Courtès +;;; Copyright © 2019-2022, 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +37,7 @@ (define latest-channel-instances* (define* (build-channels name inputs #:key source system commit + (channels '()) (authenticate? #t) #:allow-other-keys) (mlet* %store-monad ((instances @@ -44,7 +45,7 @@ (define* (build-channels name inputs (return (list source))) ((channel? source) (latest-channel-instances* - (list source) + (cons source channels) #:authenticate? authenticate?)) ((string? source) ;; If SOURCE is a store file name, as is the @@ -64,12 +65,14 @@ (define* (build-channels name inputs (define channel-build-system ;; Build system used to "convert" a channel instance to a package. (let ((lower (lambda* (name #:key system source commit (authenticate? #t) + (channels '()) #:allow-other-keys) (bag (name name) (system system) (build build-channels) (arguments `(#:source ,source + #:channels ,channels #:authenticate? ,authenticate? #:commit ,commit)))))) (build-system (name 'channel) -- cgit v1.2.3 From 91ad8a1444fa1b1d002e26bbed580e869723af47 Mon Sep 17 00:00:00 2001 From: Zheng Junjie Date: Sat, 6 Apr 2024 10:27:47 +0800 Subject: build: qt-utils: Use QML_IMPORT_PATH2 for Qt 5 (fixup). This follows a499d1772df63784e7df1767e58ca1dd5a4b1124 ("build: qt-utils: Use QML_IMPORT_PATH for Qt 6."). * guix/build/qt-utils.scm (variables-for-wrapping): Use QML_IMPORT_PATH2 when the Qt major version is <= 6, QML_IMPORT_PATH otherwise. Change-Id: I2dd1d426aef117105708cc4004078deaa28c15cd Signed-off-by: Maxim Cournoyer --- guix/build/qt-utils.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm index 8962c0edb8..d7609b9f21 100644 --- a/guix/build/qt-utils.scm +++ b/guix/build/qt-utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2021 Ludovic Courtès ;;; Copyright © 2021, 2022, 2023, 2024 Maxim Cournoyer ;;; Copyright © 2021 Brendan Tildesley +;;; Copyright © 2024 Zheng Junjie <873216071@qq.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,7 +90,7 @@ (define exists? (match file-type '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg") `("QT_PLUGIN_PATH" prefix directory ,(format #f "/lib/qt~a/plugins" qt-major-version)) - `(,(if (>= 6 (string->number qt-major-version)) + `(,(if (>= (string->number qt-major-version) 6) "QML_IMPORT_PATH" "QML2_IMPORT_PATH") prefix directory ,(format #f "/lib/qt~a/qml" qt-major-version)) -- cgit v1.2.3 From a3c28d7f7eeaf799c8f043848dbb59198649e1ac Mon Sep 17 00:00:00 2001 From: Wojtek Kosior Date: Sat, 6 Apr 2024 22:37:07 +0200 Subject: scripts: system: Rename `sqlite-register'. * guix/scripts/system.scm (define-module): #:autoload `register-valid-path' instead of `sqlite-register'. (copy-item): Call it with the new name. Change-Id: I24f71f822a5f400a47adee43f61184a4fbcb9741 Signed-off-by: Christopher Baines --- guix/scripts/system.scm | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index bf3d2f9044..67020a2aab 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -35,7 +35,7 @@ (define-module (guix scripts system) #:use-module (guix store) #:autoload (guix base16) (bytevector->base16-string) #:autoload (guix store database) - (sqlite-register store-database-file call-with-database) + (register-valid-path store-database-file call-with-database) #:autoload (guix build store-copy) (copy-store-item) #:use-module (guix describe) #:use-module (guix gexp) @@ -158,14 +158,15 @@ (define* (copy-item item info target db (copy-store-item item target #:deduplicate? #t) - (sqlite-register db - #:path item - #:references (path-info-references info) - #:deriver (path-info-deriver info) - #:hash (string-append - "sha256:" - (bytevector->base16-string (path-info-hash info))) - #:nar-size (path-info-nar-size info)))) + (register-valid-path db + #:path item + #:references (path-info-references info) + #:deriver (path-info-deriver info) + #:hash (string-append + "sha256:" + (bytevector->base16-string + (path-info-hash info))) + #:nar-size (path-info-nar-size info)))) (define* (copy-closure item target #:key (log-port (current-error-port))) -- cgit v1.2.3 From c3dfb14f9be7479057036d3fe7744828d2c1a31a Mon Sep 17 00:00:00 2001 From: Wojtek Kosior Date: Sat, 6 Apr 2024 22:37:08 +0200 Subject: store: database: Use correct function name in assertion. * guix/store/database.scm (register-valid-path): Replace "sqlite-register" with "register-valid-path" as argument to `assert-integer'. Change-Id: Id93687e90d0a806d715006ca0b2498a1d10cfba6 Signed-off-by: Christopher Baines --- guix/store/database.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/store/database.scm b/guix/store/database.scm index 58d3871e85..a847f9d2f0 100644 --- a/guix/store/database.scm +++ b/guix/store/database.scm @@ -247,8 +247,9 @@ (define registration-time (time-second time)) ;; Make sure NAR-SIZE is valid. - (assert-integer "sqlite-register" positive? #:nar-size nar-size) - (assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time) + (assert-integer "register-valid-path" positive? #:nar-size nar-size) + (assert-integer "register-valid-path" (cut >= <> 0) + #:time registration-time) (define id (let ((existing-id (valid-path-id db path))) -- cgit v1.2.3 From acd3cb258fe68548b3c14b3b7819a46e2cd2da97 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 7 Apr 2024 19:32:33 +0100 Subject: guix: nar: Update path-id to valid-path-id. To match the change in (guix store database). * guix/nar.scm (finalize-store-file): Update path-id to valid-path-id. Change-Id: I69255c7acc1ea4e4855a4621bfcec54f595dd24d --- guix/nar.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/nar.scm b/guix/nar.scm index a817b56007..cabcc4bbbf 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -103,11 +103,11 @@ (define (acquire-lock file) (acquire-lock file))))) (with-database %default-database-file db - (unless (path-id db target) + (unless (valid-path-id db target) (let ((lock (and lock? (acquire-lock (string-append target ".lock"))))) - (unless (path-id db target) + (unless (valid-path-id db target) ;; If FILE already exists, delete it (it's invalid anyway.) (when (file-exists? target) (delete-file-recursively target)) -- cgit v1.2.3 From 298aed72a2a76be33f9a55bed22636acd7a4f9b9 Mon Sep 17 00:00:00 2001 From: Ian Eure Date: Sat, 6 Apr 2024 16:17:06 -0700 Subject: gnu: open-ssh-session: Don’t require public key. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Public keys aren’t required for client connections, and this binding is unused. The behavior of assuming a ".pub"-suffixed file exists in the same directory as the secret key is undocumented and surprising. * guix/scripts/offload.scm (open-ssh-session): Delete `public' binding. Signed-off-by: Christopher Baines Change-Id: I9b532be2abe68dae0323e4ef6e1ceab1e5603359 --- guix/scripts/offload.scm | 3 --- 1 file changed, 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 137e3b5fe3..93e9d3759c 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -213,9 +213,6 @@ (define* (open-ssh-session machine #:optional max-silent-time) When MAX-SILENT-TIME is true, it must be a positive integer denoting the number of seconds after which the connection times out." (let ((private (private-key-from-file* (build-machine-private-key machine))) - (public (public-key-from-file - (string-append (build-machine-private-key machine) - ".pub"))) (session (make-session #:user (build-machine-user machine) #:host (build-machine-name machine) #:port (build-machine-port machine) -- cgit v1.2.3 From a7f15c9ecffc1762f5886fb5a2a14490e2994c8c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 6 Apr 2024 16:31:54 +0200 Subject: reconfigure: /run/current-system points to generation. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/system/reconfigure.scm (switch-system-program): Set ‘GUIX_NEW_SYSTEM’ to GENERATION rather than OS, for consistency with what ‘boot-system’ does. * gnu/tests/reconfigure.scm (run-switch-to-system-test) ["script activated the new generation"]: Adjust accordingly. Change-Id: I57b693606a41b8c952df32bbdc2b9120c6dbfd6a --- gnu/tests/reconfigure.scm | 15 ++++++--------- guix/scripts/system/reconfigure.scm | 4 ++-- 2 files changed, 8 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm index 00514e7020..bcc7645fa3 100644 --- a/gnu/tests/reconfigure.scm +++ b/gnu/tests/reconfigure.scm @@ -92,15 +92,12 @@ (define (system-generations marionette) (length (system-generations marionette)) (1+ (length generations-prior))) - (test-assert "script activated the new generation" - (and (eqv? 'symlink - (marionette-eval - '(stat:type (lstat "/run/current-system")) - marionette)) - (string= #$os - (marionette-eval - '(readlink "/run/current-system") - marionette)))) + (test-equal "script activated the new generation" + (string-append "/var/guix/profiles/system-" + (number->string (+ 1 (length generations-prior))) + "-link") + (marionette-eval '(readlink "/run/current-system") + marionette)) (test-assert "script activated user accounts" (marionette-eval diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index 9418060158..604ba08fee 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès +;;; Copyright © 2014-2022, 2024 Ludovic Courtès ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2016, 2017, 2018 Chris Marusich ;;; Copyright © 2017 Mathieu Othacehe @@ -106,7 +106,7 @@ (define profile (generation (generation-file-name profile number))) (switch-symlinks generation #$os) (switch-symlinks profile generation) - (setenv "GUIX_NEW_SYSTEM" #$os) + (setenv "GUIX_NEW_SYSTEM" generation) (primitive-load #$(operating-system-activation-script os)))))))) (define* (switch-to-system eval os #:optional profile) -- cgit v1.2.3 From b30b838d5055e36be19d030db28838fec4474d98 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 6 Apr 2024 23:03:26 +0200 Subject: gexp: Add #:guile parameter to ‘gexp->file’ and ‘scheme-file’. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This brings ‘gexp->file’ in line with its documentation and mirrors what’s done for ‘gexp->script’ and ‘program-file’. Fixes . * guix/gexp.scm (gexp->file): Add #:guile, as was already documented. ()[guile]: New field. (scheme-file): Add #:guile. (scheme-file-compiler): Honor ‘guile’ field. * tests/gexp.scm ("gexp->file") ("gexp->file + file-append", "gexp->file + #:splice?") ("gexp->file, cross-compilation") ("gexp->file, cross-compilation with default target") Add #:guile to ‘gexp->file’ calls. ("gexp-modules deletes duplicates") ("gexp->derivation & with-imported-module & computed module") ("gexp->derivation & with-extensions", "scheme-file"): Likewise for ‘scheme-file’ calls. Change-Id: I47536063d5e411e561ec321e535267e92dd06044 Reported-by: Efraim Flashner Change-Id: I58d653c7fbe65c665bafcbd332ac9b264ddeab64 --- doc/guix.texi | 5 +++-- guix/gexp.scm | 19 ++++++++++++++----- tests/gexp.scm | 31 +++++++++++++++++++++---------- 3 files changed, 38 insertions(+), 17 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 3ad44b4acb..5827e0de14 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12192,9 +12192,10 @@ The resulting file holds references to all the dependencies of @var{exp} or a subset thereof. @end deffn -@deffn {Procedure} scheme-file name exp [#:splice? #f] [#:set-load-path? #t] +@deffn {Procedure} scheme-file name exp [#:splice? #f] @ + [#:guile #f] [#:set-load-path? #t] Return an object representing the Scheme file @var{name} that contains -@var{exp}. +@var{exp}. @var{guile} is the Guile package used to produce that file. This is the declarative counterpart of @code{gexp->file}. @end deffn diff --git a/guix/gexp.scm b/guix/gexp.scm index 29819878fa..74b4c49f90 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2023 Ludovic Courtès +;;; Copyright © 2014-2024 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; Copyright © 2019, 2020 Mathieu Othacehe @@ -633,25 +633,29 @@ (define-gexp-compiler (program-file-compiler (file ) #:target target)))) (define-record-type - (%scheme-file name gexp splice? load-path?) + (%scheme-file name gexp splice? guile load-path?) scheme-file? (name scheme-file-name) ;string (gexp scheme-file-gexp) ;gexp (splice? scheme-file-splice?) ;Boolean + (guile scheme-file-guile) ;package (load-path? scheme-file-set-load-path?)) ;Boolean -(define* (scheme-file name gexp #:key splice? (set-load-path? #t)) +(define* (scheme-file name gexp + #:key splice? + guile (set-load-path? #t)) "Return an object representing the Scheme file NAME that contains GEXP. This is the declarative counterpart of 'gexp->file'." - (%scheme-file name gexp splice? set-load-path?)) + (%scheme-file name gexp splice? guile set-load-path?)) (define-gexp-compiler (scheme-file-compiler (file ) system target) ;; Compile FILE by returning a derivation that builds the file. (match file - (($ name gexp splice? set-load-path?) + (($ name gexp splice? guile set-load-path?) (gexp->file name gexp + #:guile (or guile (default-guile)) #:set-load-path? set-load-path? #:splice? splice? #:system system @@ -2019,6 +2023,7 @@ (define* (gexp->script name exp #:substitutable? #f))) (define* (gexp->file name exp #:key + (guile (default-guile)) (set-load-path? #t) (module-path %load-path) (splice? #f) @@ -2038,6 +2043,8 @@ (define extensions (gexp-extensions exp)) ((target (if (eq? target 'current) (current-target-system) (return target))) + (guile-for-build + (lower-object guile system #:target #f)) (no-load-path? -> (or (not set-load-path?) (and (null? modules) (null? extensions)))) @@ -2057,6 +2064,7 @@ (define extensions (gexp-extensions exp)) '(ungexp (if splice? exp (gexp ((ungexp exp))))))))) + #:guile-for-build guile-for-build #:local-build? #t #:substitutable? #f #:system system @@ -2073,6 +2081,7 @@ (define extensions (gexp-extensions exp)) exp (gexp ((ungexp exp))))))))) #:module-path module-path + #:guile-for-build guile-for-build #:local-build? #t #:substitutable? #f #:system system diff --git a/tests/gexp.scm b/tests/gexp.scm index 001786c13c..905009caee 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2023 Ludovic Courtès +;;; Copyright © 2014-2024 Ludovic Courtès ;;; Copyright © 2021-2022 Maxime Devos ;;; ;;; This file is part of GNU Guix. @@ -661,7 +661,8 @@ (define (match-input thing) (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (guile (package-file %bootstrap-guile)) (sexp (gexp->sexp exp (%current-system) #f)) - (drv (gexp->file "foo" exp)) + (drv (gexp->file "foo" exp + #:guile %bootstrap-guile)) (out -> (derivation->output-path drv)) (done (built-derivations (list drv))) (refs (references* out))) @@ -672,7 +673,8 @@ (define (match-input thing) (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile "/bin/guile")) (guile (package-file %bootstrap-guile)) - (drv (gexp->file "foo" exp)) + (drv (gexp->file "foo" exp + #:guile %bootstrap-guile)) (out -> (derivation->output-path drv)) (done (built-derivations (list drv))) (refs (references* out))) @@ -685,7 +687,9 @@ (define (match-input thing) #~(define foo 'bar) #~(define guile #$%bootstrap-guile))) (guile (package-file %bootstrap-guile)) - (drv (gexp->file "splice" exp #:splice? #t)) + (drv (gexp->file "splice" exp + #:splice? #t + #:guile %bootstrap-guile)) (out -> (derivation->output-path drv)) (done (built-derivations (list drv))) (refs (references* out))) @@ -943,7 +947,8 @@ (define (canonical-file? file) (let ((make-file (lambda () ;; Use 'eval' to make sure we get an object that's not ;; 'eq?' nor 'equal?' due to the closures it embeds. - (eval '(scheme-file "bar.scm" #~(define-module (bar))) + (eval '(scheme-file "bar.scm" #~(define-module (bar)) + #:guile %bootstrap-guile) (current-module))))) (define result ((@@ (guix gexp) gexp-modules) @@ -1035,7 +1040,8 @@ (define-module (foo bar) #:export (the-answer)) (define the-answer 42)) - #:splice? #t)) + #:splice? #t + #:guile %bootstrap-guile)) (build -> (with-imported-modules `(((foo bar) => ,module) (guix build utils)) #~(begin @@ -1080,7 +1086,8 @@ (define-module (foo) (define (multiply x) (* the-answer x))) - #:splice? #t)) + #:splice? #t + #:guile %bootstrap-guile)) (build -> (with-extensions (list extension) (with-imported-modules `((guix build utils) ((foo) => ,module)) @@ -1432,7 +1439,8 @@ (define-public %stupid-thing ,text)) (test-assertm "scheme-file" (let* ((text (plain-file "foo" "Hello, world!")) - (scheme (scheme-file "bar" #~(list "foo" #$text)))) + (scheme (scheme-file "bar" #~(list "foo" #$text) + #:guile %bootstrap-guile))) (mlet* %store-monad ((drv (lower-object scheme)) (text (lower-object text)) (out -> (derivation->output-path drv))) @@ -1719,7 +1727,9 @@ (define (contents=? file str) (test-assertm "gexp->file, cross-compilation" (mlet* %store-monad ((target -> "aarch64-linux-gnu") (exp -> (gexp (list (ungexp coreutils)))) - (xdrv (gexp->file "foo" exp #:target target)) + (xdrv (gexp->file "foo" exp + #:target target + #:guile %bootstrap-guile)) (refs (references* (derivation-file-name xdrv))) (xcu (package->cross-derivation coreutils @@ -1732,7 +1742,8 @@ (define (contents=? file str) (mlet* %store-monad ((target -> "aarch64-linux-gnu") (_ (set-current-target target)) (exp -> (gexp (list (ungexp coreutils)))) - (xdrv (gexp->file "foo" exp)) + (xdrv (gexp->file "foo" exp + #:guile %bootstrap-guile)) (refs (references* (derivation-file-name xdrv))) (xcu (package->cross-derivation coreutils -- cgit v1.2.3 From 3cadb61963b2116d35a0f9b989223cf19155bec6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 31 Mar 2024 23:06:46 +0200 Subject: channels: Use SRFI-71 instead of SRFI-11. * guix/channels.scm (latest-channel-instance): Use SRFI-71. Change-Id: I73531c98b3034e228006ed91518cc7bfedc784fd --- guix/channels.scm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index 66f3122f79..10f0e3800f 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -43,10 +43,10 @@ (define-module (guix channels) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:autoload (guix describe) (current-channels) ;XXX: circular dep #:autoload (guix self) (whole-package make-config.scm) #:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep @@ -411,12 +411,11 @@ (define (dot-git? file stat) (and (string=? (basename file) ".git") (eq? 'directory (stat:type stat)))) - (let-values (((channel) - (ensure-default-introduction channel)) - ((checkout commit relation) - (update-cached-checkout (channel-url channel) - #:ref (channel-reference channel) - #:starting-commit starting-commit))) + (let ((channel (ensure-default-introduction channel)) + (checkout commit relation + (update-cached-checkout (channel-url channel) + #:ref (channel-reference channel) + #:starting-commit starting-commit))) (when relation (validate-pull channel starting-commit commit relation)) -- cgit v1.2.3 From a57518484e5437b29496e1c132c6566e1eb437e8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 31 Mar 2024 23:16:30 +0200 Subject: git: Add ‘repository-info’ and use it in (guix channels). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/git.scm (repository-info): New procedure. * guix/channels.scm (repository->guix-channel): Use it instead of local code. Change-Id: I74c758c73a22e16031571ca4271cc9cab0492f6e --- guix/channels.scm | 20 ++++++++------------ guix/git.scm | 19 ++++++++++++++++++- 2 files changed, 26 insertions(+), 13 deletions(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index 10f0e3800f..f26ccbc3ae 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -24,6 +24,7 @@ (define-module (guix channels) #:autoload (guix git) (update-cached-checkout url+commit->name commit-difference + repository-info with-repository) #:autoload (guix git-authenticate) (authenticate-repository) #:autoload (guix openpgp) (openpgp-public-key-fingerprint @@ -207,18 +208,13 @@ (define* (repository->guix-channel directory channel that uses that repository and the commit HEAD currently points to; use INTRODUCTION as the channel's introduction. Return #f if no Git repository could be found at DIRECTORY or one of its ancestors." - (catch 'git-error - (lambda () - (with-repository (repository-discover directory) repository - (let* ((head (repository-head repository)) - (commit (oid->string (reference-target head)))) - (channel - (inherit %default-guix-channel) - (url (repository-working-directory repository)) - (commit commit) - (branch (reference-shorthand head)) - (introduction introduction))))) - (const #f))) + (let ((directory commit branch (repository-info directory))) + (channel + (inherit %default-guix-channel) + (url directory) + (commit commit) + (branch branch) + (introduction introduction)))) (define-record-type (channel-instance channel commit checkout) diff --git a/guix/git.scm b/guix/git.scm index cbcdb1904b..760b064a9c 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2020 Mathieu Othacehe -;;; Copyright © 2018-2023 Ludovic Courtès +;;; Copyright © 2018-2024 Ludovic Courtès ;;; Copyright © 2021 Kyle Meyer ;;; Copyright © 2021 Marius Bakke ;;; Copyright © 2022 Maxime Devos @@ -59,6 +59,7 @@ (define-module (guix git) with-repository with-git-error-handling false-if-git-not-found + repository-info update-cached-checkout url+commit->name latest-repository-commit @@ -330,6 +331,22 @@ (define-syntax-rule (with-git-error-handling body ...) (lambda (key err) (report-git-error err)))) +(define (repository-info directory) + "Open the Git repository in DIRECTORY or one of its parent and return three +values: the working directory of that repository, its checked out commit ID, +and its checked out reference (such as a branch name). Return #f (three +values) if DIRECTORY does not hold a readable Git repository." + (catch 'git-error + (lambda () + (with-repository (repository-discover directory) repository + (let* ((head (repository-head repository)) + (commit (oid->string (reference-target head)))) + (values (repository-working-directory repository) + commit + (reference-shorthand head))))) + (lambda _ + (values #f #f #f)))) + (define* (update-submodules repository #:key (log-port (current-error-port)) (fetch-options #f)) -- cgit v1.2.3 From 088e181c0a58bf1a03e3aa7be1202fb3cd209136 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 31 Mar 2024 23:17:29 +0200 Subject: channels: Move ‘commit-short-id’ to (guix git). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/channels.scm (commit-short-id): Move to… * guix/git.scm (commit-short-id): … here. Change-Id: If4b34b1d82b1aa5068d157f26e57e8aecc967061 --- guix/channels.scm | 4 +--- guix/git.scm | 4 ++++ 2 files changed, 5 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index f26ccbc3ae..0b776ab211 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -25,6 +25,7 @@ (define-module (guix channels) url+commit->name commit-difference repository-info + commit-short-id with-repository) #:autoload (guix git-authenticate) (authenticate-repository) #:autoload (guix openpgp) (openpgp-public-key-fingerprint @@ -339,9 +340,6 @@ (define (apply-patches checkout commit patches) (apply-patch patch checkout)) (loop rest))))) -(define commit-short-id - (compose (cut string-take <> 7) oid->string commit-id)) - (define* (authenticate-channel channel checkout commit #:key (keyring-reference-prefix "origin/")) "Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a diff --git a/guix/git.scm b/guix/git.scm index 760b064a9c..eab84ea798 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -67,6 +67,7 @@ (define-module (guix git) commit-relation commit-descendant? commit-id? + commit-short-id remote-refs @@ -233,6 +234,9 @@ (define (commit-id? str) (and (= (string-length str) 40) (string-every char-set:hex-digit str))) +(define commit-short-id + (compose (cut string-take <> 7) oid->string commit-id)) + (define (resolve-reference repository ref) "Resolve the branch, commit or tag specified by REF, and return the corresponding Git object." -- cgit v1.2.3 From 96d2de01853a5955ad882a565c903e1b1689b4f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 31 Mar 2024 23:31:21 +0200 Subject: git: Add ‘tag->commit’ and use it in (guix channels). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/git.scm (tag->commit): New procedure, taken from… (resolve-reference): … here. Use it in the ‘tag’ case. * guix/channels.scm (resolve-channel-news-entry-tag): Use ‘tag->commit’ instead of custom code. Change-Id: I46ea387345dc1b695ce0702991a52d0cde29e2f0 --- guix/channels.scm | 11 +++-------- guix/git.scm | 24 +++++++++++++++--------- 2 files changed, 18 insertions(+), 17 deletions(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index 0b776ab211..70608561f9 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -26,6 +26,7 @@ (define-module (guix channels) commit-difference repository-info commit-short-id + tag->commit with-repository) #:autoload (guix git-authenticate) (authenticate-repository) #:autoload (guix openpgp) (openpgp-public-key-fingerprint @@ -1148,14 +1149,8 @@ (define (resolve-channel-news-entry-tag repository entry) cannot be found." (if (channel-news-entry-commit entry) entry - (let* ((tag (channel-news-entry-tag entry)) - (reference (reference-lookup repository - (string-append "refs/tags/" tag))) - (target (reference-target reference)) - (oid (let ((obj (object-lookup repository target))) - (if (= OBJ-TAG (object-type obj)) ;annotated tag? - (tag-target-id (tag-lookup repository target)) - target)))) + (let* ((tag (channel-news-entry-tag entry)) + (oid (object-id (tag->commit repository tag)))) (channel-news-entry (oid->string oid) tag (channel-news-entry-title entry) (channel-news-entry-body entry))))) diff --git a/guix/git.scm b/guix/git.scm index eab84ea798..8e1d863976 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -68,6 +68,7 @@ (define-module (guix git) commit-descendant? commit-id? commit-short-id + tag->commit remote-refs @@ -237,6 +238,19 @@ (define (commit-id? str) (define commit-short-id (compose (cut string-take <> 7) oid->string commit-id)) +(define (tag->commit repository tag) + "Resolve TAG in REPOSITORY and return the corresponding object, usually a +commit." + (let* ((oid (reference-name->oid repository + (string-append "refs/tags/" tag))) + (obj (object-lookup repository oid))) + ;; OID may designate an "annotated tag" object or a "commit" object. + ;; Return the commit object in both cases. + (if (= OBJ-TAG (object-type obj)) + (object-lookup repository + (tag-target-id (tag-lookup repository oid))) + obj))) + (define (resolve-reference repository ref) "Resolve the branch, commit or tag specified by REF, and return the corresponding Git object." @@ -283,15 +297,7 @@ (define (resolve-reference repository ref) ;; There's no such tag, so it must be a commit ID. (resolve `(commit . ,str))))))) (('tag . tag) - (let* ((oid (reference-name->oid repository - (string-append "refs/tags/" tag))) - (obj (object-lookup repository oid))) - ;; OID may designate an "annotated tag" object or a "commit" object. - ;; Return the commit object in both cases. - (if (= OBJ-TAG (object-type obj)) - (object-lookup repository - (tag-target-id (tag-lookup repository oid))) - obj)))))) + (tag->commit repository tag))))) (define (switch-to-ref repository ref) "Switch to REPOSITORY's branch, commit or tag specified by REF. Return the -- cgit v1.2.3 From 276e6589439e79d20f706609eb22f616f62de2d3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 31 Mar 2024 23:37:29 +0200 Subject: channels: Autoload (git …) modules. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Autoloading Guile-Git is important in cases where (guix channels) is used for little more than the definition. This is the case, for example, of ‘guix describe’ or ‘guix shell’. This reduces from 177 to 121 the number of .go files loaded when running: ./pre-inst-env strace -e openat -o /tmp/log.strace \ guix describe -p /var/guix/profiles/per-user/$USER/current-guix grep 'openat.*\.go.* = [0-9]' < /tmp/log.strace |wc -l Likewise, it reduces the max RSS (as measured by ‘time -f %M guix describe -p …’) from 54 to 37 MiB. * guix/channels.scm: Autoload (git …) modules. Change-Id: Ia58a99c865bf0f6fe461a1e71390d075e760f8d6 --- guix/channels.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index 70608561f9..51024dcad4 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -20,7 +20,13 @@ ;;; along with GNU Guix. If not, see . (define-module (guix channels) - #:use-module (git) ;TODO: autoload + #:autoload (git commit) (commit-lookup + commit-id) + #:autoload (git oid) (oid->string + string->oid) + #:autoload (git object) (object-id) + #:autoload (git errors) (GIT_ENOTFOUND) + #:autoload (git structs) (git-error-code) #:autoload (guix git) (update-cached-checkout url+commit->name commit-difference -- cgit v1.2.3 From 6dc238f2613c5049e2f2d346c4482b7ecc76c9fa Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 1 Apr 2024 00:02:51 +0200 Subject: guix system: Autoload some more. * guix/scripts/system.scm: Autoload more modules. Change-Id: I665857109bbfd1e3755135daacc01affcb3eb2eb --- guix/scripts/system.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 67020a2aab..2260bcf985 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2023 Ludovic Courtès +;;; Copyright © 2014-2024 Ludovic Courtès ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2016, 2017, 2018 Chris Marusich ;;; Copyright © 2017, 2019 Mathieu Othacehe @@ -37,7 +37,7 @@ (define-module (guix scripts system) #:autoload (guix store database) (register-valid-path store-database-file call-with-database) #:autoload (guix build store-copy) (copy-store-item) - #:use-module (guix describe) + #:autoload (guix describe) (current-profile) #:use-module (guix gexp) #:use-module (guix derivations) #:use-module (guix diagnostics) @@ -47,7 +47,10 @@ (define-module (guix scripts system) #:use-module (guix records) #:use-module (guix profiles) #:use-module (guix scripts) - #:use-module (guix channels) + #:autoload (guix channels) (channel-name + channel-url + channel-branch + channel-commit) #:use-module (guix scripts build) #:autoload (guix scripts package) (delete-generations delete-matching-generations @@ -57,7 +60,8 @@ (define-module (guix scripts system) graph-backend-name lookup-backend) #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) - #:use-module (guix progress) + #:autoload (guix progress) (progress-reporter/bar + call-with-progress-reporter) #:use-module ((guix docker) #:select (%docker-image-max-layers)) #:use-module (gnu build image) #:use-module (gnu build install) -- cgit v1.2.3 From 54be7795b5cc2f6cad05f8649121372c9d5af806 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 1 Apr 2024 15:11:40 +0200 Subject: utils: Don’t re-export ‘call-with-temporary-output-file’. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/utils.scm: Remove re-export of ‘call-with-temporary-output-file’. Autoload a number of modules. * guix/download.scm, guix/import/hackage.scm, guix/import/hexpm.scm, guix/import/opam.scm, guix/import/pypi.scm, tests/cpio.scm, tests/egg.scm, tests/opam.scm, tests/publish.scm, tests/store-database.scm, tests/utils.scm: Adjust imports accordingly. Change-Id: I3f5e94631397996a30be2ea4ff8b50a3371e8ee7 --- guix/download.scm | 2 +- guix/import/hackage.scm | 4 ++-- guix/import/hexpm.scm | 7 ++++--- guix/import/opam.scm | 7 ++++--- guix/import/pypi.scm | 5 +++-- guix/utils.scm | 17 ++++++++--------- tests/cpio.scm | 6 +++--- tests/egg.scm | 5 +++-- tests/opam.scm | 5 +++-- tests/publish.scm | 5 +++-- tests/store-database.scm | 6 +++--- tests/utils.scm | 3 ++- 12 files changed, 39 insertions(+), 33 deletions(-) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index 3dfe143e9f..192c47f113 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -31,7 +31,7 @@ (define-module (guix download) #:autoload (guix build download) (url-fetch) #:use-module (guix monads) #:use-module (guix gexp) - #:use-module (guix utils) + #:autoload (guix build utils) (call-with-temporary-output-file) #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index bbaee73a06..79a51d3300 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -8,7 +8,7 @@ ;;; Copyright © 2021 Sarah Morgensen ;;; Copyright © 2019 Simon Tournier ;;; Copyright © 2022 Hartmut Goebel -;;; Copyright © 2023 Ludovic Courtès +;;; Copyright © 2023-2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,7 +47,7 @@ (define-module (guix import hackage) #:use-module (guix upstream) #:use-module (guix packages) #:autoload (guix build-system haskell) (hackage-uri) - #:use-module ((guix utils) #:select (call-with-temporary-output-file)) + #:autoload (guix build utils) (call-with-temporary-output-file) #:export (%hackage-url hackage->guix-package hackage-recursive-import diff --git a/guix/import/hexpm.scm b/guix/import/hexpm.scm index 628a44ff24..71a54ba973 100644 --- a/guix/import/hexpm.scm +++ b/guix/import/hexpm.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Cyril Roelandt ;;; Copyright © 2016 David Craven -;;; Copyright © 2017, 2019-2021 Ludovic Courtès +;;; Copyright © 2017, 2019-2021, 2024 Ludovic Courtès ;;; Copyright © 2019 Martin Becze ;;; Copyright © 2019 Maxim Cournoyer ;;; Copyright © 2020-2022 Hartmut Goebel @@ -28,10 +28,11 @@ (define-module (guix import hexpm) #:use-module ((guix build utils) #:select ((package-name->name+version . hyphen-package-name->name+version) - dump-port)) + dump-port + call-with-temporary-output-file)) #:use-module (guix packages) #:use-module (guix upstream) - #:use-module (guix utils) + #:autoload (guix utils) (version>? file-sans-extension) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) diff --git a/guix/import/opam.scm b/guix/import/opam.scm index 86e82cde59..a7f8092507 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -31,7 +31,9 @@ (define-module (guix import opam) #:use-module ((srfi srfi-26) #:select (cut)) #:use-module (srfi srfi-34) #:use-module ((web uri) #:select (string->uri uri->string)) - #:use-module ((guix build utils) #:select (dump-port find-files mkdir-p)) + #:use-module ((guix build utils) + #:select (dump-port find-files mkdir-p + call-with-temporary-output-file)) #:use-module (guix build-system) #:use-module (guix i18n) #:use-module (guix diagnostics) @@ -39,8 +41,7 @@ (define-module (guix import opam) #:use-module (guix packages) #:use-module (guix upstream) #:use-module ((guix utils) #:select (cache-directory - version>? - call-with-temporary-output-file)) + version>?)) #:use-module ((guix import utils) #:select (beautify-description guix-hash-url recursive-import diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 1a3070fb36..6719fde330 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson ;;; Copyright © 2015 Cyril Roelandt -;;; Copyright © 2015-2017, 2019-2023 Ludovic Courtès +;;; Copyright © 2015-2017, 2019-2024 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018, 2023 Ricardo Wurmus ;;; Copyright © 2019 Maxim Cournoyer @@ -52,7 +52,8 @@ (define-module (guix import pypi) #:select ((package-name->name+version . hyphen-package-name->name+version) find-files - invoke)) + invoke + call-with-temporary-output-file)) #:use-module (guix import utils) #:use-module (guix import json) #:use-module (json) diff --git a/guix/utils.scm b/guix/utils.scm index 29ad09d9f7..d8ce6ed886 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès +;;; Copyright © 2012-2022, 2024 Ludovic Courtès ;;; Copyright © 2013, 2014, 2015 Mark H Weaver ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2014 Ian Denhardt @@ -47,11 +47,12 @@ (define-module (guix utils) #:use-module (rnrs io ports) ;need 'port-position' etc. #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) #:use-module (guix memoization) - #:use-module ((guix build utils) - #:select (dump-port mkdir-p delete-file-recursively - call-with-temporary-output-file %xz-parallel-args)) - #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) - #:use-module ((guix combinators) #:select (fold2)) + #:autoload (guix build utils) (dump-port + mkdir-p + delete-file-recursively + %xz-parallel-args) + #:autoload (guix build syscalls) (mkdtemp! fdatasync) + #:autoload (guix combinators) (fold2) #:use-module (guix diagnostics) ;, &error-location, etc. #:use-module (ice-9 format) #:use-module ((ice-9 iconv) #:prefix iconv:) @@ -76,9 +77,7 @@ (define-module (guix utils) &fix-hint fix-hint? - condition-fix-hint - - call-with-temporary-output-file) + condition-fix-hint) #:export (strip-keyword-arguments default-keyword-arguments substitute-keyword-arguments diff --git a/tests/cpio.scm b/tests/cpio.scm index 832101d1bb..35a704822b 100644 --- a/tests/cpio.scm +++ b/tests/cpio.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2022 Ludovic Courtès +;;; Copyright © 2015, 2022, 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,8 +19,8 @@ (define-module (test-cpio) #:use-module (guix cpio) #:use-module (guix tests) - #:use-module ((guix build utils) #:select (which)) - #:use-module ((guix utils) #:select (call-with-temporary-output-file)) + #:use-module ((guix build utils) + #:select (which call-with-temporary-output-file)) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (rnrs io ports) diff --git a/tests/egg.scm b/tests/egg.scm index a7d3378dd7..c74f954683 100644 --- a/tests/egg.scm +++ b/tests/egg.scm @@ -24,8 +24,9 @@ (define-module (test-eggs) #:use-module (gcrypt hash) #:use-module (guix tests) #:use-module ((guix build syscalls) #:select (mkdtemp!)) - #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which)) - #:use-module ((guix utils) #:select (call-with-temporary-output-file)) + #:use-module ((guix build utils) + #:select (delete-file-recursively mkdir-p which + call-with-temporary-output-file)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) #:use-module (web uri) diff --git a/tests/opam.scm b/tests/opam.scm index 832fea1d9b..f444ef302e 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -24,8 +24,9 @@ (define-module (test-opam) #:use-module (gcrypt hash) #:use-module (guix tests) #:use-module ((guix build syscalls) #:select (mkdtemp!)) - #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which)) - #:use-module ((guix utils) #:select (call-with-temporary-output-file)) + #:use-module ((guix build utils) + #:select (delete-file-recursively mkdir-p which + call-with-temporary-output-file)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) #:use-module (web uri) diff --git a/tests/publish.scm b/tests/publish.scm index efb5698bed..d5ec3c954f 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2020 by Amar M. Singh -;;; Copyright © 2016-2022 Ludovic Courtès +;;; Copyright © 2016-2022, 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,7 +25,8 @@ (define-module (test-publish) #:use-module (guix scripts publish) #:use-module (guix tests) #:use-module (guix config) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module ((guix build utils) #:select (call-with-temporary-output-file)) #:use-module (gcrypt hash) #:use-module (guix store) #:use-module (guix derivations) diff --git a/tests/store-database.scm b/tests/store-database.scm index 67d464386d..177c776b6c 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018, 2020, 2021 Ludovic Courtès +;;; Copyright © 2017-2018, 2020-2021, 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,9 +21,9 @@ (define-module (test-store-database) #:use-module (guix store) #:use-module (guix store database) #:use-module (guix build store-copy) - #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:use-module ((guix build utils) - #:select (mkdir-p delete-file-recursively)) + #:select (mkdir-p delete-file-recursively + call-with-temporary-output-file)) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64)) diff --git a/tests/utils.scm b/tests/utils.scm index 52f3b58ede..462e43e2b1 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2012-2021, 2024 Ludovic Courtès ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016 Mathieu Lirzin ;;; Copyright © 2021 Simon Tournier @@ -25,6 +25,7 @@ (define-module (test-utils) #:use-module ((guix config) #:select (%gzip)) #:use-module (guix utils) + #:use-module ((guix build utils) #:select (call-with-temporary-output-file)) #:use-module ((guix store) #:select (%store-prefix store-path-package-name)) #:use-module ((guix search-paths) #:select (string-tokenize*)) #:use-module (srfi srfi-1) -- cgit v1.2.3 From 44de6d3990ee36c54fb0209bfae4fcdf6a392b15 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 1 Apr 2024 15:55:05 +0200 Subject: guix: Delay loading of (gnutls). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (web …) modules pull in (gnutls) indirectly. Arrange to load them lazily, thereby reducing I/O and allocations when GnuTLS is not needed such as when running ‘guix describe’ or ‘guix shell’ on a cache hit. * guix/download.scm: Autoload (web uri). * guix/scripts/describe.scm: Likewise. * guix/store.scm: Likewise. (%default-substitute-urls): Remove ‘resolve-interface’ call and use https URLs unconditionally. Change-Id: Ide470c556a14866e8740966d25821df487a79859 --- guix/download.scm | 2 +- guix/scripts/describe.scm | 4 ++-- guix/store.scm | 16 +++++++++------- 3 files changed, 12 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index 192c47f113..b251e1f6c0 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -32,7 +32,7 @@ (define-module (guix download) #:use-module (guix monads) #:use-module (guix gexp) #:autoload (guix build utils) (call-with-temporary-output-file) - #:use-module (web uri) + #:autoload (web uri) (string->uri uri-scheme uri-path) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%download-methods diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index 449ab4b252..70ae84e9f6 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019, 2020, 2021, 2023 Ludovic Courtès +;;; Copyright © 2018, 2019, 2020, 2021, 2023, 2024 Ludovic Courtès ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2020 Ekaitz Zarraga ;;; Copyright © 2021 Simon Tournier @@ -37,7 +37,7 @@ (define-module (guix scripts describe) #:use-module (ice-9 match) #:use-module (ice-9 format) #:autoload (ice-9 pretty-print) (pretty-print) - #:use-module (web uri) + #:autoload (web uri) (string->uri uri-host) #:export (display-profile-content channel-commit-hyperlink diff --git a/guix/store.scm b/guix/store.scm index 1229198b09..5e398743cb 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2023 Ludovic Courtès +;;; Copyright © 2012-2024 Ludovic Courtès ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; Copyright © 2019, 2020 Mathieu Othacehe ;;; Copyright © 2020 Florian Pelz @@ -49,7 +49,12 @@ (define-module (guix store) #:use-module (ice-9 popen) #:autoload (ice-9 threads) (current-processor-count) #:use-module (ice-9 format) - #:use-module (web uri) + #:autoload (web uri) (uri? + string->uri + uri-scheme + uri-host + uri-port + uri-path) #:export (%daemon-socket-uri %gc-roots-directory %default-substitute-urls @@ -764,11 +769,8 @@ (define %default-substitute-urls ;; Default list of substituters. This is *not* the list baked in ;; 'guix-daemon', but it is used by 'guix-service-type' and and a couple of ;; clients ('guix build --log-file' uses it.) - (map (if (false-if-exception (resolve-interface '(gnutls))) - (cut string-append "https://" <>) - (cut string-append "http://" <>)) - '("bordeaux.guix.gnu.org" - "ci.guix.gnu.org"))) + '("https://bordeaux.guix.gnu.org" + "https://ci.guix.gnu.org")) (define (current-user-name) "Return the name of the calling user." -- cgit v1.2.3 From 657107cb90708aae8adadcba047b6e7eaf6b4cef Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 1 Apr 2024 16:19:17 +0200 Subject: ui: Delay use of (guix build syscalls). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This ensures (guix build syscalls) is loaded only when needed. * guix/ui.scm (%text-width): Unconditionally alias ‘*line-width*’. Remove initialization. : Remove code for Guile < 2.2.7. (package->recutils): Change default #:width to (terminal-columns). Change-Id: I990a1b5b0f20a6243e47e314d1d3d4f8298b7151 --- guix/ui.scm | 22 ++++------------------ 1 file changed, 4 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 34ff210930..d82fa533cc 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -1473,23 +1473,9 @@ (define (maybe-break chr result) ;;; (define %text-width - ;; '*line-width*' was introduced in Guile 2.2.7/3.0.1. On older versions of - ;; Guile, monkey-patch 'wrap*' below. - (if (defined? '*line-width*) - (let ((parameter (fluid->parameter *line-width*))) - (parameter (terminal-columns)) - parameter) - (make-parameter (terminal-columns)))) - -(unless (defined? '*line-width*) ;Guile < 2.2.7 - (set! (@@ (texinfo plain-text) wrap*) - ;; XXX: Monkey patch this private procedure to let 'package->recutils' - ;; parameterize the fill of description field correctly. - (lambda strings - (let ((indent (fluid-ref (@@ (texinfo plain-text) *indent*)))) - (fill-string (string-concatenate strings) - #:line-width (%text-width) #:initial-indent indent - #:subsequent-indent indent))))) + ;; '*line-width*' was introduced in Guile 2.2.7/3.0.1. Keep this alias for + ;; backward-compatibility and for convenience. + (fluid->parameter *line-width*)) (define (texi->plain-text str) "Return a plain-text representation of texinfo fragment STR." @@ -1535,7 +1521,7 @@ (define (string->recutils str) '() str))) -(define* (package->recutils p port #:optional (width (%text-width)) +(define* (package->recutils p port #:optional (width (terminal-columns)) #:key (hyperlinks? (supports-hyperlinks? port)) (extra-fields '()) -- cgit v1.2.3 From ee975926ec25e44332545b0dd6df3288dbb1f4e8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 1 Apr 2024 17:27:01 +0200 Subject: Autoload (guix build syscalls). * guix/discovery.scm, guix/git.scm, guix/nar.scm, guix/scripts.scm, guix/scripts/build.scm: Autoload (guix build syscalls). * guix/packages.scm: Autoload (guix build utils). Change-Id: Ia7703b5f46e55fbfadff63b13c35bfe097ce2220 --- guix/discovery.scm | 4 ++-- guix/git.scm | 3 +-- guix/nar.scm | 4 ++-- guix/packages.scm | 5 ++--- guix/scripts.scm | 7 +++++-- guix/scripts/build.scm | 4 ++-- 6 files changed, 14 insertions(+), 13 deletions(-) (limited to 'guix') diff --git a/guix/discovery.scm b/guix/discovery.scm index 0edc7fd1ae..2febfcdcb7 100644 --- a/guix/discovery.scm +++ b/guix/discovery.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012-2019, 2024 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +20,7 @@ (define-module (guix discovery) #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix combinators) - #:use-module (guix build syscalls) + #:autoload (guix build syscalls) (scandir*) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:use-module (ice-9 vlist) diff --git a/guix/git.scm b/guix/git.scm index 8e1d863976..b22c8ac02a 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -33,8 +33,7 @@ (define-module (guix git) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix records) - #:use-module ((guix build syscalls) - #:select (terminal-string-width)) + #:autoload (guix build syscalls) (terminal-string-width) #:use-module (guix gexp) #:autoload (guix git-download) (git-reference-url git-reference-commit git-reference-recursive?) diff --git a/guix/nar.scm b/guix/nar.scm index cabcc4bbbf..c7842399dc 100644 --- a/guix/nar.scm +++ b/guix/nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2012-2016, 2018-2020, 2024 Ludovic Courtès ;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -19,7 +19,7 @@ (define-module (guix nar) #:use-module (guix serialization) - #:use-module (guix build syscalls) + #:autoload (guix build syscalls) (lock-file unlock-file) #:use-module ((guix build utils) #:select (delete-file-recursively with-directory-excursion)) diff --git a/guix/packages.scm b/guix/packages.scm index 930b1a3b0e..bd72b284b1 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2023 Ludovic Courtès +;;; Copyright © 2012-2024 Ludovic Courtès ;;; Copyright © 2014, 2015, 2017, 2018, 2019 Mark H Weaver ;;; Copyright © 2015 Eric Bavier ;;; Copyright © 2016 Alex Kost @@ -27,8 +27,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix packages) - #:use-module ((guix build utils) #:select (compressor tarball? - strip-store-file-name)) + #:autoload (guix build utils) (compressor tarball? strip-store-file-name) #:use-module (guix utils) #:use-module (guix records) #:use-module (guix store) diff --git a/guix/scripts.scm b/guix/scripts.scm index 5d11ce7fe9..c4849816ea 100644 --- a/guix/scripts.scm +++ b/guix/scripts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020, 2021, 2021 Ludovic Courtès +;;; Copyright © 2013-2015, 2017-2021, 2021, 2024 Ludovic Courtès ;;; Copyright © 2014 Deck Pickard ;;; Copyright © 2015, 2016 Alex Kost ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen @@ -29,7 +29,10 @@ (define-module (guix scripts) #:use-module (guix packages) #:use-module (guix derivations) #:autoload (guix describe) (current-profile-date) - #:use-module (guix build syscalls) + #:autoload (guix build syscalls) (statfs + file-system-block-size + file-system-blocks-available + file-system-block-count) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-37) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 05f022a92e..da4859eeaa 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2023 Ludovic Courtès +;;; Copyright © 2012-2024 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2020 Marius Bakke ;;; Copyright © 2020 Ricardo Wurmus @@ -45,7 +45,7 @@ (define-module (guix scripts build) #:use-module (guix platform) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix progress) #:select (current-terminal-columns)) - #:use-module ((guix build syscalls) #:select (terminal-columns)) + #:autoload (guix build syscalls) (terminal-columns) #:use-module (guix transformations) #:export (log-url -- cgit v1.2.3 From 8a74bb8030f2433155f00332475fc21191ef2952 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 1 Apr 2024 17:33:32 +0200 Subject: Autoload (gcrypt hash). * guix/derivations.scm: Autoload (guix utils) and (gcrypt hash). * guix/git.scm, guix/store.scm: Autoload (gcrypt hash). Change-Id: I6145231d41c61f2d8c36e28f29e91074910bdd15 --- guix/derivations.scm | 6 +++--- guix/git.scm | 2 +- guix/store.scm | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/derivations.scm b/guix/derivations.scm index 9fec7f4f0b..a91c1ae984 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2021, 2023 Ludovic Courtès +;;; Copyright © 2012-2021, 2023-2024 Ludovic Courtès ;;; Copyright © 2016, 2017 Mathieu Lirzin ;;; ;;; This file is part of GNU Guix. @@ -32,7 +32,7 @@ (define-module (guix derivations) #:use-module (ice-9 rdelim) #:use-module (ice-9 vlist) #:use-module (guix store) - #:use-module (guix utils) + #:autoload (guix utils) (%current-system string-replace-substring) #:use-module (guix base16) #:use-module (guix memoization) #:use-module (guix combinators) @@ -40,7 +40,7 @@ (define-module (guix derivations) #:use-module (guix diagnostics) #:use-module (guix i18n) #:use-module (guix monads) - #:use-module (gcrypt hash) + #:autoload (gcrypt hash) (sha256) #:use-module (guix sets) #:export ( derivation? diff --git a/guix/git.scm b/guix/git.scm index b22c8ac02a..d75a301f98 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -27,7 +27,7 @@ (define-module (guix git) #:use-module (guix i18n) #:use-module (guix base32) #:use-module (guix cache) - #:use-module (gcrypt hash) + #:autoload (gcrypt hash) (sha256) #:use-module ((guix build utils) #:select (mkdir-p delete-file-recursively invoke/quiet)) #:use-module (guix store) diff --git a/guix/store.scm b/guix/store.scm index 5e398743cb..a238cb627a 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -29,7 +29,7 @@ (define-module (guix store) #:use-module (guix records) #:use-module (guix base16) #:use-module (guix base32) - #:use-module (gcrypt hash) + #:autoload (gcrypt hash) (sha256) #:use-module (guix profiling) #:autoload (guix build syscalls) (terminal-columns) #:autoload (guix build utils) (dump-port) -- cgit v1.2.3 From 320f28390f12807e0e0408cb074f618cd16c8dbb Mon Sep 17 00:00:00 2001 From: Giacomo Leidi Date: Sat, 7 Oct 2023 21:45:11 +0200 Subject: import: github: Recognize more URLs. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . This allows more packages to be refreshed, such as launchmon, love, retux, preseq, edgar, antlr3, and runc. * guix/import/github.scm (updated-github-url)[updated-url]: Add additional heuristics to Github url updater. Signed-off-by: Ludovic Courtès Change-Id: I6409b3f61872a954f53480afd63b307d16d0b9c0 --- guix/import/github.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'guix') diff --git a/guix/import/github.scm b/guix/import/github.scm index 7409c9a202..c5556d78ee 100644 --- a/guix/import/github.scm +++ b/guix/import/github.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2019 Efraim Flashner ;;; Copyright © 2022 Maxime Devos ;;; Copyright © 2022 Hartmut Goebel +;;; Copyright © 2023 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +25,7 @@ (define-module (guix import github) #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -96,6 +98,11 @@ (define (updated-url url) url) (string-append prefix "/releases/download/" repo "-" new-version "/" repo "-" new-version ext)) + ((string-match (string-append "/releases/download/(v)?" version "/" + name ".*" ext "$") + url) + (string-replace-substring url version new-version)) + (#t #f))) ; Some URLs are not recognised. #f)) -- cgit v1.2.3 From 9a60894156c3ea2c609ae0cd787df949f2d6ecc2 Mon Sep 17 00:00:00 2001 From: Jean-Pierre De Jesus DIAZ Date: Thu, 29 Feb 2024 16:20:44 +0100 Subject: guix: Add xtensa-ath9k-elf platform. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Makefile.am (MODULES): Add guix/platforms/xtensa.scm. * guix/platforms/xtensa.scm (xtensa-ath9k-elf): New variable. * doc/guix.texi: Add xtensa-ath9k-elf documentation. Change-Id: I51eef245142ed58613340c16d4bf7266e6bf6adb Signed-off-by: Ludovic Courtès --- Makefile.am | 1 + doc/guix.texi | 6 ++++++ guix/platforms/xtensa.scm | 28 ++++++++++++++++++++++++++++ 3 files changed, 35 insertions(+) create mode 100644 guix/platforms/xtensa.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index 147767ece4..25b3eb3378 100644 --- a/Makefile.am +++ b/Makefile.am @@ -144,6 +144,7 @@ MODULES = \ guix/platforms/powerpc.scm \ guix/platforms/riscv.scm \ guix/platforms/x86.scm \ + guix/platforms/xtensa.scm \ guix/build-system.scm \ guix/build-system/agda.scm \ guix/build-system/android-ndk.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 6338915f91..964a262a7a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -16663,6 +16663,7 @@ The available targets are: - x86_64-linux-gnu - x86_64-linux-gnux32 - x86_64-w64-mingw32 + - xtensa-ath9k-elf @end example Targets are specified as GNU triplets (@pxref{Specifying Target @@ -46832,6 +46833,11 @@ Platform targeting OpenRISC 1000 CPU without an operating system and without a C standard library. @end defvar +@defvar xtensa-ath9k-elf +Platform targeting Xtensa CPU used in the Qualcomm Atheros AR7010 and AR9271 +USB 802.11n @acronym{NICs, Network Interface Controllers}. +@end defvar + @node System Images @chapter Creating System Images diff --git a/guix/platforms/xtensa.scm b/guix/platforms/xtensa.scm new file mode 100644 index 0000000000..304e23ab1a --- /dev/null +++ b/guix/platforms/xtensa.scm @@ -0,0 +1,28 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Foundation Devices, Inc. +;;; +;;; 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 platforms xtensa) + #:use-module (guix platform) + #:use-module (guix records) + #:export (xtensa-ath9k-elf)) + +(define xtensa-ath9k-elf + (platform + (target "xtensa-ath9k-elf") + (system #f) + (glibc-dynamic-linker #f))) -- cgit v1.2.3