tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 13:10:33 +02:00
Code Activity

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
2 changed files with 47 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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 @@
#: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 @@
(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