diff options
| -rw-r--r-- | doc/guix.texi | 18 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 15 | ||||
| -rw-r--r-- | tests/guix-package.sh | 7 |
3 files changed, 30 insertions, 10 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 2e6bdc595e..29928c5af4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -711,18 +711,24 @@ second one. @item @emph{Durations}. You can also get the last @emph{N}@tie{}days, weeks, or months by passing an integer along with the first letter of the -duration, e.g., @code{--list-generations=20d}. +duration. For example, @code{--list-generations=20d} lists generations +that are up to 20 days old. @end itemize @item --delete-generations[=@var{pattern}] @itemx -d [@var{pattern}] -Delete all generations except the current one. Note that the zeroth -generation is never deleted. +When @var{pattern} is omitted, delete all generations except the current +one. This command accepts the same patterns as @option{--list-generations}. -When @var{pattern} is specified, delete the matching generations. If -the current generation matches, it is deleted atomically, i.e., by -switching to the previous available generation. +When @var{pattern} is specified, delete the matching generations. When +@var{pattern} specifies a duration, generations @emph{older} than the +specified duration match. For instance, @code{--delete-generations=1m} +deletes generations that are more than one month old. + +If the current generation matches, it is deleted atomically---i.e., by +switching to the previous available generation. Note that the zeroth +generation is never deleted. @end table diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 35a5129d25..5c7c165cbb 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -258,9 +258,12 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (make-time time-utc 0 (stat:ctime (stat (format #f "~a-~a-link" profile number))))) -(define* (matching-generations str #:optional (profile %current-profile)) +(define* (matching-generations str #:optional (profile %current-profile) + #:key (duration-relation <=)) "Return the list of available generations matching a pattern in STR. See -'string->generations' and 'string->duration' for the list of valid patterns." +'string->generations' and 'string->duration' for the list of valid patterns. +When STR is a duration pattern, return all the generations whose ctime has +DURATION-RELATION with the current time." (define (valid-generations lst) (define (valid-generation? n) (any (cut = n <>) (generation-numbers profile))) @@ -309,7 +312,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (subtract-duration (time-at-midnight (current-time)) duration)))) (delete #f (map (lambda (x) - (and (<= s (cdr x)) + (and (duration-relation s (cdr x)) (first x))) generation-ctime-alist)))))) @@ -887,7 +890,11 @@ more information.~%")) ;; Do not delete the zeroth generation. ((equal? 0 (string->number pattern)) (exit 0)) - ((matching-generations pattern profile) + + ;; If PATTERN is a duration, match generations that are + ;; older than the specified duration. + ((matching-generations pattern profile + #:duration-relation >) => (lambda (numbers) (if (null-list? numbers) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 80301f63cc..9116f352c9 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -168,6 +168,13 @@ then false; else true; fi # Check whether `--list-available' returns something sensible. guix package -p "$profile" -A 'gui.*e' | grep guile +# There's no generation older than 12 months, so the following command should +# have no effect. +generation="`readlink_base "$profile"`" +if guix package -p "$profile" --delete-generations=12m; +then false; else true; fi +test "`readlink_base "$profile"`" = "$generation" + # # Try with the default profile. # |