branch master updated: Try to work around update-cached-checkout

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository data-service.

The following commit(s) were added to refs/heads/master by this push:
     new 695fce6  Try to work around update-cached-checkout
695fce6 is described below

commit 695fce69228fb66f74eba1403a61771d2c9e872d
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Wed Oct 11 16:25:51 2023 +0100

    Try to work around update-cached-checkout
    
    As it's causing problems with the guix-patches repository.
---
 guix-data-service/poll-git-repository.scm | 31 ++++++++++++++++++++++++++++++-
 1 file changed, 30 insertions(+), 1 deletion(-)

diff --git a/guix-data-service/poll-git-repository.scm 
b/guix-data-service/poll-git-repository.scm
index 6c9112b..ddc6aa7 100644
--- a/guix-data-service/poll-git-repository.scm
+++ b/guix-data-service/poll-git-repository.scm
@@ -24,7 +24,9 @@
   #:use-module (squee)
   #:use-module (git oid)
   #:use-module (git branch)
+  #:use-module (git remote)
   #:use-module (git reference)
+  #:use-module (git repository)
   #:use-module (guix git)
   #:use-module (guix channels)
   #:use-module (guix-data-service database)
@@ -60,6 +62,24 @@
              (sleep poll-interval)
              (loop)))))))))
 
+(define* (just-update-cached-checkout url
+                                      #:key
+                                      (ref '())
+                                      recursive?
+                                      (cache-directory
+                                       (url-cache-directory
+                                        url (%repository-cache-directory)
+                                        #:recursive? recursive?)))
+  (let* ((cache-exists? (openable-repository? cache-directory))
+         (repository    (if cache-exists?
+                            (repository-open cache-directory)
+                            ((@@ (guix git) clone/swh-fallback)
+                             url ref cache-directory))))
+    ;; Only fetch remote if it has not been cloned just before.
+    (when cache-exists?
+      (remote-fetch (remote-lookup repository "origin")
+                    #:fetch-options ((@@ (guix git) 
make-default-fetch-options))))))
+
 (define (poll-git-repository conn git-repository-id)
   (define git-repository-details
     (select-git-repository conn git-repository-id))
@@ -72,7 +92,16 @@
    (lambda ()
      ;; Maybe this helps avoid segfaults?
      (monitor
-      (update-cached-checkout (second git-repository-details)))
+      ;; This was using update-cached-checkout, but it wants to checkout
+      ;; refs/remotes/origin/HEAD by default, and that can fail for some
+      ;; reason on some repositories:
+      ;;
+      ;;   reference 'refs/remotes/origin/HEAD' not found
+      ;;
+      ;; I just want to update the cached checkout though, so trying to
+      ;; checkout some revision is unnecessary, hence
+      ;; just-update-cached-checkout
+      (just-update-cached-checkout (second git-repository-details)))
 
      (let* ((repository-directory
              (url-cache-directory