mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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.
This commit is contained in:
parent
71339070a9
commit
3972dc5d43
3 changed files with 39 additions and 1 deletions
|
@ -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
|
||||
|
|
|
@ -39,6 +39,7 @@ (define-module (guix scripts package)
|
|||
#: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 @@ (define (show-help)
|
|||
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 @@ (define %options
|
|||
(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 @@ (define (diff-profiles profile numbers)
|
|||
(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)
|
||||
|
|
|
@ -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'
|
||||
|
|
Loading…
Reference in a new issue