~ruther/guix-local: publish: Explicitly update the atime for cache expiry.

02d3a5a1fb7275a5f313e1c55e6ae1d297bab50c — Ludovic Courtès 5 months ago 529dce6

publish: Explicitly update the atime for cache expiry.

Mounting file systems with ‘noatime’ is common.  Thus, avoid relying on the
atime.

* guix/scripts/publish.scm (render-narinfo/cached): Add ‘utime’ call on cache
hit.  Use ‘stat’ instead of ‘file-exists?’.
(bake-narinfo+nar): Update comment.

Change-Id: Id8c68d3b793922fdadca8cbd02b50368b418bb67

patch browse .tar.gz

1 files changed, 16 insertions(+), 11 deletions(-)

M guix/scripts/publish.scm

M guix/scripts/publish.scm => guix/scripts/publish.scm +16 -11

@@ 1,7 1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
-;;; Copyright © 2015-2022, 2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2022, 2024-2025 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim@guixotic.coop>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021, 2022 Mathieu Othacehe <othacehe@gnu.org>


@@ 551,16 551,21 @@ requested using POOL."
                                                 (first compressions)))))
     (cond ((string-null? item)
            (not-found request #:ttl negative-ttl))
-          ((file-exists? cached)
-           ;; Narinfo is in cache, send it.
-           (values `((content-type . (application/x-nix-narinfo))
-                     ,@(if ttl
-                           `((cache-control (max-age . ,ttl)))
-                           '()))
-                   (lambda (port)
-                     (display (call-with-input-file cached
-                                read-string)
-                              port))))
+          ((stat cached #f)
+           =>
+           (lambda (stat)
+             ;; Narinfo is in cache: update its atime to reflect usage (in
+             ;; case the file system is mounted with 'noatime') and send it.
+             (let ((now ((@ (guile) current-time))))
+               (utime cached now (stat:mtime stat) 0 0))
+             (values `((content-type . (application/x-nix-narinfo))
+                       ,@(if ttl
+                             `((cache-control (max-age . ,ttl)))
+                             '()))
+                     (lambda (port)
+                       (display (call-with-input-file cached
+                                  read-string)
+                                port)))))
           ((and (file-exists? item)        ;cheaper than the 'valid-path?' RPC
                 (valid-path? store item))
            ;; Nothing in cache: bake the narinfo and nar in the background and