02/07: cache: Catch invalid 'last-expiry-cleanup'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 104b4e25ab7da5697f2f6f1ddfdd4955f05afece
Author: zimoun <zimon.toutoune@gmail.com>
AuthorDate: Mon May 30 15:07:14 2022 +0200

    cache: Catch invalid 'last-expiry-cleanup'.
    
    Fixes <http://issues.guix.gnu.org/55638>.
    
    * guix/cache.scm (maybe-remove-expired-cache-entries)[last-expiry-date]:
    Use 'get-string-all' + 'string->number' instead of 'read'; ignore
    invalid numbers.
    * tests/cache.scm ("maybe-remove-expired-cache-entries, empty cache")
    ("maybe-remove-expired-cache-entries, corrupted cache"): New tests.
    
    Co-authored-by: Ludovic Courtès <ludo@gnu.org>
---
 guix/cache.scm  |  9 +++++++--
 tests/cache.scm | 15 +++++++++++++++
 2 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/guix/cache.scm b/guix/cache.scm
index 51009809bd..be0de90e67 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
@@ -93,7 +96,9 @@ CLEANUP-PERIOD denotes the minimum time between two cache 
cleanups."
   (define last-expiry-date
     (catch 'system-error
       (lambda ()
-        (call-with-input-file expiry-file read))
+        (or (string->number
+             (call-with-input-file expiry-file get-string-all))
+            0))
       (const 0)))
 
   (when (obsolete? last-expiry-date now cleanup-period)
@@ -103,7 +108,7 @@ CLEANUP-PERIOD denotes the minimum time between two cache 
cleanups."
                                   #: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..d495ace2bd 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,20 @@
       (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-end "cache")
 
 ;;; Local Variables: