Subject: bug#45187: git download defaults to origin/master

From: Marius Bakke <[email-masked]>
Date: Sun, 13 Dec 2020 22:52:46 +0100

Kyle Meyer <[email-masked]> skriver:

> Ricardo Wurmus writes:
>
>> Importing https://github.com/immunogenomics/scpost with the CRAN
>> importer fails, because the git repository does not have an
>> origin/master branch.  This repository only has a “main” branch.
>>
>> Arguably, this shouldn’t matter, but (guix git) has the “master” name
>> set up as the default.  When cloning a repository it may be better to
>> fetch everything and select the default branch — whichever name it may
>> have.
>
> One option may be to use the remote HEAD symref.  That's probably the
> best indicator of what the primary branch is.  In a clone, it doesn't
> necessarily match HEAD on the remote, because users may change it to
> another branch they're interested in, but that isn't really relevant to
> these behind-the-scenes checkouts.
>
> Here's a quick and dirty demo that makes your reproducer work.  A real
> patch in this direction would of course look very different.

Another quick and dirty patch to make this specific example work ...

diff --git a/guix/git.scm b/guix/git.scm
index ca77b9f54b..0c49859e42 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -198,47 +198,11 @@ of SHA1 string."
     (last (string-split url #\/)) ".git" "")
    "-" (string-take sha1 7)))
 
-(define (resolve-reference repository ref)
-  "Resolve the branch, commit or tag specified by REF, and return the
-corresponding Git object."
-  (let resolve ((ref ref))
-    (match ref
-      (('branch . branch)
-       (let ((oid (reference-target
-                   (branch-lookup repository branch BRANCH-REMOTE))))
-         (object-lookup repository oid)))
-      (('commit . commit)
-       (let ((len (string-length commit)))
-         ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we
-         ;; can't be sure it's available.  Furthermore, 'string->oid' used to
-         ;; read out-of-bounds when passed a string shorter than 40 chars,
-         ;; which is why we delay calls to it below.
-         (if (< len 40)
-             (object-lookup-prefix repository (string->oid commit) len)
-             (object-lookup repository (string->oid commit)))))
-      (('tag-or-commit . str)
-       (if (or (> (string-length str) 40)
-               (not (string-every char-set:hex-digit str)))
-           (resolve `(tag . ,str))              ;definitely a tag
-           (catch 'git-error
-             (lambda ()
-               (resolve `(tag . ,str)))
-             (lambda _
-               ;; There's no such tag, so it must be a commit ID.
-               (resolve `(commit . ,str))))))
-      (('tag    . tag)
-       (let ((oid (reference-name->oid repository
-                                       (string-append "refs/tags/" tag))))
-         ;; OID may point to a "tag" object, but it can also point directly
-         ;; to a "commit" object, as surprising as it may seem.  Return that
-         ;; object, whatever that is.
-         (object-lookup repository oid))))))
-
 (define (switch-to-ref repository ref)
   "Switch to REPOSITORY's branch, commit or tag specified by REF.  Return the
 OID (roughly the commit hash) corresponding to REF."
   (define obj
-    (resolve-reference repository ref))
+    (revparse-single repository (cdr ref)))
 
   (reset repository obj RESET_HARD)
   (object-id obj))
@@ -320,7 +284,7 @@ definitely available in REPOSITORY, false otherwise."
 
 (define* (update-cached-checkout url
                                  #:key
-                                 (ref '(branch . "master"))
+                                 (ref '(branch . "HEAD"))
                                  recursive?
                                  (check-out? #t)
                                  starting-commit
@@ -349,7 +313,9 @@ it unchanged."
       (('branch . branch)
        `(branch . ,(if (string-prefix? "origin/" branch)
                        branch
-                       (string-append "origin/" branch))))
+                       (if (string=? "HEAD" branch)
+                           branch
+                           (string-append "origin/" branch)))))
       (_ ref)))
 
   (with-libgit2
@@ -370,8 +336,7 @@ it unchanged."
      ;; than letting users re-open the checkout later on.
      (let* ((oid      (if check-out?
                           (switch-to-ref repository canonical-ref)
-                          (object-id
-                           (resolve-reference repository canonical-ref))))
+                          (revparse-single repository (cdr canonical-ref))))
             (new      (and starting-commit
                            (commit-lookup repository oid)))
             (old      (and starting-commit
@@ -395,7 +360,7 @@ it unchanged."
                                    (log-port (%make-void-port "w"))
                                    (cache-directory
                                     (%repository-cache-directory))
-                                   (ref '(branch . "master")))
+                                   (ref '(branch . "HEAD")))
   "Return two values: the content of the git repository at URL copied into a
 store directory and the sha1 of the top level commit in this directory.  The
 reference to be checkout, once the repository is fetched, is specified by REF.
@@ -510,7 +475,7 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
   git-checkout make-git-checkout
   git-checkout?
   (url     git-checkout-url)
-  (branch  git-checkout-branch (default "master"))
+  (branch  git-checkout-branch (default "HEAD"))
   (commit  git-checkout-commit (default #f))      ;#f | tag | commit
   (recursive? git-checkout-recursive? (default #f)))
 
@@ -550,7 +515,7 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
     (($ <git-checkout> url branch commit recursive?)
      (latest-repository-commit* url
                                 #:ref (if commit
-                                          `(tag-or-commit . ,commit)
+                                          `(commit . ,commit)
                                           `(branch . ,branch))
                                 #:recursive? recursive?
                                 #:log-port (current-error-port)))))

I wonder if there was a specific reason to not use 'revparse-single',
and instead mostly reinvent it with (resolve-reference ...).

This approach can be simplified further by deprecating the 'commit' and
'branch' fields, and just use a single reference string.