diff options
| -rw-r--r-- | guix/cache.scm | 9 | ||||
| -rw-r--r-- | tests/cache.scm | 15 |
2 files changed, 22 insertions, 2 deletions
diff --git a/guix/cache.scm b/guix/cache.scm index 51009809bd3..be0de90e67b 100644 --- a/guix/cache.scm +++ b/guix/cache.scm | |||
| @@ -1,5 +1,6 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020, 2021 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2020, 2021 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com> | ||
| 3 | ;;; | 4 | ;;; |
| 4 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| 5 | ;;; | 6 | ;;; |
| @@ -17,9 +18,11 @@ | |||
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | 18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 18 | 19 | ||
| 19 | (define-module (guix cache) | 20 | (define-module (guix cache) |
| 21 | #:use-module ((guix utils) #:select (with-atomic-file-output)) | ||
| 20 | #:use-module (srfi srfi-19) | 22 | #:use-module (srfi srfi-19) |
| 21 | #:use-module (srfi srfi-26) | 23 | #:use-module (srfi srfi-26) |
| 22 | #:use-module (ice-9 match) | 24 | #:use-module (ice-9 match) |
| 25 | #:use-module ((ice-9 textual-ports) #:select (get-string-all)) | ||
| 23 | #:export (obsolete? | 26 | #:export (obsolete? |
| 24 | delete-file* | 27 | delete-file* |
| 25 | file-expiration-time | 28 | file-expiration-time |
| @@ -93,7 +96,9 @@ CLEANUP-PERIOD denotes the minimum time between two cache cleanups." | |||
| 93 | (define last-expiry-date | 96 | (define last-expiry-date |
| 94 | (catch 'system-error | 97 | (catch 'system-error |
| 95 | (lambda () | 98 | (lambda () |
| 96 | (call-with-input-file expiry-file read)) | 99 | (or (string->number |
| 100 | (call-with-input-file expiry-file get-string-all)) | ||
| 101 | 0)) | ||
| 97 | (const 0))) | 102 | (const 0))) |
| 98 | 103 | ||
| 99 | (when (obsolete? last-expiry-date now cleanup-period) | 104 | (when (obsolete? last-expiry-date now cleanup-period) |
| @@ -103,7 +108,7 @@ CLEANUP-PERIOD denotes the minimum time between two cache cleanups." | |||
| 103 | #:delete-entry delete-entry) | 108 | #:delete-entry delete-entry) |
| 104 | (catch 'system-error | 109 | (catch 'system-error |
| 105 | (lambda () | 110 | (lambda () |
| 106 | (call-with-output-file expiry-file | 111 | (with-atomic-file-output expiry-file |
| 107 | (cute write (time-second now) <>))) | 112 | (cute write (time-second now) <>))) |
| 108 | (lambda args | 113 | (lambda args |
| 109 | ;; ENOENT means CACHE does not exist. | 114 | ;; ENOENT means CACHE does not exist. |
diff --git a/tests/cache.scm b/tests/cache.scm index 80b44d69aad..d495ace2bd7 100644 --- a/tests/cache.scm +++ b/tests/cache.scm | |||
| @@ -1,5 +1,6 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com> | ||
| 3 | ;;; | 4 | ;;; |
| 4 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| 5 | ;;; | 6 | ;;; |
| @@ -74,6 +75,20 @@ | |||
| 74 | (lambda (port) | 75 | (lambda (port) |
| 75 | (display 0 port))))) | 76 | (display 0 port))))) |
| 76 | 77 | ||
| 78 | (test-equal "maybe-remove-expired-cache-entries, empty cache" | ||
| 79 | '("a" "b" "c") | ||
| 80 | (test-cache-cleanup cache | ||
| 81 | (call-with-output-file (string-append cache "/last-expiry-cleanup") | ||
| 82 | (lambda (port) | ||
| 83 | (display "" port))))) | ||
| 84 | |||
| 85 | (test-equal "maybe-remove-expired-cache-entries, corrupted cache" | ||
| 86 | '("a" "b" "c") | ||
| 87 | (test-cache-cleanup cache | ||
| 88 | (call-with-output-file (string-append cache "/last-expiry-cleanup") | ||
| 89 | (lambda (port) | ||
| 90 | (display "1\"34657890" port))))) | ||
| 91 | |||
| 77 | (test-end "cache") | 92 | (test-end "cache") |
| 78 | 93 | ||
| 79 | ;;; Local Variables: | 94 | ;;; Local Variables: |
