From 5ea206a8a916ff055c1f3840e4a52ab2c123658f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 11 Feb 2019 22:47:06 +0100 Subject: status: Erase the current line upon new builds or downloads. * guix/status.scm (print-build-event): Add 'erase-current-line*' call upon 'build-started, 'substituter-started, 'download-started. --- guix/status.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'guix') diff --git a/guix/status.scm b/guix/status.scm index cd5027ef17..bddaa003db 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -506,6 +506,7 @@ addition to build events." (match event (('build-started drv . _) + (erase-current-line*) (let ((properties (derivation-properties (read-derivation-from-file drv)))) (match (assq-ref properties 'type) @@ -552,10 +553,12 @@ addition to build events." (format port (info (G_ "View build log at '~a'.")) log))) (newline port)) (('substituter-started item _ ...) + (erase-current-line*) (when (or print-log? (not (extended-build-trace-supported?))) (format port (info (G_ "substituting ~a...")) item) (newline port))) (('download-started item uri _ ...) + (erase-current-line*) (format port (info (G_ "downloading from ~a...")) uri) (newline port)) (('download-progress item uri -- cgit v1.2.3 From 70a50305c495ca96fdec3d31e7e7972cfc54f8ee Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 11 Feb 2019 22:48:24 +0100 Subject: ui: Always print the exception upon load errors. Fixes . Reported by . Previously 'display-error' could be called with the wrong number of arguments (e.g., for 'git-error' exceptions), and thus nothing at all was displayed. * guix/ui.scm (report-load-error): Check whether ARGS matches the parameters for 'display-error' and call 'print-exception' otherwise. --- guix/ui.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index f0465519b6..2fc001d2eb 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -374,9 +374,16 @@ ARGS is the list of arguments received by the 'throw' handler." (report-error (G_ "exception thrown: ~s~%") obj)) (when (fix-hint? obj) (display-hint (condition-fix-hint obj)))) - ((error args ...) + ((key args ...) (report-error (G_ "failed to load '~a':~%") file) - (apply display-error frame (current-error-port) args)))) + (match args + (((? symbol? proc) (? string? message) (args ...) . rest) + (display-error frame (current-error-port) proc message + args rest)) + (_ + ;; Some exceptions like 'git-error' do not follow Guile's convention + ;; above and need to be printed with 'print-exception'. + (print-exception (current-error-port) frame key args)))))) (define (warn-about-load-error file args) ;FIXME: factorize with ↑ "Report the failure to load FILE, a user-provided Scheme file, without -- cgit v1.2.3 From 1d8b10d00f0c242bc5ce9540737af3d3f24a05c0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 11 Feb 2019 22:51:08 +0100 Subject: git: Add an exception printer for 'git-error'. * guix/git.scm (print-git-error): New procedure. : Call 'set-exception-printer!'. --- guix/git.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index 0e3ce37e26..289537dedf 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -300,6 +300,14 @@ Log progress and checkout info to LOG-PORT." #:select? (negate dot-git?)) commit))) +(define (print-git-error port key args default-printer) + (match args + (((? git-error? error) . _) + (format port (G_ "Git error: ~a~%") + (git-error-message error))))) + +(set-exception-printer! 'git-error print-git-error) + ;;; ;;; Checkouts. -- cgit v1.2.3 From 910d0121a8b6515febf0a02e4d23c249f98c0da2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 11 Feb 2019 22:52:28 +0100 Subject: pack, vm: Fix incorrect use of 'package-transitive-propagated-inputs'. In practice the error was not triggered because 'package-transitive-propagated-inputs' currently returns the empty list for these two packages. * guix/scripts/pack.scm (gcrypt-sqlite3&co): Remove labels from the result. * gnu/system/vm.scm (gcrypt-sqlite3&co): Likewise. --- gnu/system/vm.scm | 6 ++++-- guix/scripts/pack.scm | 4 +++- 2 files changed, 7 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 088b582bcd..e09c687a04 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2016 Christopher Allan Webber ;;; Copyright © 2016, 2017 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe @@ -134,7 +134,9 @@ ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs. (append-map (lambda (package) (cons package - (package-transitive-propagated-inputs package))) + (match (package-transitive-propagated-inputs package) + (((labels packages) ...) + packages)))) (list guile-gcrypt guile-sqlite3))) (define* (expression->derivation-in-linux-vm name exp diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index b19a4ae1b1..8fce99ad17 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -104,7 +104,9 @@ found." ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs. (append-map (lambda (package) (cons package - (package-transitive-propagated-inputs package))) + (match (package-transitive-propagated-inputs package) + (((labels packages) ...) + packages)))) (list guile-gcrypt guile-sqlite3))) (define (store-database items) -- cgit v1.2.3 From 2637cfd7a4894ef2a2a7da3bb46d8815c43d7e75 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 11 Feb 2019 23:05:36 +0100 Subject: Avoid name clash with 'build' from (guix store) and (guix status). Since commit 976ef2d97887d16eab8d4eb9dad811786b04d690, (guix status) exports 'build', which clashes with 'build' from (guix store). * build-aux/run-system-tests.scm: Select 'with-status-verbosity' from (guix status). * guix/scripts/archive.scm: Likewise. * guix/scripts/build.scm: Likewise. * guix/scripts/copy.scm: Likewise. * guix/scripts/environment.scm: Likewise. * guix/scripts/pack.scm: Likewise. * guix/scripts/package.scm: Likewise. * guix/scripts/pull.scm: Likewise. * guix/scripts/system.scm: Likewise. --- build-aux/run-system-tests.scm | 2 +- guix/scripts/archive.scm | 2 +- guix/scripts/build.scm | 2 +- guix/scripts/copy.scm | 2 +- guix/scripts/environment.scm | 2 +- guix/scripts/pack.scm | 2 +- guix/scripts/package.scm | 2 +- guix/scripts/pull.scm | 2 +- guix/scripts/system.scm | 2 +- 9 files changed, 9 insertions(+), 9 deletions(-) (limited to 'guix') diff --git a/build-aux/run-system-tests.scm b/build-aux/run-system-tests.scm index fd1f6653af..18f7393d81 100644 --- a/build-aux/run-system-tests.scm +++ b/build-aux/run-system-tests.scm @@ -19,7 +19,7 @@ (define-module (run-system-tests) #:use-module (gnu tests) #:use-module (guix store) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix ui) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 950f0f41d8..d349b5d590 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -23,7 +23,7 @@ #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix serialization) #:select (restore-file)) #:use-module (guix store) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix grafts) #:use-module (guix packages) #:use-module (guix derivations) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index fb7e04904d..6b29c470fb 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -47,7 +47,7 @@ #:autoload (guix download) (download-to-store) #:autoload (guix git-download) (git-reference?) #:autoload (guix git) (git-checkout?) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix progress) #:select (current-terminal-columns)) #:use-module ((guix build syscalls) #:select (terminal-columns)) #:export (%standard-build-options diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm index be4ce4364b..ce70f2f0b3 100644 --- a/guix/scripts/copy.scm +++ b/guix/scripts/copy.scm @@ -21,7 +21,7 @@ #:use-module (guix scripts) #:use-module (guix ssh) #:use-module (guix store) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix utils) #:use-module (guix derivations) #:use-module (guix scripts build) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 116b8dcbce..3143ea9281 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -21,7 +21,7 @@ (define-module (guix scripts environment) #:use-module (guix ui) #:use-module (guix store) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix grafts) #:use-module (guix derivations) #:use-module (guix packages) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 8fce99ad17..86e15d9bab 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -26,7 +26,7 @@ #:use-module (guix gexp) #:use-module (guix utils) #:use-module (guix store) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix grafts) #:use-module (guix monads) #:use-module (guix modules) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 8a71467b52..1695250c79 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -24,7 +24,7 @@ (define-module (guix scripts package) #:use-module (guix ui) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix store) #:use-module (guix grafts) #:use-module (guix derivations) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 3320200c07..e721cb859e 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -20,7 +20,7 @@ (define-module (guix scripts pull) #:use-module (guix ui) #:use-module (guix utils) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix config) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 569b826acd..4c8d8acc8f 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -23,7 +23,7 @@ (define-module (guix scripts system) #:use-module (guix config) #:use-module (guix ui) - #:use-module (guix status) + #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix store) #:autoload (guix store database) (register-path) #:use-module (guix grafts) -- cgit v1.2.3 From 46765f82dbd541a6ab48ba84816dbcf701d8714b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Feb 2019 22:09:07 +0100 Subject: pull: Use 'fold-available-packages' for the current package list. * guix/scripts/pull.scm (display-profile-news): Use 'fold-available-packages' instead of 'fold-packages' to compute OLD. (profile-package-alist): Use 'inferior-available-packages'. --- guix/scripts/pull.scm | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index e721cb859e..a1d27406a5 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -169,11 +169,14 @@ Download and deploy the latest version of Guix.\n")) (reverse (profile-generations profile))) ((current previous _ ...) (newline) - (let ((old (fold-packages (lambda (package result) - (alist-cons (package-name package) - (package-version package) - result)) - '())) + (let ((old (fold-available-packages + (lambda* (name version result + #:key supported? deprecated? + #:allow-other-keys) + (if (and supported? (not deprecated?)) + (alist-cons name version result) + result)) + '())) (new (profile-package-alist (generation-file-name profile current)))) (display-new/upgraded-packages old new @@ -338,15 +341,10 @@ way and displaying details about the channel's source code." (define profile-package-alist (mlambda (profile) "Return a name/version alist representing the packages in PROFILE." - (fold (lambda (package lst) - (alist-cons (inferior-package-name package) - (inferior-package-version package) - lst)) - '() - (let* ((inferior (open-inferior profile)) - (packages (inferior-packages inferior))) - (close-inferior inferior) - packages)))) + (let* ((inferior (open-inferior profile)) + (packages (inferior-available-packages inferior))) + (close-inferior inferior) + packages))) (define* (display-new/upgraded-packages alist1 alist2 #:key (heading "")) -- cgit v1.2.3 From 739380542da7e434c581ec620edeb4348d6ece89 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Feb 2019 22:17:11 +0100 Subject: inferior: Add 'inferior-available-packages'. * guix/inferior.scm (inferior-available-packages): New procedure. * tests/inferior.scm ("inferior-available-packages"): New test. --- guix/inferior.scm | 26 ++++++++++++++++++++++++++ tests/inferior.scm | 22 +++++++++++++++++++++- 2 files changed, 47 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/inferior.scm b/guix/inferior.scm index 6cfa146029..027418a98d 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -61,6 +61,7 @@ inferior-object? inferior-packages + inferior-available-packages lookup-inferior-packages inferior-package? @@ -256,6 +257,31 @@ equivalent. Return #f if the inferior could not be launched." vlist-null (inferior-packages inferior))) +(define (inferior-available-packages inferior) + "Return the list of name/version pairs corresponding to the set of packages +available in INFERIOR. + +This is faster and requires less resource-intensive than calling +'inferior-packages'." + (if (inferior-eval '(defined? 'fold-available-packages) + inferior) + (inferior-eval '(fold-available-packages + (lambda* (name version result + #:key supported? deprecated? + #:allow-other-keys) + (if (and supported? (not deprecated?)) + (acons name version result) + result)) + '()) + inferior) + + ;; As a last resort, if INFERIOR is old and lacks + ;; 'fold-available-packages', fall back to 'inferior-packages'. + (map (lambda (package) + (cons (inferior-package-name package) + (inferior-package-version package))) + (inferior-packages inferior)))) + (define* (lookup-inferior-packages inferior name #:optional version) "Return the sorted list of inferior packages matching NAME in INFERIOR, with highest version numbers first. If VERSION is true, return only packages with diff --git a/tests/inferior.scm b/tests/inferior.scm index d5a894ca8f..71ebf8f59b 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,6 +89,26 @@ (close-inferior inferior) result)))) +(test-equal "inferior-available-packages" + (take (sort (fold-available-packages + (lambda* (name version result + #:key supported? deprecated? + #:allow-other-keys) + (if (and supported? (not deprecated?)) + (alist-cons name version result) + result)) + '()) + (lambda (x y) + (stringlist (lambda (package) (list (package-name package) -- cgit v1.2.3 From cf0eacceb46492515431fec6bcf25b750b7d402d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Feb 2019 22:35:28 +0100 Subject: pull: Move profile comparison to 'new/upgraded-packages'. * guix/scripts/pull.scm (new/upgraded-packages): New procedure, with code formerly in 'display-new/upgraded-packages'. (display-new/upgraded-packages): Use it. --- guix/scripts/pull.scm | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index a1d27406a5..408ff91978 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -45,6 +45,7 @@ #:select (%bootstrap-guile)) #:use-module ((gnu packages certs) #:select (le-certs)) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -346,11 +347,10 @@ way and displaying details about the channel's source code." (close-inferior inferior) packages))) -(define* (display-new/upgraded-packages alist1 alist2 - #:key (heading "")) - "Given the two package name/version alists ALIST1 and ALIST2, display the -list of new and upgraded packages going from ALIST1 to ALIST2. When ALIST1 -and ALIST2 differ, display HEADING upfront." +(define (new/upgraded-packages alist1 alist2) + "Compare ALIST1 and ALIST2, both of which are lists of package name/version +pairs, and return two values: the list of packages new in ALIST2, and the list +of packages upgraded in ALIST2." (let* ((old (fold (match-lambda* (((name . version) table) (vhash-cons name version table))) @@ -370,6 +370,14 @@ and ALIST2 differ, display HEADING upfront." (string-append name "@" new-version)))))) alist2))) + (values new upgraded))) + +(define* (display-new/upgraded-packages alist1 alist2 + #:key (heading "")) + "Given the two package name/version alists ALIST1 and ALIST2, display the +list of new and upgraded packages going from ALIST1 to ALIST2. When ALIST1 +and ALIST2 differ, display HEADING upfront." + (let-values (((new upgraded) (new/upgraded-packages alist1 alist2))) (unless (and (null? new) (null? upgraded)) (display heading)) -- cgit v1.2.3 From 201253674bca6a1bf5d45e2af46fbb5c34f060bf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Feb 2019 22:51:23 +0100 Subject: pull: Speed up the new/upgraded package computation. * guix/scripts/pull.scm (new/upgraded-packages): OLD no longer stores all the versions of each package. Remove 'vhash-fold*' call and reduce the number of 'version>?' calls when computing UPGRADED. --- guix/scripts/pull.scm | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 408ff91978..730b6a0bf2 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -353,7 +353,13 @@ pairs, and return two values: the list of packages new in ALIST2, and the list of packages upgraded in ALIST2." (let* ((old (fold (match-lambda* (((name . version) table) - (vhash-cons name version table))) + (match (vhash-assoc name table) + (#f + (vhash-cons name version table)) + ((_ . previous-version) + (if (version>? version previous-version) + (vhash-cons name version table) + table))))) vlist-null alist1)) (new (remove (match-lambda @@ -362,11 +368,10 @@ of packages upgraded in ALIST2." alist2)) (upgraded (filter-map (match-lambda ((name . new-version) - (match (vhash-fold* cons '() name old) - (() #f) - ((= (cut sort <> version>?) old-versions) - (and (version>? new-version - (first old-versions)) + (match (vhash-assoc name old) + (#f #f) + ((_ . old-version) + (and (version>? new-version old-version) (string-append name "@" new-version)))))) alist2))) -- cgit v1.2.3 From 499b166d1ce3ead61afb985053012ceb451f3beb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Feb 2019 15:27:36 +0100 Subject: guix system: Add 'delete-generations'. * guix/scripts/package.scm (delete-matching-generations): Export. * guix/scripts/system.scm (show-help): Add 'delete-generations'. (process-command): Honor it. (guix-system): Support it. * doc/guix.texi (Invoking guix system): Document it. --- doc/guix.texi | 26 ++++++++++++++++++++++++++ guix/scripts/package.scm | 1 + guix/scripts/system.scm | 17 +++++++++++++++-- 3 files changed, 42 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 2ae4f53245..6980672094 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -23038,6 +23038,32 @@ Currently, as with @command{switch-generation}, you must reboot after running this action to actually start using the preceding system generation. +@item delete-generations +@cindex deleting system generations +@cindex saving space +Delete system generations, making them candidates for garbage collection +(@pxref{Invoking guix gc}, for information on how to run the ``garbage +collector''). + +This works in the same way as @command{guix package --delete-generations} +(@pxref{Invoking guix package, @code{--delete-generations}}). With no +arguments, all system generations but the current one are deleted: + +@example +guix system delete-generations +@end example + +You can also select the generations you want to delete. The example below +deletes all the system generations that are more than two month old: + +@example +guix system delete-generations 2m +@end example + +Running this command automatically reinstalls the bootloader with an updated +list of menu entries---e.g., the ``old generations'' sub-menu in GRUB no +longer lists the generations that have been deleted. + @item build Build the derivation of the operating system, which includes all the configuration files and programs needed to boot and run the system. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 1695250c79..0e70315708 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -55,6 +55,7 @@ #:autoload (gnu packages bootstrap) (%bootstrap-guile) #:export (build-and-use-profile delete-generations + delete-matching-generations display-search-paths guix-package)) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 4c8d8acc8f..c0301eac2b 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -36,6 +36,8 @@ #:use-module (guix profiles) #:use-module (guix scripts) #:use-module (guix scripts build) + #:autoload (guix scripts package) (delete-generations + delete-matching-generations) #:use-module (guix graph) #:use-module (guix scripts graph) #:use-module (guix build utils) @@ -962,10 +964,12 @@ Some ACTIONS support additional ARGS.\n")) reconfigure switch to a new operating system configuration\n")) (display (G_ "\ roll-back switch to the previous operating system configuration\n")) + (display (G_ "\ + list-generations list the system generations\n")) (display (G_ "\ switch-generation switch to an existing operating system configuration\n")) (display (G_ "\ - list-generations list the system generations\n")) + delete-generations delete old system generations\n")) (display (G_ "\ build build the operating system without installing anything\n")) (display (G_ "\ @@ -1202,6 +1206,14 @@ argument list and OPTS is the option alist." (apply (resolve-subcommand "search") args)) ;; The following commands need to use the store, but they do not need an ;; operating system configuration file. + ((delete-generations) + (let ((pattern (match args + (() "") + ((pattern) pattern) + (x (leave (G_ "wrong number of arguments~%")))))) + (with-store store + (delete-matching-generations store %system-profile pattern) + (reinstall-bootloader store (generation-number %system-profile))))) ((switch-generation) (let ((pattern (match args ((pattern) pattern) @@ -1228,7 +1240,8 @@ argument list and OPTS is the option alist." (let ((action (string->symbol arg))) (case action ((build container vm vm-image disk-image reconfigure init - extension-graph shepherd-graph list-generations roll-back + extension-graph shepherd-graph + list-generations delete-generations roll-back switch-generation search docker-image) (alist-cons 'action action result)) (else (leave (G_ "~a: unknown action~%") action)))))) -- cgit v1.2.3 From 1e9698344dcd0f44453be7cbb384a2eefe46441f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Feb 2019 15:31:05 +0100 Subject: guix system: List old generations from newest to oldest. Previously 'guix system switch-generation' or 'delete-generations' would yield a GRUB menu where entries for old generations were in the wrong order (i.e., oldest first.) * guix/scripts/system.scm (reinstall-bootloader): Reverse the list returned by 'generation-numbers'. --- guix/scripts/system.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index c0301eac2b..d67b9f8185 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -492,7 +492,8 @@ STORE is an open connection to the store." ;; Make the specified system generation the default entry. (params (profile-boot-parameters %system-profile (list number))) - (old-generations (delv number (generation-numbers %system-profile))) + (old-generations + (delv number (reverse (generation-numbers %system-profile)))) (old-params (profile-boot-parameters %system-profile old-generations)) (entries (map boot-parameters->menu-entry params)) -- cgit v1.2.3 From ab149c6ba0d19dfd6e15f2324cf9e3d6e2944ac5 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 8 Feb 2019 10:20:53 +0000 Subject: gnu: ruby-build-system: Change extract-gemspec to always return #t. * guix/build/ruby-build-system.scm (extract-gemspec): Return #t right at the end, rather than returning # when not handling a gem archive. --- guix/build/ruby-build-system.scm | 45 ++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 22 deletions(-) (limited to 'guix') diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index 3a658e2557..cdabd829e2 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -86,28 +86,29 @@ operation is not deterministic, we replace it with `find`." "Remove the original gemspec, if present, and replace it with a new one. This avoids issues with upstream gemspecs requiring tools such as git to generate the files list." - (when (gem-archive? source) - (let ((gemspec (or (false-if-exception (first-gemspec)) - ;; Make new gemspec if one wasn't shipped. - ".gemspec"))) - - (when (file-exists? gemspec) (delete-file gemspec)) - - ;; Extract gemspec from source gem. - (let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source))) - (dynamic-wind - (const #t) - (lambda () - (call-with-output-file gemspec - (lambda (out) - ;; 'gem spec' writes to stdout, but 'gem build' only reads - ;; gemspecs from a file, so we redirect the output to a file. - (while (not (eof-object? (peek-char pipe))) - (write-char (read-char pipe) out)))) - #t) - (lambda () - (close-pipe pipe))))) - #t)) + (if (gem-archive? source) + (let ((gemspec (or (false-if-exception (first-gemspec)) + ;; Make new gemspec if one wasn't shipped. + ".gemspec"))) + + (when (file-exists? gemspec) (delete-file gemspec)) + + ;; Extract gemspec from source gem. + (let ((pipe (open-pipe* OPEN_READ "gem" "spec" "--ruby" source))) + (dynamic-wind + (const #t) + (lambda () + (call-with-output-file gemspec + (lambda (out) + ;; 'gem spec' writes to stdout, but 'gem build' only reads + ;; gemspecs from a file, so we redirect the output to a file. + (while (not (eof-object? (peek-char pipe))) + (write-char (read-char pipe) out)))) + #t) + (lambda () + (close-pipe pipe))))) + (display "extract-gemspec: skipping as source is not a gem archive\n")) + #t) (define* (build #:key source #:allow-other-keys) "Build a new gem using the gemspec from the SOURCE gem." -- cgit v1.2.3 From 9be39b4c67c733058c3b709e897a8477605f6d4a Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 8 Feb 2019 10:22:39 +0000 Subject: guix: ruby-build-system: Do gem install --verbose. This is helpful as it displays more information about what gem install is doing, especially for packages with native extensions. * guix/build/ruby-build-system.scm (install): Add --verbose to gem install command. --- guix/build/ruby-build-system.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index cdabd829e2..64b4400f1a 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -144,6 +144,7 @@ GEM-FLAGS are passed to the 'gem' invokation, if present." (or (zero? (apply system* "gem" "install" gem-file + "--verbose" "--local" "--ignore-dependencies" "--vendor" ;; Executables should go into /bin, not ;; /lib/ruby/gems. -- cgit v1.2.3 From 0168473c0a74ff1f3429e94fdb308cd20e3ea4e8 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 8 Feb 2019 19:50:29 +0000 Subject: guix: ruby-build-system: Fix removal of extension related files. This functionality was broken, possibly to do with the vendor related changes in the ruby build system. These changes restore the file removal functionality at the end of the install phase. * guix/build/ruby-build-system.scm (install): Fix removal of files related to native extensions. --- guix/build/ruby-build-system.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index 64b4400f1a..ba0de1259e 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -139,7 +139,8 @@ GEM-FLAGS are passed to the 'gem' invokation, if present." (gem-file-basename (basename gem-file)) (gem-name (substring gem-file-basename 0 - (- (string-length gem-file-basename) 4)))) + (- (string-length gem-file-basename) 4))) + (gem-dir (string-append vendor-dir "/gems/" gem-name))) (setenv "GEM_VENDOR" vendor-dir) (or (zero? @@ -165,7 +166,7 @@ GEM-FLAGS are passed to the 'gem' invokation, if present." ;; For gems with native extensions, several Makefile-related files ;; are created that contain timestamps or other elements making ;; them not reproducible. They are unnecessary so we remove them. - (when (file-exists? (string-append vendor-dir "/ext")) + (when (file-exists? (string-append gem-dir "/ext")) (for-each (lambda (file) (log-file-deletion file) (delete-file file)) @@ -174,7 +175,7 @@ GEM-FLAGS are passed to the 'gem' invokation, if present." "page-Makefile.ri") (find-files (string-append vendor-dir "/extensions") "gem_make.out") - (find-files (string-append vendor-dir "/ext") + (find-files (string-append gem-dir "/ext") "Makefile")))) #t)) -- cgit v1.2.3 From 142cf421217dd1bde60cef3d18069398e3c24fbc Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Fri, 15 Feb 2019 11:09:36 +0100 Subject: gnu-maintenance: Verify GPG signatures in KDE updater. * guix/gnu-maintenance.scm (latest-kde-release): Remove #:file->signature. --- guix/gnu-maintenance.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index bfd47a831d..36b3c930d7 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -623,8 +623,7 @@ releases are on gnu.org." (package-upstream-name package) #:server "mirrors.mit.edu" #:directory - (string-append "/kde" (dirname (dirname (uri-path uri)))) - #:file->signature (const #f))))) + (string-append "/kde" (dirname (dirname (uri-path uri)))))))) (define (latest-xorg-release package) "Return the latest release of PACKAGE, the name of an X.org package." -- cgit v1.2.3 From e6e599fa0106f57b9de15f90dcab3795ff1575b6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Feb 2019 08:45:57 +0100 Subject: environment: Add '--inherit'. * guix/scripts/environment.scm (purify-environment): Add 'white-list' parameter and honor it. (create-environment): Add #:white-list parameter and honor it. (launch-environment): Likewise. (launch-environment/fork): Likewise. (show-help, %options): Add '--inherit'. (guix-environment): Define 'white-list' and pass it to 'launch-environment/fork'. * tests/guix-environment.sh: Test '--inherit'. * doc/guix.texi (Invoking guix environment): Document it. --- doc/guix.texi | 21 +++++++++++++++--- guix/scripts/environment.scm | 53 +++++++++++++++++++++++++++++++------------- tests/guix-environment.sh | 15 ++++++++++++- 3 files changed, 69 insertions(+), 20 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 1ac077d98a..68d39ed02f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4454,9 +4454,24 @@ default behavior. Packages appearing after are interpreted as packages that will be added to the environment directly. @item --pure -Unset existing environment variables when building the new environment. -This has the effect of creating an environment in which search paths -only contain package inputs. +Unset existing environment variables when building the new environment, except +those specified with @option{--inherit} (see below.) This has the effect of +creating an environment in which search paths only contain package inputs. + +@item --inherit=@var{regexp} +When used alongside @option{--pure}, inherit all the environment variables +matching @var{regexp}---in other words, put them on a ``white list'' of +environment variables that must be preserved. + +@example +guix environment --pure --inherit=^SLURM --ad-hoc openmpi @dots{} \ + -- mpirun @dots{} +@end example + +This example runs @command{mpirun} in a context where the only environment +variables defined are @code{PATH}, environment variables whose name starts +with @code{SLURM}, as well as the usual ``precious'' variables (@code{HOME}, +@code{USER}, etc.) @item --search-paths Display the environment variable definitions that make up the diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 3143ea9281..3966531efa 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -57,20 +57,27 @@ (define %default-shell (or (getenv "SHELL") "/bin/sh")) -(define (purify-environment) - "Unset almost all environment variables. A small number of variables such -as 'HOME' and 'USER' are left untouched." +(define (purify-environment white-list) + "Unset all environment variables except those that match the regexps in +WHITE-LIST and those listed in %PRECIOUS-VARIABLES. A small number of +variables such as 'HOME' and 'USER' are left untouched." (for-each unsetenv - (remove (cut member <> %precious-variables) + (remove (lambda (variable) + (or (member variable %precious-variables) + (find (cut regexp-exec <> variable) + white-list))) (match (get-environment-variables) (((names . _) ...) names))))) -(define* (create-environment profile manifest #:key pure?) - "Set the environment variables specified by MANIFEST for PROFILE. When PURE? -is #t, unset the variables in the current environment. Otherwise, augment -existing environment variables with additional search paths." - (when pure? (purify-environment)) +(define* (create-environment profile manifest + #:key pure? (white-list '())) + "Set the environment variables specified by MANIFEST for PROFILE. When +PURE? is #t, unset the variables in the current environment except those that +match the regexps in WHITE-LIST. Otherwise, augment existing environment +variables with additional search paths." + (when pure? + (purify-environment white-list)) (for-each (match-lambda ((($ variable _ separator) . value) (let ((current (getenv variable))) @@ -133,6 +140,8 @@ COMMAND or an interactive shell in that environment.\n")) of only their inputs")) (display (G_ " --pure unset existing environment variables")) + (display (G_ " + --inherit=REGEXP inherit environment variables that match REGEXP")) (display (G_ " --search-paths display needed environment variable definitions")) (display (G_ " @@ -206,6 +215,11 @@ COMMAND or an interactive shell in that environment.\n")) (option '("pure") #f #f (lambda (opt name arg result) (alist-cons 'pure #t result))) + (option '("inherit") #t #f + (lambda (opt name arg result) + (alist-cons 'inherit-regexp + (make-regexp* arg) + result))) (option '(#\E "exec") #t #f ; deprecated (lambda (opt name arg result) (alist-cons 'exec (list %default-shell "-c" arg) result))) @@ -397,25 +411,30 @@ and suitable for 'exit'." (define primitive-exit/status (compose primitive-exit status->exit-code)) (define* (launch-environment command profile manifest - #:key pure?) + #:key pure? (white-list '())) "Run COMMAND in a new environment containing INPUTS, using the native search paths defined by the list PATHS. When PURE?, pre-existing environment -variables are cleared before setting the new ones." +variables are cleared before setting the new ones, except those matching the +regexps in WHITE-LIST." ;; Properly handle SIGINT, so pressing C-c in an interactive terminal ;; application works. (sigaction SIGINT SIG_DFL) - (create-environment profile manifest #:pure? pure?) + (create-environment profile manifest + #:pure? pure? #:white-list white-list) (match command ((program . args) (apply execlp program program args)))) -(define* (launch-environment/fork command profile manifest #:key pure?) +(define* (launch-environment/fork command profile manifest + #:key pure? (white-list '())) "Run COMMAND in a new process with an environment containing PROFILE, with the search paths specified by MANIFEST. When PURE?, pre-existing environment -variables are cleared before setting the new ones." +variables are cleared before setting the new ones, except those matching the +regexps in WHITE-LIST." (match (primitive-fork) (0 (launch-environment command profile manifest - #:pure? pure?)) + #:pure? pure? + #:white-list white-list)) (pid (match (waitpid pid) ((_ . status) status))))) @@ -672,7 +691,8 @@ message if any test fails." ;; within the container. '("/bin/sh") (list %default-shell)))) - (mappings (pick-all opts 'file-system-mapping))) + (mappings (pick-all opts 'file-system-mapping)) + (white-list (pick-all opts 'inherit-regexp))) (when container? (assert-container-features)) @@ -741,4 +761,5 @@ message if any test fails." (return (exit/status (launch-environment/fork command profile manifest + #:white-list white-list #:pure? pure?)))))))))))))) diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index 30b21028aa..ccbe027c7b 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès +# Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès # # This file is part of GNU Guix. # @@ -49,6 +49,19 @@ test -x `sed -r 's/^export PATH="(.*)"/\1/' "$tmpdir/a"`/guile cmp "$tmpdir/a" "$tmpdir/b" +# Check '--inherit'. +GUIX_TEST_ABC=1 +GUIX_TEST_DEF=2 +GUIX_TEST_XYZ=3 +export GUIX_TEST_ABC GUIX_TEST_DEF GUIX_TEST_XYZ +guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ + --inherit='^GUIX_TEST_A' --inherit='^GUIX_TEST_D' \ + -- "$SHELL" -c set > "$tmpdir/a" +grep '^PATH=' "$tmpdir/a" +grep '^GUIX_TEST_ABC=' "$tmpdir/a" +grep '^GUIX_TEST_DEF=' "$tmpdir/a" +if grep '^GUIX_TEST_XYZ=' "$tmpdir/a"; then false; else true; fi + # Make sure the exit value is preserved. if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ -- guile -c '(exit 42)' -- cgit v1.2.3 From ba48895899a117d6ace2209c3f54411a4a989133 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 14 Feb 2019 17:41:42 +0100 Subject: self: Bundle 'glibc-utf8-locales'. This minimizes the risk of locale-related warnings, at least for those who use one of the bundled UTF-8 locales. * guix/self.scm (guix-command)[glibc-utf8-locales]: New variable. In program body, set GUIX_LOCPATH. --- guix/self.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index a45470a0a6..bcf04a1b28 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -390,6 +390,10 @@ that provide Guile modules." guile (guile-version (effective-version))) "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its load path." + (define glibc-utf8-locales + (module-ref (resolve-interface '(gnu packages base)) + 'glibc-utf8-locales)) + (define module-directory ;; To minimize the number of 'stat' calls needed to locate a module, ;; create the union of all the module directories. @@ -410,6 +414,16 @@ load path." "/site-ccache") %load-compiled-path)) + ;; To maximize the chances that locales are set up right + ;; out-of-the-box, bundle "common" UTF-8 locales. + (let ((locpath (getenv "GUIX_LOCPATH"))) + (setenv "GUIX_LOCPATH" + (string-append (if locpath + (string-append locpath ":") + "") + #$(file-append glibc-utf8-locales + "/lib/locale")))) + (let ((guix-main (module-ref (resolve-interface '(guix ui)) 'guix-main))) #$(if source -- cgit v1.2.3 From 54eadc42d2a5ef748a7f007516cd3d56ca17c07e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Feb 2019 23:51:01 +0100 Subject: self: Generated (guix config) honors %CURRENT-SYSTEM. Fixes . Reported by Diego Nicola Barbato . * guix/self.scm (%config-variables): Remove %SYSTEM. (make-config.scm): Define '%system' to (%current-system). --- guix/self.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/self.scm b/guix/self.scm index bcf04a1b28..ccff9be5b3 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -771,7 +771,7 @@ Info manual." ((_ variable rest ...) (cons `(variable . ,variable) (variables rest ...)))))) - (variables %localstatedir %storedir %sysconfdir %system))) + (variables %localstatedir %storedir %sysconfdir))) (define* (make-config.scm #:key zlib gzip xz bzip2 (package-name "GNU Guix") @@ -789,6 +789,7 @@ Info manual." %guix-version %guix-bug-report-address %guix-home-page-url + %system %store-directory %state-directory %store-database-directory @@ -798,6 +799,9 @@ Info manual." %bzip2 %xz)) + (define %system + #$(%current-system)) + #$@(map (match-lambda ((name . value) #~(define-public #$name #$value))) -- cgit v1.2.3