summaryrefslogtreecommitdiff
path: root/guix/scripts/package.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-09-24 17:50:48 +0200
committerLudovic Courtès <ludo@gnu.org>2019-09-26 11:43:26 +0200
commit3972dc5d43ea824ee4ab78592e759f62ce90bf6a (patch)
tree8d3e77fa1ea038735b327ecc9b2b959f6cefdb3f /guix/scripts/package.scm
parent71339070a9c38dc5502697edacb11adbc30303eb (diff)
guix package: Add '--list-profiles'.
* guix/scripts/package.scm (show-help, %options): Add '--list-profiles'. (process-query): Honor it. * tests/guix-package.sh: Add test.
Diffstat (limited to 'guix/scripts/package.scm')
-rw-r--r--guix/scripts/package.scm21
1 files changed, 21 insertions, 0 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f03741aa9e..1a58d43e5c 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -39,6 +39,7 @@
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:autoload (guix describe) (package-provenance)
+ #:autoload (guix store roots) (gc-roots)
#:use-module ((guix build utils)
#:select (directory-exists? mkdir-p))
#:use-module (ice-9 format)
@@ -359,6 +360,8 @@ Install, remove, or upgrade packages in a single transaction.\n"))
switch to a generation matching PATTERN"))
(display (G_ "
-p, --profile=PROFILE use PROFILE instead of the user's default profile"))
+ (display (G_ "
+ --list-profiles list the user's profiles"))
(newline)
(display (G_ "
--allow-collisions do not treat collisions in the profile as an error"))
@@ -458,6 +461,11 @@ command-line option~%")
(values (cons `(query list-generations ,arg)
result)
#f)))
+ (option '("list-profiles") #f #f
+ (lambda (opt name arg result arg-handler)
+ (values (cons `(query list-profiles #t)
+ result)
+ #f)))
(option '(#\d "delete-generations") #f #t
(lambda (opt name arg result arg-handler)
(values (alist-cons 'delete-generations arg
@@ -750,6 +758,19 @@ processed, #f otherwise."
(string<? name1 name2))))))
#t))
+ (('list-profiles _)
+ (let ((profiles (delete-duplicates
+ (filter-map (lambda (root)
+ (and (or (zero? (getuid))
+ (user-owned? root))
+ (generation-profile root)))
+ (gc-roots)))))
+ (leave-on-EPIPE
+ (for-each (lambda (profile)
+ (display (user-friendly-profile profile))
+ (newline))
+ (sort profiles string<?)))))
+
(('search _)
(let* ((patterns (filter-map (match-lambda
(('query 'search rx) rx)