05/05: guix package: Add '--list-profiles'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 3972dc5d43ea824ee4ab78592e759f62ce90bf6a
Author: Ludovic Courtès <address@hidden>
Date:   Tue Sep 24 17:50:48 2019 +0200

    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.
---
 doc/guix.texi            | 13 +++++++++++++
 guix/scripts/package.scm | 21 +++++++++++++++++++++
 tests/guix-package.sh    |  6 +++++-
 3 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4ffffcd..14c4514 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 f03741a..1a58d43 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 79e8928..0de30bf 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'