diff options
Diffstat (limited to 'guix/scripts')
29 files changed, 473 insertions, 271 deletions
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 3b2bdee835..a7ff1593a6 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -18,7 +18,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix scripts archive) - #:use-module (guix config) #:use-module (guix utils) #:use-module (guix combinators) #:use-module ((guix build utils) #:select (mkdir-p)) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index b4437172d7..72a24f91ac 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2020 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net> @@ -27,7 +27,6 @@ #:use-module (guix store) #:use-module (guix derivations) #:use-module (guix packages) - #:use-module (guix memoization) #:use-module (guix utils) #:use-module (guix monads) #:use-module (guix gexp) @@ -36,10 +35,8 @@ #:autoload (guix http-client) (http-fetch http-get-error?) #:use-module (ice-9 format) #:use-module (ice-9 match) - #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #: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) @@ -377,12 +374,12 @@ use '--no-offload' instead~%"))) arg) (if closest (display-hint - (format #f (G_ "Did you mean @code{~a}? + (G_ "Did you mean @code{~a}? Try @option{--list-targets} to view available targets.~%") - closest)) + closest) (display-hint - (format #f (G_ "\ -Try @option{--list-targets} to view available targets.~%")))) + (G_ "\ +Try @option{--list-targets} to view available targets.~%"))) (exit 1)))))))) (define %standard-native-build-options @@ -404,12 +401,12 @@ Try @option{--list-targets} to view available targets.~%")))) arg) (if closest (display-hint - (format #f (G_ "Did you mean @code{~a}? + (G_ "Did you mean @code{~a}? Try @option{--list-systems} to view available system types.~%") - closest)) + closest) (display-hint - (format #f (G_ "\ -Try @option{--list-systems} to view available system types.~%")))) + (G_ "\ +Try @option{--list-systems} to view available system types.~%"))) (exit 1)))))))) diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index 620a1762a1..4821e11bf6 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -24,7 +24,6 @@ #:use-module (guix utils) #:use-module (guix monads) #:use-module (guix base32) - #:use-module (guix packages) #:use-module ((guix progress) #:hide (dump-port*)) #:use-module (guix serialization) #:use-module (guix substitutes) diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index ef6f9acc86..14ce736174 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -26,7 +26,6 @@ #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix ui) - #:use-module (guix utils) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix diagnostics) #:use-module (guix i18n) diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index 80cd0ce00a..5523aa0ec2 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019, 2020, 2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Ekaitz Zarraga <ekaitz@elenq.tech> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> @@ -154,10 +154,10 @@ within a Git checkout." (channel (repository->guix-channel (dirname program)))) (unless channel (report-error (G_ "failed to determine origin~%")) - (display-hint (format #f (G_ "Perhaps this + (display-hint (G_ "Perhaps this @command{guix} command was not obtained with @command{guix pull}? Its version string is ~a.~%") - %guix-version)) + %guix-version) (exit 1)) (match fmt diff --git a/guix/scripts/discover.scm b/guix/scripts/discover.scm index dadade81bb..8970f835c9 100644 --- a/guix/scripts/discover.scm +++ b/guix/scripts/discover.scm @@ -23,7 +23,6 @@ #:use-module (guix scripts) #:use-module (guix ui) #:use-module (guix utils) - #:use-module (guix build syscalls) #:use-module (guix build utils) #:use-module (guix scripts publish) #:use-module (avahi) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 5a91390358..0ab5c8c39c 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -35,11 +35,8 @@ #:use-module (web uri) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-14) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) - #:use-module (rnrs bytevectors) - #:use-module (ice-9 binary-ports) #:export (guix-download)) diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index 8e777d1405..5ce2870c5a 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -22,7 +22,8 @@ #:use-module (guix ui) #:use-module (guix scripts) #:use-module ((guix scripts build) #:select (%standard-build-options)) - #:use-module (guix utils) + #:use-module ((guix diagnostics) + #:select (location-file location-line)) #:use-module (gnu packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-37) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 46435ae48e..a4939ea63c 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -514,6 +514,11 @@ by running 'set' in the shell." (catch #t (lambda () (load-profile profile manifest #:pure? #t) + + ;; Mark the terminal as "unknown" do avoid ANSI escape codes such + ;; as bracketed paste that would mess up the output of the script. + (setenv "TERM" "") + (setenv "GUIX_ENVIRONMENT" profile) (close-fdes controller) (login-tty inferior) @@ -664,8 +669,8 @@ command name." (let ((closest (string-closest executable available #:threshold 12))) (unless (or (not closest) (string=? closest executable)) - (display-hint (format #f (G_ "Did you mean '~a'?~%") - closest))))))))) + (display-hint (G_ "Did you mean '~a'?~%") + closest)))))))) (define* (launch-environment/fork command profile manifest #:key pure? (white-list '())) @@ -767,14 +772,17 @@ WHILE-LIST." (append (override-user-mappings user home - (append user-mappings - ;; Share current working directory, unless asked not to. - (if map-cwd? - (list (file-system-mapping - (source cwd) - (target cwd) - (writable? #t))) - '()))) + (append + ;; Share current working directory, unless asked not to. + (if map-cwd? + (list (file-system-mapping + (source cwd) + (target cwd) + (writable? #t))) + '()) + ;; Add the user mappings *after* the current working directory + ;; so that a user can layer bind mounts on top of it. + user-mappings)) ;; Mappings for the union closure of all inputs. (map (lambda (dir) (file-system-mapping diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 6847dd1962..c075e0ec29 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -20,7 +20,6 @@ (define-module (guix scripts graph) #:use-module (guix ui) #:use-module (guix graph) - #:use-module (guix grafts) #:use-module (guix scripts) #:use-module (guix packages) #:use-module (guix monads) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index 4e792c6a03..6dc67a2416 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -23,18 +23,14 @@ (define-module (guix scripts hash) #:use-module (gcrypt hash) - #:use-module (guix serialization) #:use-module (guix ui) #:use-module (guix hash) #:use-module (guix scripts) #:use-module (guix base16) #:use-module (guix base32) #:autoload (guix base64) (base64-encode) - #:use-module (ice-9 binary-ports) - #:use-module (rnrs files) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:autoload (disarchive git-hash) (git-hash-file git-hash-directory) diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index 1d8aae727e..954bb0045f 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> +;;; Copyright © 2021, 2023 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Pierre Langlois <pierre.langlois@gmx.com> ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> @@ -22,9 +22,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix scripts home) - #:use-module (gnu packages admin) #:use-module ((gnu services) #:hide (delete)) - #:use-module (gnu packages) #:autoload (gnu packages base) (coreutils) #:autoload (gnu packages bash) (bash) #:autoload (gnu packages gnupg) (guile-gcrypt) @@ -409,6 +407,7 @@ immediately. Return the exit status of the process in the container." network?) "Perform ACTION for home environment. " + (ensure-profile-directory) (define println (cut format #t "~a~%" <>)) @@ -473,7 +472,6 @@ ACTION must be one of the sub-commands that takes a home environment declaration as an argument (a file name.) OPTS is the raw alist of options resulting from command-line parsing." (define (ensure-home-environment file-or-exp obj) - (ensure-profile-directory) (unless (home-environment? obj) (leave (G_ "'~a' does not return a home environment~%") file-or-exp)) @@ -572,10 +570,10 @@ argument list and OPTS is the option alist." (cut import-manifest manifest destination <>)) (info (G_ "'~a' populated with all the Home configuration files~%") destination) - (display-hint (format #f (G_ "\ + (display-hint (G_ "\ Run @command{guix home reconfigure ~a/home-configuration.scm} to effectively deploy the home environment described by these files.\n") - destination)))) + destination))) ((describe) (let ((list-installed-regex (assoc-ref opts 'list-installed))) (match (generation-number %guix-home) diff --git a/guix/scripts/home/edit.scm b/guix/scripts/home/edit.scm index a6c05675b3..d039179a10 100644 --- a/guix/scripts/home/edit.scm +++ b/guix/scripts/home/edit.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,8 +40,8 @@ '())) (closest (string-closest type available))) (unless (or (not closest) (string=? closest type)) - (display-hint (format #f (G_ "Did you mean @code{~a}?~%") - closest)))) + (display-hint (G_ "Did you mean @code{~a}?~%") + closest))) (exit 1)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 2bca927d63..f84a964a53 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2014, 2020-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2014, 2020-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2019, 2022 Ricardo Wurmus <rekado@elephly.net> @@ -28,9 +28,6 @@ #:use-module (guix read-print) #:use-module (guix utils) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (srfi srfi-37) #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (%standard-import-options @@ -106,6 +103,5 @@ Run IMPORTER with ARGS.\n")) (let ((hint (string-closest importer importers #:threshold 3))) (report-error (G_ "~a: invalid importer~%") importer) (when hint - (display-hint - (format #f (G_ "Did you mean @code{~a}?~%") hint))) + (display-hint (G_ "Did you mean @code{~a}?~%") hint)) (exit 1)))))) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 578b3b9888..7b76126d35 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -39,7 +39,6 @@ #:autoload (guix derivations) (read-derivation-from-file derivation-file-name build-derivations) - #:autoload (guix serialization) (nar-error? nar-error-file) #:autoload (guix nar) (restore-file-set) #:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix build syscalls) @@ -220,7 +219,12 @@ number of seconds after which the connection times out." (session (make-session #:user (build-machine-user machine) #:host (build-machine-name machine) #:port (build-machine-port machine) - #:timeout 10 ;initial timeout (seconds) + ;; Multiple derivations may be offloaded in + ;; parallel, and when there is a large amount + ;; of data to be sent, it can choke lower + ;; bandwidth connections and cause timeouts, so + ;; set it to a large enough value. + #:timeout 30 ;initial timeout (seconds) ;; #:log-verbosity 'protocol #:identity (build-machine-private-key machine) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index f65642fb85..0dc9979194 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1,11 +1,11 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2017-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> -;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Eric Bavier <bavier@posteo.net> ;;; Copyright © 2022 Alex Griffin <a@ajgrf.com> ;;; @@ -28,7 +28,6 @@ #:use-module (guix scripts) #:use-module (guix ui) #:use-module (guix gexp) - #:use-module ((guix build utils) #:select (%xz-parallel-args)) #:use-module (guix utils) #:use-module (guix store) #:use-module ((guix status) #:select (with-status-verbosity)) @@ -54,7 +53,6 @@ #:use-module ((gnu packages compression) #:hide (zip)) #:use-module (gnu packages guile) #:use-module (gnu packages base) - #:autoload (gnu packages package-management) (guix) #:autoload (gnu packages gnupg) (guile-gcrypt) #:autoload (gnu packages guile) (guile2.0-json guile-json) #:use-module (srfi srfi-1) @@ -67,6 +65,7 @@ self-contained-tarball debian-archive + rpm-archive docker-image squashfs-image @@ -194,104 +193,150 @@ target the profile's @file{bin/env} file: (leave (G_ "~a: invalid symlink specification~%") arg)))) - -;;; -;;; Tarball format. -;;; -(define* (self-contained-tarball/builder profile - #:key (profile-name "guix-profile") - (compressor (first %compressors)) - localstatedir? - (symlinks '()) - (archiver tar) - (extra-options '())) - "Return the G-Expression of the builder used for self-contained-tarball." +(define (set-utf8-locale profile) + "Configure the environment to use the \"en_US.utf8\" locale provided by the +GLIBC-UT8-LOCALES package." + ;; Arrange to not depend on 'glibc-utf8-locales' when using '--bootstrap'. + (and (or (not (profile? profile)) + (profile-locales? profile)) + #~(begin + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales "/lib/locale")) + (setlocale LC_ALL "en_US.utf8")))) + +(define* (populate-profile-root profile + #:key (profile-name "guix-profile") + target + localstatedir? + deduplicate? + (symlinks '())) + "Populate the root profile directory with SYMLINKS and a Guix database, when +LOCALSTATEDIR? is set. When DEDUPLICATE? is true, deduplicate the store +items, which relies on hard links." (define database (and localstatedir? (file-append (store-database (list profile)) "/db/db.sqlite"))) - (define set-utf8-locale - ;; Arrange to not depend on 'glibc-utf8-locales' when using '--bootstrap'. - (and (or (not (profile? profile)) - (profile-locales? profile)) - #~(begin - (setenv "GUIX_LOCPATH" - #+(file-append glibc-utf8-locales "/lib/locale")) - (setlocale LC_ALL "en_US.utf8")))) + (define bootstrap? + ;; Whether a '--bootstrap' environment is needed, for testing purposes. + ;; XXX: Infer that from available info. + (and (not database) (not (profile-locales? profile)))) (define (import-module? module) ;; Since we don't use deduplication support in 'populate-store', don't ;; import (guix store deduplication) and its dependencies, which includes - ;; Guile-Gcrypt. That way we can run tests with '--bootstrap'. + ;; Guile-Gcrypt, unless DEDUPLICATE? is #t. This makes it possible to run + ;; tests with '--bootstrap'. (and (not-config? module) - (not (equal? '(guix store deduplication) module)))) + (or deduplicate? (not (equal? '(guix store deduplication) module))))) - (with-imported-modules (source-module-closure - `((guix build pack) - (guix build store-copy) - (guix build utils) - (guix build union) - (gnu build install)) - #:select? import-module?) - #~(begin - (use-modules (guix build pack) - (guix build store-copy) - (guix build utils) - ((guix build union) #:select (relative-file-name)) - (gnu build install) - (srfi srfi-1) - (srfi srfi-26) - (ice-9 match)) + (computed-file "profile-directory" + (with-imported-modules (source-module-closure + `((guix build pack) + (guix build store-copy) + (guix build utils) + (guix build union) + (gnu build install)) + #:select? import-module?) + #~(begin + (use-modules (guix build pack) + (guix build store-copy) + (guix build utils) + ((guix build union) #:select (relative-file-name)) + (gnu build install) + (srfi srfi-1) + (srfi srfi-26) + (ice-9 match)) + + (define symlink->directives + ;; Return "populate directives" to make the given symlink and its + ;; parent directories. + (match-lambda + ((source '-> target) + (let ((target (string-append #$profile "/" target)) + (parent (dirname source))) + ;; Never add a 'directory' directive for "/" so as to + ;; preserve its ownership when extracting the archive (see + ;; below), and also because this would lead to adding the + ;; same entries twice in the tarball. + `(,@(if (string=? parent "/") + '() + `((directory ,parent))) + ;; Use a relative file name for compatibility with + ;; relocatable packs. + (,source -> ,(relative-file-name parent target))))))) + + (define directives + ;; Fully-qualified symlinks. + (append-map symlink->directives '#$symlinks)) - (define %root "root") + ;; Make sure non-ASCII file names are properly handled. + #+(set-utf8-locale profile) - (define symlink->directives - ;; Return "populate directives" to make the given symlink and its - ;; parent directories. - (match-lambda - ((source '-> target) - (let ((target (string-append #$profile "/" target)) - (parent (dirname source))) - ;; Never add a 'directory' directive for "/" so as to - ;; preserve its ownership when extracting the archive (see - ;; below), and also because this would lead to adding the - ;; same entries twice in the tarball. - `(,@(if (string=? parent "/") - '() - `((directory ,parent))) - ;; Use a relative file name for compatibility with - ;; relocatable packs. - (,source -> ,(relative-file-name parent target))))))) + ;; Note: there is not much to gain here with deduplication and there + ;; is the overhead of the '.links' directory, so turn it off by + ;; default. Furthermore GNU tar < 1.30 sometimes fails to extract + ;; tarballs with hard links: + ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>. + (populate-store (list "profile") #$output + #:deduplicate? #$deduplicate?) - (define directives - ;; Fully-qualified symlinks. - (append-map symlink->directives '#$symlinks)) + (when #+localstatedir? + (install-database-and-gc-roots #$output #+database #$profile + #:profile-name #$profile-name)) + + ;; Create SYMLINKS. + (for-each (cut evaluate-populate-directive <> #$output) + directives))) + #:local-build? #f + #:guile (if bootstrap? %bootstrap-guile (default-guile)) + #:options (list #:references-graphs `(("profile" ,profile)) + #:target target))) + + +;;; +;;; Tarball format. +;;; +(define* (self-contained-tarball/builder profile + #:key (profile-name "guix-profile") + target + localstatedir? + deduplicate? + symlinks + compressor + archiver) + "Return a GEXP that can build a self-contained tarball." + + (define root (populate-profile-root profile + #:profile-name profile-name + #:target target + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks)) + + (with-imported-modules (source-module-closure '((guix build pack) + (guix build utils))) + #~(begin + (use-modules (guix build pack) + (guix build utils)) ;; Make sure non-ASCII file names are properly handled. - #+set-utf8-locale + #+(set-utf8-locale profile) (define tar #+(file-append archiver "/bin/tar")) - ;; Note: there is not much to gain here with deduplication and there - ;; is the overhead of the '.links' directory, so turn it off. - ;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs - ;; with hard links: - ;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>. - (populate-store (list "profile") %root #:deduplicate? #f) + (define %root (if #$localstatedir? "." #$root)) - (when #+localstatedir? - (install-database-and-gc-roots %root #+database #$profile - #:profile-name #$profile-name)) + (when #$localstatedir? + ;; Fix the permission of the Guix database file, which was made + ;; read-only when copied to the store in populate-profile-root. + (copy-recursively #$root %root) + (chmod (string-append %root "/var/guix/db/db.sqlite") #o644)) - ;; Create SYMLINKS. - (for-each (cut evaluate-populate-directive <> %root) - directives) - - ;; Create the tarball. (with-directory-excursion %root ;; GNU Tar recurses directories by default. Simply add the whole - ;; current directory, which contains all the generated files so far. + ;; current directory, which contains all the files to be archived. ;; This avoids creating duplicate files in the archives that would ;; be stored as hard links by GNU Tar. (apply invoke tar "-cvf" #$output "." @@ -320,17 +365,16 @@ added to the pack." (warning (G_ "entry point not supported in the '~a' format~%") 'tarball)) - (gexp->derivation - (string-append name ".tar" - (compressor-extension compressor)) - (self-contained-tarball/builder profile - #:profile-name profile-name - #:compressor compressor - #:localstatedir? localstatedir? - #:symlinks symlinks - #:archiver archiver) - #:target target - #:references-graphs `(("profile" ,profile)))) + (gexp->derivation (string-append name ".tar" + (compressor-extension compressor)) + (self-contained-tarball/builder profile + #:profile-name profile-name + #:target target + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks + #:compressor compressor + #:archiver archiver))) ;;; @@ -676,18 +720,19 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors))) 'deb)) (define data-tarball - (computed-file (string-append "data.tar" - (compressor-extension compressor)) - (self-contained-tarball/builder - profile - #:profile-name profile-name - #:compressor compressor - #:localstatedir? localstatedir? - #:symlinks symlinks - #:archiver archiver) - #:local-build? #f ;allow offloading - #:options (list #:references-graphs `(("profile" ,profile)) - #:target target))) + (computed-file (string-append "data.tar" (compressor-extension + compressor)) + (self-contained-tarball/builder profile + #:target target + #:profile-name profile-name + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks + #:compressor compressor + #:archiver archiver) + #:local-build? #f ;allow offloading + #:options (list #:references-graphs `(("profile" ,profile)) + #:target target))) (define build (with-extensions (list guile-gcrypt) @@ -702,6 +747,7 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors))) (guix build utils) (guix profiles) (ice-9 match) + (ice-9 optargs) (srfi srfi-1)) (define machine-type @@ -762,32 +808,23 @@ Valid compressors are: ~a~%") compressor-name %valid-compressors))) (copy-file #+data-tarball data-tarball-file-name) - (define (keyword-ref lst keyword) - (match (memq keyword lst) - ((_ value . _) value) - (#f #f))) - ;; Generate the control archive. - (define control-file - (keyword-ref '#$extra-options #:control-file)) - - (define postinst-file - (keyword-ref '#$extra-options #:postinst-file)) - - (define triggers-file - (keyword-ref '#$extra-options #:triggers-file)) + (let-keywords '#$extra-options #f + ((control-file #f) + (postinst-file #f) + (triggers-file #f)) - (define control-tarball-file-name - (string-append "control.tar" - #$(compressor-extension compressor))) + (define control-tarball-file-name + (string-append "control.tar" + #$(compressor-extension compressor))) - ;; Write the compressed control tarball. Only the control file is - ;; mandatory (see: 'man deb' and 'man deb-control'). - (if control-file - (copy-file control-file "control") - (call-with-output-file "control" - (lambda (port) - (format port "\ + ;; Write the compressed control tarball. Only the control file is + ;; mandatory (see: 'man deb' and 'man deb-control'). + (if control-file + (copy-file control-file "control") + (call-with-output-file "control" + (lambda (port) + (format port "\ Package: ~a Version: ~a Description: Debian archive generated by GNU Guix. @@ -797,36 +834,196 @@ Priority: optional Section: misc ~%" package-name package-version architecture)))) - (when postinst-file - (copy-file postinst-file "postinst") - (chmod "postinst" #o755)) + (when postinst-file + (copy-file postinst-file "postinst") + (chmod "postinst" #o755)) - (when triggers-file - (copy-file triggers-file "triggers")) + (when triggers-file + (copy-file triggers-file "triggers")) - (define tar (string-append #+archiver "/bin/tar")) + (define tar (string-append #+archiver "/bin/tar")) - (apply invoke tar - `(,@(tar-base-options - #:tar tar - #:compressor #+(and=> compressor compressor-command)) - "-cvf" ,control-tarball-file-name - "control" - ,@(if postinst-file '("postinst") '()) - ,@(if triggers-file '("triggers") '()))) + (apply invoke tar + `(,@(tar-base-options + #:tar tar + #:compressor #+(and=> compressor compressor-command)) + "-cvf" ,control-tarball-file-name + "control" + ,@(if postinst-file '("postinst") '()) + ,@(if triggers-file '("triggers") '()))) - ;; Create the .deb archive using GNU ar. - (invoke (string-append #+binutils "/bin/ar") "-rv" #$output - "debian-binary" - control-tarball-file-name data-tarball-file-name))))) + ;; Create the .deb archive using GNU ar. + (invoke (string-append #+binutils "/bin/ar") "-rv" #$output + "debian-binary" + control-tarball-file-name data-tarball-file-name)))))) - (gexp->derivation (string-append name ".deb") - build - #:target target - #:references-graphs `(("profile" ,profile)))) + (gexp->derivation (string-append name ".deb") build)) ;;; +;;; RPM archive format. +;;; +(define* (rpm-archive name profile + #:key target + (profile-name "guix-profile") + entry-point + (compressor (first %compressors)) + deduplicate? + localstatedir? + (symlinks '()) + archiver + (extra-options '())) + "Return a RPM archive (.rpm) containing a store initialized with the closure +of PROFILE, a derivation. The archive contains /gnu/store. SYMLINKS must be +a list of (SOURCE -> TARGET) tuples denoting symlinks to be added to the pack. +ARCHIVER and ENTRY-POINT are not used. RELOCATABLE?, PREIN-FILE, POSTIN-FILE, +PREUN-FILE and POSTUN-FILE can be provided via EXTRA-OPTIONS." + (when entry-point + (warning (G_ "entry point not supported in the '~a' format~%") 'rpm)) + + (define root (populate-profile-root profile + #:profile-name profile-name + #:target target + #:localstatedir? localstatedir? + #:deduplicate? deduplicate? + #:symlinks symlinks)) + + (define payload + (let* ((raw-cpio-file-name "payload.cpio") + (compressed-cpio-file-name (string-append raw-cpio-file-name + (compressor-extension + compressor)))) + (computed-file compressed-cpio-file-name + (with-imported-modules (source-module-closure + '((guix build utils) + (guix cpio) + (guix rpm))) + #~(begin + (use-modules (guix build utils) + (guix cpio) + (guix rpm) + (srfi srfi-1)) + + ;; Make sure non-ASCII file names are properly handled. + #+(set-utf8-locale profile) + + (define %root (if #$localstatedir? "." #$root)) + + (when #$localstatedir? + ;; Fix the permission of the Guix database file, which was made + ;; read-only when copied to the store in populate-profile-root. + (copy-recursively #$root %root) + (chmod (string-append %root "/var/guix/db/db.sqlite") #o644)) + + (call-with-output-file #$raw-cpio-file-name + (lambda (port) + (with-directory-excursion %root + ;; The first "." entry is discarded. + (write-cpio-archive + (remove fhs-directory? + (cdr (find-files "." #:directories? #t))) + port)))) + (when #+(compressor-command compressor) + (apply invoke (append #+(compressor-command compressor) + (list #$raw-cpio-file-name)))) + (copy-file #$compressed-cpio-file-name #$output))) + #:local-build? #f))) ;allow offloading + + (define build + (with-extensions (list guile-gcrypt) + (with-imported-modules `(((guix config) => ,(make-config.scm)) + ,@(source-module-closure + `((gcrypt hash) + (guix build utils) + (guix profiles) + (guix rpm)) + #:select? not-config?)) + #~(begin + (use-modules (gcrypt hash) + (guix build utils) + (guix profiles) + (guix rpm) + (ice-9 binary-ports) + (ice-9 match) ;for manifest->friendly-name + (ice-9 optargs) + (rnrs bytevectors) + (srfi srfi-1)) + + ;; Make sure non-ASCII file names are properly handled. + #+(set-utf8-locale profile) + + (define machine-type + (and=> (or #$target %host-type) + (lambda (triplet) + (first (string-split triplet #\-))))) + + #$(procedure-source manifest->friendly-name) + + (define manifest (profile-manifest #$profile)) + + (define single-entry ;manifest entry + (match (manifest-entries manifest) + ((entry) + entry) + (_ #f))) + + (define name + (or (and=> single-entry manifest-entry-name) + (manifest->friendly-name manifest))) + + (define version + (or (and=> single-entry manifest-entry-version) "0.0.0")) + + (define lead + (generate-lead (string-append name "-" version) + #:target (or #$target %host-type))) + + (define payload-digest + (bytevector->hex-string (file-sha256 #$payload))) + + (let-keywords '#$extra-options #f ((relocatable? #f) + (prein-file #f) + (postin-file #f) + (preun-file #f) + (postun-file #f)) + + (let ((header (generate-header name version + payload-digest + #$root + #$(compressor-name compressor) + #:target (or #$target %host-type) + #:relocatable? relocatable? + #:prein-file prein-file + #:postin-file postin-file + #:preun-file preun-file + #:postun-file postun-file))) + + (define header-sha256 + (bytevector->hex-string (sha256 (u8-list->bytevector header)))) + + (define payload-size (stat:size (stat #$payload))) + + (define header+compressed-payload-size + (+ (length header) payload-size)) + + (define signature + (generate-signature header-sha256 + header+compressed-payload-size)) + + ;; Serialize the archive components to a file. + (call-with-input-file #$payload + (lambda (in) + (call-with-output-file #$output + (lambda (out) + (put-bytevector out (assemble-rpm-metadata lead + signature + header)) + (sendfile out in payload-size))))))))))) + + (gexp->derivation (string-append name ".rpm") build)) + + +;;; ;;; Compiling C programs. ;;; @@ -1004,12 +1201,10 @@ last resort for relocation." (utf8->string bv))))) (define (runpath file) - ;; Return the RUNPATH of FILE as a list of directories. - (let* ((bv (call-with-input-file file get-bytevector-all)) - (elf (parse-elf bv)) - (dyninfo (elf-dynamic-info elf))) - (or (and=> dyninfo elf-dynamic-info-runpath) - '()))) + ;; Return the "recursive" RUNPATH of FILE as a list of + ;; directories. + (delete-duplicates + (map dirname (file-needed/recursive file)))) (define (elf-loader-compile-flags program) ;; Return the cpp flags defining macros for the ld.so/fakechroot @@ -1158,7 +1353,8 @@ last resort for relocation." `((tarball . ,self-contained-tarball) (squashfs . ,squashfs-image) (docker . ,docker-image) - (deb . ,debian-archive))) + (deb . ,debian-archive) + (rpm . ,rpm-archive))) (define (show-formats) ;; Print the supported pack formats. @@ -1172,18 +1368,22 @@ last resort for relocation." docker Tarball ready for 'docker load'")) (display (G_ " deb Debian archive installable via dpkg/apt")) + (display (G_ " + rpm RPM archive installable via rpm/yum")) (newline)) +(define (required-option symbol) + "Return an SYMBOL option that requires a value." + (option (list (symbol->string symbol)) #t #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons symbol arg result) + rest)))) + (define %deb-format-options - (let ((required-option (lambda (symbol) - (option (list (symbol->string symbol)) #t #f - (lambda (opt name arg result . rest) - (apply values - (alist-cons symbol arg result) - rest)))))) - (list (required-option 'control-file) - (required-option 'postinst-file) - (required-option 'triggers-file)))) + (list (required-option 'control-file) + (required-option 'postinst-file) + (required-option 'triggers-file))) (define (show-deb-format-options) (display (G_ " @@ -1202,6 +1402,32 @@ last resort for relocation." (newline) (exit 0)) +(define %rpm-format-options + (list (required-option 'prein-file) + (required-option 'postin-file) + (required-option 'preun-file) + (required-option 'postun-file))) + +(define (show-rpm-format-options) + (display (G_ " + --help-rpm-format list options specific to the RPM format"))) + +(define (show-rpm-format-options/detailed) + (display (G_ " + --prein-file=FILE + Embed the provided prein script")) + (display (G_ " + --postin-file=FILE + Embed the provided postin script")) + (display (G_ " + --preun-file=FILE + Embed the provided preun script")) + (display (G_ " + --postun-file=FILE + Embed the provided postun script")) + (newline) + (exit 0)) + (define %options ;; Specifications of the command-line options. (cons* (option '(#\h "help") #f #f @@ -1278,7 +1504,12 @@ last resort for relocation." (lambda args (show-deb-format-options/detailed))) + (option '("help-rpm-format") #f #f + (lambda args + (show-rpm-format-options/detailed))) + (append %deb-format-options + %rpm-format-options %transformation-options %standard-build-options %standard-cross-build-options @@ -1296,6 +1527,7 @@ Create a bundle of PACKAGE.\n")) (show-transformation-options-help) (newline) (show-deb-format-options) + (show-rpm-format-options) (newline) (display (G_ " -f, --format=FORMAT build a pack in the given FORMAT")) @@ -1454,6 +1686,16 @@ Create a bundle of PACKAGE.\n")) (process-file-arg opts 'postinst-file) #:triggers-file (process-file-arg opts 'triggers-file))) + ('rpm + (list #:relocatable? relocatable? + #:prein-file + (process-file-arg opts 'prein-file) + #:postin-file + (process-file-arg opts 'postin-file) + #:preun-file + (process-file-arg opts 'preun-file) + #:postun-file + (process-file-arg opts 'postun-file))) (_ '()))) (target (assoc-ref opts 'target)) (bootstrap? (assoc-ref opts 'bootstrap?)) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index b9090307ac..f1eef9dfaf 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com> @@ -38,9 +38,7 @@ #:use-module (guix profiles) #:use-module (guix search-paths) #:autoload (guix import json) (json->scheme-file) - #:use-module (guix monads) #:use-module (guix utils) - #:use-module (guix config) #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (guix transformations) @@ -48,12 +46,9 @@ manifest-entry-with-provenance) #:autoload (guix channels) (channel-name channel-commit channel->code) #:autoload (guix store roots) (gc-roots user-owned?) - #:use-module ((guix build utils) - #:select (directory-exists? mkdir-p)) #:use-module (ice-9 format) #:use-module (ice-9 match) #:autoload (ice-9 pretty-print) (pretty-print) - #:use-module (ice-9 regex) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -322,7 +317,7 @@ of manifest entries, in the context of PROFILE." (settings (search-path-environment-variables entries (list profile) #:kind 'prefix))) (unless (null? settings) - (display-hint (format #f (G_ "Consider setting the necessary environment + (display-hint (G_ "Consider setting the necessary environment variables by running: @example @@ -331,7 +326,7 @@ GUIX_PROFILE=\"~a\" @end example Alternately, see @command{guix package --search-paths -p ~s}.") - profile profile))))) + profile profile)))) ;;; diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 6307ae54bb..ada81838ac 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -23,16 +23,13 @@ (define-module (guix scripts publish) #:use-module ((system repl server) #:prefix repl:) - #:use-module (ice-9 binary-ports) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 poll) - #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) #:use-module (ice-9 threads) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-19) @@ -50,7 +47,6 @@ #:use-module (guix base32) #:use-module (guix base64) #:use-module (guix config) - #:use-module (guix derivations) #:use-module (gcrypt hash) #:use-module (guix pki) #:use-module (gcrypt pk-crypto) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 7b6c58dbc3..cd2e470289 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2015, 2017-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2015, 2017-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr> ;;; @@ -30,7 +30,6 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix profiles) - #:use-module (guix gexp) #:use-module (guix memoization) #:use-module (guix monads) #:use-module (guix channels) @@ -45,7 +44,6 @@ #:autoload (gnu packages) (fold-available-packages) #:autoload (guix scripts package) (build-and-use-profile delete-matching-generations) - #:autoload (gnu packages base) (canonical-package) #:autoload (gnu packages bootstrap) (%bootstrap-guile) #:autoload (gnu packages certs) (le-certs) #:use-module (srfi srfi-1) @@ -469,9 +467,9 @@ true, display what would be built without actually building it." ;; Is the 'guix' command previously in $PATH the same as the new ;; one? If the answer is "no", then suggest 'hash guix'. (unless (member guix-command new) - (display-hint (format #f (G_ "After setting @code{PATH}, run + (display-hint (G_ "After setting @code{PATH}, run @command{hash guix} to make sure your shell refers to @file{~a}.") - (first new)))) + (first new))) (return #f)) (return #f))))) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 6498d73c2b..bc6c24967a 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -43,15 +43,12 @@ #:use-module (gnu packages) #:use-module ((gnu packages commencement) #:select (%final-inputs)) #:use-module (ice-9 match) - #:use-module (ice-9 regex) - #:use-module (ice-9 vlist) #:use-module (ice-9 format) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (srfi srfi-71) - #:use-module (ice-9 binary-ports) #:export (guix-refresh)) @@ -101,7 +98,7 @@ (option '(#\r "recursive") #f #f (lambda (opt name arg result) (alist-cons 'recursive? #t result))) - (option '("list-transitive") #f #f + (option '(#\T "list-transitive") #f #f (lambda (opt name arg result) (alist-cons 'list-transitive? #t result))) @@ -159,7 +156,7 @@ specified with `--select'.\n")) (display (G_ " -r, --recursive check the PACKAGE and its inputs for upgrades")) (display (G_ " - --list-transitive list all the packages that PACKAGE depends on")) + -T, --list-transitive list all the packages that PACKAGE depends on")) (newline) (display (G_ " --keyring=FILE use FILE as the keyring of upstream OpenPGP keys")) diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm index 787c63d48e..fd23a2b982 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -23,10 +23,8 @@ #:use-module (guix scripts) #:use-module (guix repl) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (ice-9 match) - #:use-module (rnrs bytevectors) #:autoload (guix describe) (current-profile) #:autoload (system repl repl) (start-repl) #:autoload (system repl server) @@ -211,6 +209,7 @@ call THUNK." ((guile) (save-module-excursion (lambda () + (current-profile) ;populate (%package-module-path); see above (set-user-module) ;; Do not exit repl on SIGINT. ((@@ (ice-9 top-repl) call-with-sigint) diff --git a/guix/scripts/search.scm b/guix/scripts/search.scm index 27b9da5278..307ea410b9 100644 --- a/guix/scripts/search.scm +++ b/guix/scripts/search.scm @@ -24,7 +24,6 @@ #:select (%standard-build-options)) #:use-module (guix scripts) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:export (guix-search)) diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm index 64b5c2e8e9..92bbfb04d0 100644 --- a/guix/scripts/shell.scm +++ b/guix/scripts/shell.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021-2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -305,16 +305,16 @@ Return the modified OPTS." (report-error (G_ "not loading '~a' because not authorized to do so~%") file) - (display-hint (format #f (G_ "To allow automatic loading of + (display-hint (G_ "To allow automatic loading of @file{~a} when running @command{guix shell}, you must explicitly authorize its directory, like so: @example echo ~a >> ~a @end example\n") - file - (dirname file) - (authorized-directory-file))) + file + (dirname file) + (authorized-directory-file)) (exit 1))))))) diff --git a/guix/scripts/show.scm b/guix/scripts/show.scm index c747eedd21..f6d8256951 100644 --- a/guix/scripts/show.scm +++ b/guix/scripts/show.scm @@ -23,7 +23,6 @@ #:select (%standard-build-options)) #:use-module (guix scripts) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:export (guix-show)) diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index fa7175fb16..8e89a58948 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -31,7 +31,6 @@ #:autoload (gnu packages) (specification->package fold-packages) #:use-module (guix scripts) #:use-module ((guix scripts build) #:select (%standard-build-options)) - #:use-module (guix combinators) #:use-module (guix ui) #:use-module (guix packages) #:use-module (guix utils) @@ -42,7 +41,6 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) - #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:export (guix-style)) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index fedb33019d..109b0c7900 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -26,7 +26,6 @@ #:use-module (guix store) #:use-module (guix substitutes) #:use-module (guix utils) - #:use-module (guix combinators) #:use-module (guix config) #:use-module (guix records) #:use-module (guix diagnostics) @@ -36,7 +35,6 @@ #:autoload (guix scripts discover) (read-substitute-urls) #:use-module (gcrypt hash) #:use-module (guix base32) - #:use-module (guix base64) #:use-module (guix cache) #:use-module (gcrypt pk-crypto) #:use-module (guix pki) @@ -55,10 +53,8 @@ #:use-module (ice-9 ftw) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) - #:use-module (srfi srfi-35) #:use-module (srfi srfi-71) #:use-module (web uri) #:use-module (guix http-client) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6fd915cb5e..d7163dd3eb 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com> @@ -55,20 +55,14 @@ #:autoload (guix scripts pull) (channel-commit-hyperlink) #:autoload (guix graph) (export-graph node-type graph-backend-name lookup-backend) - #:use-module (guix scripts graph) #:use-module (guix scripts system reconfigure) #:use-module (guix build utils) #:use-module (guix progress) - #:use-module ((guix build syscalls) #:select (terminal-columns)) #:use-module (gnu build image) #:use-module (gnu build install) #:autoload (gnu build file-systems) (find-partition-by-label find-partition-by-uuid) - #:autoload (gnu build linux-modules) - (device-module-aliases matching-modules) - #:use-module (gnu system linux-initrd) #:use-module (gnu image) - #:use-module (guix platform) #:use-module (gnu system) #:use-module (gnu bootloader) #:use-module (gnu system file-systems) @@ -81,7 +75,6 @@ #:use-module (gnu services shepherd) #:use-module (gnu services herd) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -633,9 +626,9 @@ any, are available. Raise an error if they're not." (G_ "device '~a' not found: ~a~%") device (strerror errno)) (unless (string-prefix? "/" device) - (display-hint (format #f (G_ "If '~a' is a file system + (display-hint (G_ "If '~a' is a file system label, write @code{(file-system-label ~s)} in your @code{device} field.") - device device))))))) + device device)))))) literal) (for-each (lambda (fs) (let ((label (file-system-label->string @@ -1417,8 +1410,7 @@ argument list and OPTS is the option alist." (let ((hint (string-closest arg actions #:threshold 3))) (report-error (G_ "~a: unknown action~%") arg) (when hint - (display-hint - (format #f (G_ "Did you mean @code{~a}?~%") hint))) + (display-hint (G_ "Did you mean @code{~a}?~%") hint)) (exit 1))))) (define (match-pair car) diff --git a/guix/scripts/system/edit.scm b/guix/scripts/system/edit.scm index d966ee0aaa..0afb071650 100644 --- a/guix/scripts/system/edit.scm +++ b/guix/scripts/system/edit.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,8 +39,8 @@ '())) (closest (string-closest type available))) (unless (or (not closest) (string=? closest type)) - (display-hint (format #f (G_ "Did you mean @code{~a}?~%") - closest)))) + (display-hint (G_ "Did you mean @code{~a}?~%") + closest))) (exit 1)) diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index 5179ea035f..d7c71ef705 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -22,7 +22,6 @@ #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix inferior) - #:use-module (guix channels) #:use-module (guix store) #:use-module (guix status) #:use-module ((guix git) |