guix package: '--delete-generations' deletes generations older than specified.

* guix/scripts/package.scm (matching-generations): Add
  'duration-relation' keyword parameter.
  (guix-package)[process-action](delete-generations): Pass
  #:duration-relation >.
* tests/guix-package.sh: Add test.
* doc/guix.texi (Invoking guix package): Clarify the meaning of
  durations for '--list-durations' and '--delete-durations'.
This commit is contained in:
Ludovic Courtès 2013-09-27 01:17:01 +02:00
parent 03f4ef28b1
commit d7ddb257c9
3 changed files with 30 additions and 10 deletions

View File

@ -711,18 +711,24 @@ second one.
@item @emph{Durations}. You can also get the last @emph{N}@tie{}days, weeks, @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 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 @end itemize
@item --delete-generations[=@var{pattern}] @item --delete-generations[=@var{pattern}]
@itemx -d [@var{pattern}] @itemx -d [@var{pattern}]
Delete all generations except the current one. Note that the zeroth When @var{pattern} is omitted, delete all generations except the current
generation is never deleted. one.
This command accepts the same patterns as @option{--list-generations}. This command accepts the same patterns as @option{--list-generations}.
When @var{pattern} is specified, delete the matching generations. If When @var{pattern} is specified, delete the matching generations. When
the current generation matches, it is deleted atomically, i.e., by @var{pattern} specifies a duration, generations @emph{older} than the
switching to the previous available generation. 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 @end table

View File

@ -258,9 +258,12 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
(make-time time-utc 0 (make-time time-utc 0
(stat:ctime (stat (format #f "~a-~a-link" profile number))))) (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 "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-generations lst)
(define (valid-generation? n) (define (valid-generation? n)
(any (cut = n <>) (generation-numbers profile))) (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)) (subtract-duration (time-at-midnight (current-time))
duration)))) duration))))
(delete #f (map (lambda (x) (delete #f (map (lambda (x)
(and (<= s (cdr x)) (and (duration-relation s (cdr x))
(first x))) (first x)))
generation-ctime-alist)))))) generation-ctime-alist))))))
@ -887,7 +890,11 @@ more information.~%"))
;; Do not delete the zeroth generation. ;; Do not delete the zeroth generation.
((equal? 0 (string->number pattern)) ((equal? 0 (string->number pattern))
(exit 0)) (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) (lambda (numbers)
(if (null-list? numbers) (if (null-list? numbers)

View File

@ -168,6 +168,13 @@ then false; else true; fi
# Check whether `--list-available' returns something sensible. # Check whether `--list-available' returns something sensible.
guix package -p "$profile" -A 'gui.*e' | grep guile 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. # Try with the default profile.
# #