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