ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-06 23:16:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

cache: Avoid cache cleanup storms from concurrent processes.

Browse source 
Reported by Christopher Baines <guix@cbaines.net>.

* guix/cache.scm (maybe-remove-expired-cache-entries): Define
‘expiry-port’; create it with ‘lock-file’.  Change ‘last-expiry-date’
accordingly.  Write timestamp straight to ‘expiry-port’.
* tests/cache.scm ("maybe-remove-expired-cache-entries, cleanup needed
but lock taken"): New test.

Change-Id: I22441d9d2c4a339d3d3878de131864db5a0ae826
This commit is contained in:
Ludovic Courtès 2024-07-16 11:03:16 +02:00
parent 96cd163c14
commit d921c742b7
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 47 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
guix/cache.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2017, 2020-2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013-2017, 2020-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
@ -19,6 +19,7 @@
(define-module (guix cache)
#:use-module ((guix utils) #:select (with-atomic-file-output))
#:autoload (guix build syscalls) (lock-file unlock-file)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
@ -93,13 +94,19 @@ (define now
(define expiry-file
(string-append cache "/last-expiry-cleanup"))
(define expiry-port
;; Get exclusive access to EXPIRY-FILE to avoid "cleanup storms" where
;; several processes would concurrently decide that time has come to clean
;; up the same cache. 'lock-file' might throw to 'system-error' or to
;; 'flock-error'; in either case, assume that we lost the race.
(false-if-exception
(lock-file expiry-file "a+0" #:wait? #f)))
(define last-expiry-date
(catch 'system-error
(lambda ()
(or (string->number
(call-with-input-file expiry-file get-string-all))
0))
(const 0)))
(if expiry-port
(or (string->number (get-string-all expiry-port))
0)
+inf.0))
(when (obsolete? last-expiry-date now cleanup-period)
(remove-expired-cache-entries (cache-entries cache)
@ -108,8 +115,10 @@ (define last-expiry-date
#:delete-entry delete-entry)
(catch 'system-error
(lambda ()
(with-atomic-file-output expiry-file
(cute write (time-second now) <>)))
(seek expiry-port 0 SEEK_SET)
(truncate-file expiry-port 0)
(write (time-second now) expiry-port)
(unlock-file expiry-port))
(lambda args
;; ENOENT means CACHE does not exist.
(unless (= ENOENT (system-error-errno args))

30
tests/cache.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2020, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
@ -22,7 +22,9 @@ (define-module (test-cache)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-64)
#:use-module ((guix build syscalls) #:select (lock-file))
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module ((rnrs io ports) #:select (get-string-all))
#:use-module (ice-9 match))
(test-begin "cache")
@ -75,6 +77,32 @@ (define-syntax-rule (test-cache-cleanup cache exp ...)
(lambda (port)
(display 0 port)))))
(let ((pid #f))
(test-equal "maybe-remove-expired-cache-entries, cleanup needed but lock taken"
'()
(test-cache-cleanup cache
(let ((in+out (pipe)))
(match (primitive-fork)
(0 (dynamic-wind
(const #t)
(lambda ()
(close-port (car in+out))
(let ((port (lock-file
(string-append cache "/last-expiry-cleanup"))))
(display 0 port)
(display "done!\n" (cdr in+out))
(close-port (cdr in+out))
(sleep 100)))
(lambda ()
(primitive-exit 0))))
(n
(set! pid n)
(close-port (cdr in+out))
(pk 'chr (get-string-all (car in+out)))
(close-port (car in+out)))))))
(when pid (kill pid SIGKILL)))
(test-equal "maybe-remove-expired-cache-entries, empty cache"
'("a" "b" "c")
(test-cache-cleanup cache