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.

5 files changed, 27 insertions, 28 deletions

diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 9a57e5fd1e..31657326b6 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -104,11 +104,14 @@ Invoke the garbage collector.\n"))
           '()))))
 
 (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 @@ is deprecated; use '-D'~%"))
                         (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 @@ is deprecated; use '-D'~%"))
          (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
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7b277b63f1..a43c96516f 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -98,7 +98,7 @@ denote ranges as interpreted by 'matching-generations'."
     (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 @@ denote ranges as interpreted by 'matching-generations'."
              (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 @@ command-line option~%")
                            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 @@ processed, #f otherwise."
         (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 @@ processed, #f otherwise."
                      (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)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 2d428546c9..7895c19914 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -117,7 +117,7 @@ Download and deploy the latest version of Guix.\n"))
                    (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 @@ list of package changes.")))))
       (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)
              =>
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 60c1ca5c9a..67a4071684 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -614,7 +614,7 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
   (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 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
            (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 @@ argument list and OPTS is the option alist."
     ;; 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 @@ argument list and OPTS is the option alist."
     ;; operating system configuration file.
     ((delete-generations)
      (let ((pattern (match args
-                      (() "")
+                      (() #f)
                       ((pattern) pattern)
                       (x (leave (G_ "wrong number of arguments~%"))))))
        (with-store store
diff --git a/guix/ui.scm b/guix/ui.scm
index 7d6ab9a2a7..76f6fc8eed 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1484,7 +1484,11 @@ DURATION-RELATION with the current time."
         ((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."