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'.master
parent
03f4ef28b1
commit
d7ddb257c9
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
#
|
||||
|
|
Reference in New Issue