mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 15:36:20 -05:00
guix gc: Correctly handle '--delete-generations' with no arguments.
Previously, 'guix gc --delete-generations' would crash: the "" pattern would be passed to 'matching-generations', which would return #f instead of returning a list. Reported by Raghav Gururajan <rvgn@disroot.org> in <https://bugs.gnu.org/36466>. * guix/ui.scm (matching-generations): Raise an error when passed an invalid pattern. * guix/scripts/gc.scm (delete-old-generations): Check if PATTERN is true. (%options): Leave ARG as-is for 'delete-generations'. (guix-gc): Use 'assq' instead of 'assoc-ref' for 'delete-generations'. * guix/scripts/package.scm (delete-matching-generations): Replace (string-null? pattern) with (not pattern). Remove 'else' clause. (%options): Leave ARG as-is for 'delete-generations'. * guix/scripts/pull.scm (%options): Leave ARG as-is for 'list-generations'. (process-query): Replace (string-null? pattern) with (not pattern). * guix/scripts/system.scm (list-generations): Likewise, and remove 'else' clause. (process-command): Use #f instead of "" when no pattern is given.
This commit is contained in:
Ludovic Courtès
parent
878a6baa4c
commit
5c3d44303e
5 changed files with 27 additions and 28 deletions
|
|
@ -104,11 +104,14 @@ (define argument->verify-options
|
|||
'()))))
|
||||
|
||||
(define (delete-old-generations store profile pattern)
|
||||
"Remove the generations of PROFILE that match PATTERN, a duration pattern.
|
||||
Do nothing if none matches."
|
||||
"Remove the generations of PROFILE that match PATTERN, a duration pattern;
|
||||
do nothing if none matches. If PATTERN is #f, delete all generations but the
|
||||
current one."
|
||||
(let* ((current (generation-number profile))
|
||||
(numbers (matching-generations pattern profile
|
||||
#:duration-relation >)))
|
||||
(numbers (if (not pattern)
|
||||
(profile-generations profile)
|
||||
(matching-generations pattern profile
|
||||
#:duration-relation >))))
|
||||
|
||||
;; Make sure we don't inadvertently remove the current generation.
|
||||
(delete-generations store profile (delv current numbers))))
|
||||
|
|
@ -155,8 +158,7 @@ (define %options
|
|||
(when (and arg (not (string->duration arg)))
|
||||
(leave (G_ "~s does not denote a duration~%")
|
||||
arg))
|
||||
(alist-cons 'delete-generations (or arg "")
|
||||
result)))))
|
||||
(alist-cons 'delete-generations arg result)))))
|
||||
(option '("optimize") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'action 'optimize
|
||||
|
|
@ -287,9 +289,9 @@ (define (list-relatives relatives)
|
|||
(assert-no-extra-arguments)
|
||||
(let ((min-freed (assoc-ref opts 'min-freed))
|
||||
(free-space (assoc-ref opts 'free-space)))
|
||||
(match (assoc-ref opts 'delete-generations)
|
||||
(match (assq 'delete-generations opts)
|
||||
(#f #t)
|
||||
((? string? pattern)
|
||||
((_ . pattern)
|
||||
(delete-generations store pattern)))
|
||||
(cond
|
||||
(free-space
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@ (define (delete-matching-generations store profile pattern)
|
|||
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||
(raise (condition (&profile-not-found-error
|
||||
(profile profile)))))
|
||||
((string-null? pattern)
|
||||
((not pattern)
|
||||
(delete-generations store profile
|
||||
(delv current (profile-generations profile))))
|
||||
;; Do not delete the zeroth generation.
|
||||
|
|
@ -120,9 +120,7 @@ (define (delete-matching-generations store profile pattern)
|
|||
(let ((numbers (delv current numbers)))
|
||||
(when (null-list? numbers)
|
||||
(leave (G_ "no matching generation~%")))
|
||||
(delete-generations store profile numbers))))
|
||||
(else
|
||||
(leave (G_ "invalid syntax: ~a~%") pattern)))))
|
||||
(delete-generations store profile numbers)))))))
|
||||
|
||||
(define* (build-and-use-profile store profile manifest
|
||||
#:key
|
||||
|
|
@ -457,12 +455,12 @@ (define %options
|
|||
arg-handler)))
|
||||
(option '(#\l "list-generations") #f #t
|
||||
(lambda (opt name arg result arg-handler)
|
||||
(values (cons `(query list-generations ,(or arg ""))
|
||||
(values (cons `(query list-generations ,arg)
|
||||
result)
|
||||
#f)))
|
||||
(option '(#\d "delete-generations") #f #t
|
||||
(lambda (opt name arg result arg-handler)
|
||||
(values (alist-cons 'delete-generations (or arg "")
|
||||
(values (alist-cons 'delete-generations arg
|
||||
result)
|
||||
#f)))
|
||||
(option '(#\S "switch-generation") #t #f
|
||||
|
|
@ -683,7 +681,7 @@ (define (diff-profiles profile numbers)
|
|||
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||
(raise (condition (&profile-not-found-error
|
||||
(profile profile)))))
|
||||
((string-null? pattern)
|
||||
((not pattern)
|
||||
(match (profile-generations profile)
|
||||
(()
|
||||
#t)
|
||||
|
|
@ -697,10 +695,7 @@ (define (diff-profiles profile numbers)
|
|||
(exit 1)
|
||||
(begin
|
||||
(list-generation display-profile-content (car numbers))
|
||||
(diff-profiles profile numbers)))))
|
||||
(else
|
||||
(leave (G_ "invalid syntax: ~a~%")
|
||||
pattern))))
|
||||
(diff-profiles profile numbers)))))))
|
||||
#t)
|
||||
|
||||
(('list-installed regexp)
|
||||
|
|
|
|||
|
|
@ -117,7 +117,7 @@ (define %options
|
|||
(alist-cons 'channel-file arg result)))
|
||||
(option '(#\l "list-generations") #f #t
|
||||
(lambda (opt name arg result)
|
||||
(cons `(query list-generations ,(or arg ""))
|
||||
(cons `(query list-generations ,arg)
|
||||
result)))
|
||||
(option '(#\N "news") #f #f
|
||||
(lambda (opt name arg result)
|
||||
|
|
@ -486,7 +486,7 @@ (define (list-generations profile numbers)
|
|||
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||
(raise (condition (&profile-not-found-error
|
||||
(profile profile)))))
|
||||
((string-null? pattern)
|
||||
((not pattern)
|
||||
(list-generations profile (profile-generations profile)))
|
||||
((matching-generations pattern profile)
|
||||
=>
|
||||
|
|
|
|||
|
|
@ -614,7 +614,7 @@ (define* (list-generations pattern #:optional (profile %system-profile))
|
|||
(cond ((not (file-exists? profile)) ; XXX: race condition
|
||||
(raise (condition (&profile-not-found-error
|
||||
(profile profile)))))
|
||||
((string-null? pattern)
|
||||
((not pattern)
|
||||
(for-each display-system-generation (profile-generations profile)))
|
||||
((matching-generations pattern profile)
|
||||
=>
|
||||
|
|
@ -622,9 +622,7 @@ (define* (list-generations pattern #:optional (profile %system-profile))
|
|||
(if (null-list? numbers)
|
||||
(exit 1)
|
||||
(leave-on-EPIPE
|
||||
(for-each display-system-generation numbers)))))
|
||||
(else
|
||||
(leave (G_ "invalid syntax: ~a~%") pattern))))
|
||||
(for-each display-system-generation numbers)))))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -1232,7 +1230,7 @@ (define (process-command command args opts)
|
|||
;; an operating system configuration file.
|
||||
((list-generations)
|
||||
(let ((pattern (match args
|
||||
(() "")
|
||||
(() #f)
|
||||
((pattern) pattern)
|
||||
(x (leave (G_ "wrong number of arguments~%"))))))
|
||||
(list-generations pattern)))
|
||||
|
|
@ -1242,7 +1240,7 @@ (define (process-command command args opts)
|
|||
;; operating system configuration file.
|
||||
((delete-generations)
|
||||
(let ((pattern (match args
|
||||
(() "")
|
||||
(() #f)
|
||||
((pattern) pattern)
|
||||
(x (leave (G_ "wrong number of arguments~%"))))))
|
||||
(with-store store
|
||||
|
|
|
|||
|
|
@ -1484,7 +1484,11 @@ (define generation-ctime-alist
|
|||
((string->duration str)
|
||||
=>
|
||||
filter-by-duration)
|
||||
(else #f)))
|
||||
(else
|
||||
(raise
|
||||
(condition (&message
|
||||
(message (format #f (G_ "invalid syntax: ~a~%")
|
||||
str))))))))
|
||||
|
||||
(define (display-generation profile number)
|
||||
"Display a one-line summary of generation NUMBER of PROFILE."
|
||||
|
|
|
|||
Loading…
Reference in a new issue