* guix/cache.scm (maybe-remove-expired-cache-entries)[last-expiry-date]: Check
if the value is a valid integer.
* tests/cache.scm: Test it.
---
guix/cache.scm | 20 +++++++++++++++-----
tests/cache.scm | 22 ++++++++++++++++++++++
2 files changed, 37 insertions(+), 5 deletions(-)
Toggle diff (97 lines)
diff --git a/guix/cache.scm b/guix/cache.scm
index 51009809bd..9727a9eb58 100644
--- a/guix/cache.scm
+++ b/guix/cache.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,9 +18,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix cache)
+ #:use-module ((guix utils) #:select (with-atomic-file-output))
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
+ #:use-module ((ice-9 textual-ports) #:select (get-string-all))
#:export (obsolete?
delete-file*
file-expiration-time
@@ -91,10 +94,17 @@ (define expiry-file
(string-append cache "/last-expiry-cleanup"))
(define last-expiry-date
- (catch 'system-error
- (lambda ()
- (call-with-input-file expiry-file read))
- (const 0)))
+ (let ((str (catch 'system-error
+ (lambda ()
+ (call-with-input-file expiry-file get-string-all))
+ (const "0"))))
+ ;; Handle empty or corrupted 'expiry-file' when 'write' below is
+ ;; interrupted before being complete (e.g., SIGINT with C-c) or when
+ ;; the filesystem crashes.
+ (if (or (string-index str #\e) ; Handle value out of range
+ (string-index str #\E)) ; (e.g., 1234567890 -> 12E4567890)
+ 0
+ (or (string->number str) 0))))
(when (obsolete? last-expiry-date now cleanup-period)
(remove-expired-cache-entries (cache-entries cache)
@@ -103,7 +113,7 @@ (define last-expiry-date
#:delete-entry delete-entry)
(catch 'system-error
(lambda ()
- (call-with-output-file expiry-file
+ (with-atomic-file-output expiry-file
(cute write (time-second now) <>)))
(lambda args
;; ENOENT means CACHE does not exist.
diff --git a/tests/cache.scm b/tests/cache.scm
index 80b44d69aa..bd6fd64a22 100644
--- a/tests/cache.scm
+++ b/tests/cache.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -74,6 +75,27 @@ (define-syntax-rule (test-cache-cleanup cache exp ...)
(lambda (port)
(display 0 port)))))
+(test-equal "maybe-remove-expired-cache-entries, empty cache"
+ '("a" "b" "c")
+ (test-cache-cleanup cache
+ (call-with-output-file (string-append cache "/last-expiry-cleanup")
+ (lambda (port)
+ (display "" port)))))
+
+(test-equal "maybe-remove-expired-cache-entries, corrupted cache"
+ '("a" "b" "c")
+ (test-cache-cleanup cache
+ (call-with-output-file (string-append cache "/last-expiry-cleanup")
+ (lambda (port)
+ (display "1\"34657890" port)))))
+
+(test-equal "maybe-remove-expired-cache-entries, corrupted cache of out range"
+ '("a" "b" "c")
+ (test-cache-cleanup cache
+ (call-with-output-file (string-append cache "/last-expiry-cleanup")
+ (lambda (port)
+ (display "12E4567890" port)))))
+
(test-end "cache")
;;; Local Variables:
base-commit: 38bf6c7d0cb588e8d4546db7d2e0bae2ec25183d
--
2.36.0