cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Try to work around update-cached-checkout

Browse source 
As it's causing problems with the guix-patches repository.
This commit is contained in:
Christopher Baines 2023-10-11 16:25:51 +01:00
parent d72b9a5239
commit 695fce6922
1 changed files with 30 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

31
guix-data-service/poll-git-repository.scm
View file

@ -24,7 +24,9 @@
#:use-module (squee) #:use-module (squee)
#:use-module (git oid) #:use-module (git oid)
#:use-module (git branch) #:use-module (git branch)
#:use-module (git remote)
#:use-module (git reference) #:use-module (git reference)
#:use-module (git repository)
#:use-module (guix git) #:use-module (guix git)
#:use-module (guix channels) #:use-module (guix channels)
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
@ -60,6 +62,24 @@
(sleep poll-interval) (sleep poll-interval)
(loop))))))))) (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 (poll-git-repository conn git-repository-id)
(define git-repository-details (define git-repository-details
(select-git-repository conn git-repository-id)) (select-git-repository conn git-repository-id))
@ -72,7 +92,16 @@
(lambda () (lambda ()
;; Maybe this helps avoid segfaults? ;; Maybe this helps avoid segfaults?
(monitor (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 (let* ((repository-directory
(url-cache-directory (url-cache-directory