guix
/
data-service
mirror of git://git.savannah.gnu.org/guix/data-service.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Attempt to fetch this Git polling mess 

Listing remote branches through libgit2 will list branches that don't exist on
the remote. I think branch-list is more listing branch references, and you can
have references to a remote branch where the remote branch doesn't exist. This
isn't very useful here though, as I'm trying to work out what remote branches
exist.

There's remote-ls which might help, but I can't figure out how to get the
commits for branches from that.

Therefore, just bodge the two things together in to a big mess. I seem to be
able to get commits from branch-list that hopefully match what's on the
remote (although I'm not confident about this), and I think remote-ls does
allow checking what branches exist.
This commit is contained in:
Christopher Baines 2023-10-11 17:53:38 +01:00
parent 70f1824e46
commit 82bb174700
1 changed files with 34 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
guix-data-service/poll-git-repository.scm
View File

@ -112,21 +112,42 @@
conn
git-repository-id))
;; remote-ls returns remote-head's where the oid's aren't like the
;; oid's found through branches, and I'm not sure how to handle
;; them. Work around this by just using remote-ls to check what
;; branches exist on the remote.
(remote-branch-names
(with-repository repository-directory repository
(let ((remote (remote-lookup repository "origin")))
(remote-connect remote)
(filter-map
(lambda (rh)
(let ((name (remote-head-name rh)))
(if (string-prefix? "refs/heads/" name)
(string-drop name
(string-length "refs/heads/"))
#f)))
(remote-ls remote)))))
(repository-branches
(with-repository repository-directory repository
(map
(filter-map
(lambda (branch-reference)
(let* ((branch-name
(last
(string-split
(reference-shorthand branch-reference)
#\/))))
(cons
branch-name
;; TODO Not sure what the right way to do this is
(and=> (false-if-exception
(reference-target branch-reference))
oid->string))))
(string-drop (reference-shorthand branch-reference)
(string-length "origin/"))))
(and
;; branch-list may list branches which don't exist on the
;; remote, so use the information from remote-ls to
;; filter them out
(member branch-name remote-branch-names)
(cons
branch-name
;; TODO Not sure what the right way to do this is
(and=> (false-if-exception
(reference-target branch-reference))
oid->string)))))
(branch-list repository BRANCH-REMOTE)))))
(with-postgresql-transaction
@ -187,7 +208,8 @@
git-repository-id
repository-commit
"poll"))))
(if database-commit
(if (or (not database-commit)
(string=? database-commit ""))
#f ;; Nothing to do
(insert-git-commit-entry conn
(git-branch-entry)