diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-09-24 17:50:48 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-09-26 11:43:26 +0200 |
commit | 3972dc5d43ea824ee4ab78592e759f62ce90bf6a (patch) | |
tree | 8d3e77fa1ea038735b327ecc9b2b959f6cefdb3f | |
parent | 71339070a9c38dc5502697edacb11adbc30303eb (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.
-rw-r--r-- | doc/guix.texi | 13 | ||||
-rw-r--r-- | guix/scripts/package.scm | 21 | ||||
-rw-r--r-- | tests/guix-package.sh | 6 |
3 files changed, 39 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 4ffffcdc81..14c4514b31 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2933,6 +2933,19 @@ siblings that point to specific generations: $ rm ~/code/my-profile ~/code/my-profile-*-link @end example +@item --list-profiles +List all the user's profiles: + +@example +$ guix package --list-profiles +/home/charlie/.guix-profile +/home/charlie/code/my-profile +/home/charlie/code/devel-profile +/home/charlie/tmp/test +@end example + +When running as root, list all the profiles of all the users. + @cindex collisions, in a profile @cindex colliding packages in profiles @cindex profile collisions 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) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 79e89286f1..0de30bf6c1 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -438,7 +438,7 @@ cat > "$module_dir/foo.scm"<<EOF (version "dummy-version") (outputs '("out" "dummy-output")) (source #f) - ;; Without a real build system, the "guix pacakge -s" command will fail. + ;; Without a real build system, the "guix package -s" command will fail. (build-system trivial-build-system) (synopsis "dummy-synopsis") (description "dummy-description") @@ -448,3 +448,7 @@ EOF guix package -L "$module_dir" -s dummy-output > /tmp/out test "`guix package -L "$module_dir" -s dummy-output | grep ^name:`" = "name: dummy-package" rm -rf "$module_dir" + +# Make sure we can see user profiles. +guix package --list-profiles | grep "$profile" +guix package --list-profiles | grep '\.guix-profile' |