Help to workaround libgit2 fetch refs issue

Help to workaround libgit2 fetch refs issue

[Phil]

[-- Attachment #1: Type: text/plain, Size: 13750 bytes --]

Hi Guixers,

I raised an issue on libgit2 which effects the use of Guix with SSH git
clones and additional references:
https://github.com/libgit2/libgit2/issues/6183

The issue in summary is that if I want to build off a non-standard git
reference (say, a Pull Request), then even if I update my git config to
include that, eg:
remote.origin.fetch=+refs/pull-requests/*/merge:refs/remotes/origin/pr/*

libgit2's* initial clone* will not pull down the extra refs, despite this
being the behaviour of the git command line tool proper.  After the initial
clone, the git config is adhered to.

In Guix this means that the first time I build a PR it fails, and I have to
do something like "guix build  foo | guix build foo" which is at best a
clumsy hack, but it works!

Whilst the proper solution will be be done in libgit2 I was thinking if I
could quickly improve on my double-build workaround *without* having to
change Guix itself here (by *always *fetching):
https://github.com/guix-mirror/guix/blob/6adce1538d2df6fa2d68abc13ae94e2fa826d124/guix/git.scm#L466

If nothing else I was hoping to learn a bit more about how packages were
compiled as the details are a bit of blindspot for me!  So my plan was to
duplicate the git-checkout record and it's G-Exp compiler such that I could
redirect to a modified version of  update-cached-checkout when the source
is read from the package.

(I should also mention that the far simpler option of providing a new
"fetch" function like url-fetch or git-fetch doesn't work for me as the
repo I'm accessing happens to require SSH authentication and thus I'm using
the method as outlined here:  http://issues.guix.gnu.org/issue/31285#4 )

So I have something like:
    (package
      (name "my-test-repo")
      (version production-version)
      (source
       (git-checkout*-x-refs*
        (url "ssh://git@bitbucket:7999/ea/my-test-repo.git")
        (commit commit-production)))
      (build-system python-build-system)
      and so on....

The code I've naively duplicated is at the bottom of this e-mail - it
builds OK, so is syntactically correct, but fails when I reference it in a
package like above.  Having the record and git code as part of my local
channel is wrong, I know, but I'm looking a short term workaround with the
least disruptive footprint whilst I implement and then wait for release of
the strategic solution, probably in libgit2.

I suspect the reason for the failure is that I'd have to import my new
duplicated module somewhere in the Guix core code to make this work - i.e.
having the code in the channel is never going to work?

I was wondering if anyway could confirm this and/or give me a pointer of
where the compliation occurs (where the record in the source is handled and
compiled into a git clone) - even if my approach is (quite possibly)
unviable, I'd like to understand why!


Thanks,
Phil.


$ guix build -L /home/phil/git/guix/guix-packages/packages my-test-repo

guix build: warning: source expression failed to match any pattern
error: git-checkout-x-refs: unbound variable
hint: Did you forget `(use-modules (my-tools git))'?

guix build: error: my-test-repo: unknown package

_________________________________________________

I put this in /home/phil/git/guix/guix-packages/package/my-tools/git.scm-
I've marked the actual change in *bold *- everything else is just
boilerplate.

;; -*- mode: scheme; eval: (guix-devel-mode 1);
geiser-scheme-implementation: guile -*-

(define-module (my-tools git)
  #:use-module (git) ;; libgit
  #:use-module (guix git) ;; CAREFUL could clash!
  #:use-module (guix records) ;; define-record-type*
  #:use-module (guix gexp)
  #:use-module (ice-9 ftw) ;; scandir
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-11) ;; let*-values
  #:export (git-checkout-x-refs
            git-checkout-x-refs?
            git-checkout-x-refs-url
            git-checkout-x-refs-branch
            git-checkout-x-refs-commit
            git-checkout-z-refs-recursive?))

;; local functions stolen from guix git
(define clone/swh-fallback (@@ (guix git) clone/swh-fallback))
(define with-libgit2 (@@ (guix git) with-libgit2))

;;;
;;; Checkouts.
;;;

;; Representation of the "latest" checkout of a branch or a specific commit.
;; Shadows git-checkout but uses difference function to get the repo.
(define-record-type* <git-checkout-x-refs>
  git-checkout-x-refs make-git-checkout-x-refs
  git-checkout-x-refs?
  (url     git-checkout-x-refs-url)
  (branch  git-checkout-x-refs-branch (default #f))
  (commit  git-checkout-x-refs-commit (default #f))      ;#f | tag | commit
  (recursive? git-checkout-x-refs-recursive? (default #f)))


(define* (update-cached-checkout-x-ref url
                                 #:key
                                 (ref '())
                                 recursive?
                                 (check-out? #t)
                                 starting-commit
                                 (log-port (%make-void-port "w"))
                                 (cache-directory
                                  (url-cache-directory
                                   url (%repository-cache-directory)
                                   #:recursive? recursive?)))
  "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return
three
values: the cache directory name, and the SHA1 commit (a string)
corresponding
to REF, and the relation of the new commit relative to STARTING-COMMIT (if
provided) as returned by 'commit-relation'.
REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
the associated data: [<branch name> | <sha1> | <tag name> | <string>].
If REF is the empty list, the remote HEAD is used.
When RECURSIVE? is true, check out submodules as well, if any.
When CHECK-OUT? is true, reset the cached working tree to REF; otherwise
leave
it unchanged."
  (define (cache-entries directory)
    (filter-map (match-lambda
                  ((or "." "..")
                   #f)
                  (file
                   (string-append directory "/" file)))
                (or (scandir directory) '())))

  (define canonical-ref
    ;; We used to require callers to specify "origin/" for each branch,
which
    ;; made little sense since the cache should be transparent to them.  So
    ;; here we append "origin/" if it's missing and otherwise keep it.
    (match ref
      (() '(symref . "refs/remotes/origin/HEAD"))
      (('branch . branch)
       `(branch . ,(if (string-prefix? "origin/" branch)
                       branch
                       (string-append "origin/" branch))))
      (_ ref)))

  (with-libgit2
   (let* ((cache-exists? (openable-repository? cache-directory))
          (repository    (if cache-exists?
                             (repository-open cache-directory)
                             (clone/swh-fallback url ref
cache-directory)))) ;; if the cache doesn't exist, clone


*     ;; Always fetch remote, even if it has not been cloned just before.
   (when ;;(and cache-exists?                (not (reference-available?
repository ref)) ;;)*
       (remote-fetch (remote-lookup repository "origin")
                     #:fetch-options (make-default-fetch-options)))
     (when recursive?
       (update-submodules repository #:log-port log-port
                          #:fetch-options (make-default-fetch-options)))

     ;; Note: call 'commit-relation' from here because it's more efficient
     ;; 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))))
            (new      (and starting-commit
                           (commit-lookup repository oid)))
            (old      (and starting-commit
                           (false-if-git-not-found
                            (commit-lookup repository
                                           (string->oid starting-commit)))))
            (relation (and starting-commit
                           (if old
                               (commit-relation old new)
                               'unrelated))))

       ;; Reclaim file descriptors and memory mappings associated with
       ;; REPOSITORY as soon as possible.
       (repository-close! repository)

       ;; Update CACHE-DIRECTORY's mtime to so the cache logic sees it.
       (match (gettimeofday)
         ((seconds . microseconds)
          (let ((nanoseconds (* 1000 microseconds)))
            (utime cache-directory
                   seconds seconds
                   nanoseconds nanoseconds))))

       ;; When CACHE-DIRECTORY is a sub-directory of the default cache
       ;; directory, remove expired checkouts that are next to it.
       (let ((parent (dirname cache-directory)))
         (when (string=? parent (%repository-cache-directory))
           (maybe-remove-expired-cache-entries parent cache-entries
                                               #:entry-expiration
                                               cached-checkout-expiration
                                               #:delete-entry
delete-checkout
                                               #:cleanup-period

 %checkout-cache-cleanup-period)))

       (values cache-directory (oid->string oid) relation)))))



(define* (latest-repository-commit-x-ref store url
                                   #:key
                                   recursive?
                                   (log-port (%make-void-port "w"))
                                   (cache-directory
                                    (%repository-cache-directory))
                                   (ref '()))
  "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.
REF is pair whose key is [branch | commit | tag] and value the associated
data, respectively [<branch name> | <sha1> | <tag name>].  If REF is the
empty
list, the remote HEAD is used.
When RECURSIVE? is true, check out submodules as well, if any.
Git repositories are kept in the cache directory specified by
%repository-cache-directory parameter.
Log progress and checkout info to LOG-PORT."
  (define (dot-git? file stat)
    (and (string=? (basename file) ".git")
         (or (eq? 'directory (stat:type stat))

             ;; Submodule checkouts end up with a '.git' regular file that
             ;; contains metadata about where their actual '.git' directory
             ;; lives.
             (and recursive?
                  (eq? 'regular (stat:type stat))))))

  (format log-port "updating checkout of '~a'...~%" url)
  (let*-values
      (((checkout commit _)
        (update-cached-checkout-x-ref url
                                #:recursive? recursive?
                                #:ref ref
                                #:cache-directory
                                (url-cache-directory url cache-directory
                                                     #:recursive?
                                                     recursive?)
                                #:log-port log-port))
       ((name)
        (url+commit->name url commit)))
    (format log-port "retrieved commit ~a~%" commit)
    (values (add-to-store store name #t "sha256" checkout
                          #:select? (negate dot-git?))
            commit)))



(define* (latest-repository-commit-x-refs* url #:key ref recursive?
log-port)
  ;; Monadic variant of 'latest-repository-commit-x-refs'.
  (lambda (store)
    ;; The caller--e.g., (guix scripts build)--may not handle 'git-error' so
    ;; translate it into '&message' conditions that we know will be properly
    ;; handled.
    (catch 'git-error
      (lambda ()
        (values (latest-repository-commit-x-ref store url
                                               #:ref ref
                                               #:recursive? recursive?
                                               #:log-port log-port)
                store))
      (lambda (key error . _)
        (raise (condition
                (&message
                 (message
                  (match ref
                    (('commit . commit)
                     (format #f (G_ "cannot fetch commit ~a from ~a: ~a")
                             commit url (git-error-message error)))
                    (('branch . branch)
                     (format #f (G_ "cannot fetch branch '~a' from ~a: ~a")
                             branch url (git-error-message error)))
                    (_
                     (format #f (G_ "Git failure while fetching ~a: ~a")
                             url (git-error-message error))))))))))))



(define-gexp-compiler (git-checkout-x-refs-compiler (checkout
<git-checkout-x-refs>)
                                                    system target)
  ;; "Compile" CHECKOUT by updating the local checkout and adding it to the
  ;; store.  Handle the libgit2 issue by fetching refs, even on a clone.
  (match checkout
    (($ <git-checkout-x-refs> url branch commit recursive?)
     (latest-repository-commit-x-refs* url
                                       #:ref (cond (commit
                                                    `(tag-or-commit .
,commit))
                                                   (branch
                                                    `(branch . ,branch))
                                                   (else '()))
                                       #:recursive? recursive?
                                       #:log-port (current-error-port)))))

[-- Attachment #2: Type: text/html, Size: 17440 bytes --]

Re: Help to workaround libgit2 fetch refs issue

[Liliana Marie Prikler]

Hi Phil,

Am Mittwoch, dem 02.03.2022 um 18:31 +0000 schrieb Phil:
> Hi Guixers,
> 
> I raised an issue on libgit2 which effects the use of Guix with SSH
> git clones and additional references:
> https://github.com/libgit2/libgit2/issues/6183
> 
> The issue in summary is that if I want to build off a non-standard
> git reference (say, a Pull Request), then even if I update my git
> config to include that, eg:
> remote.origin.fetch=+refs/pull-
> requests/*/merge:refs/remotes/origin/pr/*
> 
> libgit2's initial clone will not pull down the extra refs, despite
> this being the behaviour of the git command line tool proper.  After
> the initial clone, the git config is adhered to.
This portion of the bug is in libgit2 and thus is for libgit2 to care
about.

> In Guix this means that the first time I build a PR it fails, and I
> have to do something like "guix build  foo | guix build foo" which is
> at best a clumsy hack, but it works!
Note that you could alternatively just use the requesting repo URL in
the git-reference.  Ah, but that would be too boring, wouldn't it?

> Whilst the proper solution will be be done in libgit2 I was thinking
> if I could quickly improve on my double-build workaround without
> having to change Guix itself here (by always fetching):
> https://github.com/guix-mirror/guix/blob/6adce1538d2df6fa2d68abc13ae94e2fa826d124/guix/git.scm#L466
> 
> If nothing else I was hoping to learn a bit more about how packages
> were compiled as the details are a bit of blindspot for me!  So my
> plan was to duplicate the git-checkout record and it's G-Exp compiler
> such that I could redirect to a modified version of  update-cached-
> checkout when the source is read from the package.
> 
> (I should also mention that the far simpler option of providing a new
> "fetch" function like url-fetch or git-fetch doesn't work for me as
> the repo I'm accessing happens to require SSH authentication and thus
> I'm using the method as outlined here: 
> http://issues.guix.gnu.org/issue/31285#4 )
> 
> So I have something like:
>     (package
>       (name "my-test-repo")
>       (version production-version)
>       (source
>        (git-checkout-x-refs
>         (url "ssh://git@bitbucket:7999/ea/my-test-repo.git")
>         (commit commit-production)))
>       (build-system python-build-system)
>       and so on....
> 
> The code I've naively duplicated is at the bottom of this e-mail - it
> builds OK, so is syntactically correct, but fails when I reference it
> in a package like above.  Having the record and git code as part of
> my local channel is wrong, I know, but I'm looking a short term
> workaround with the least disruptive footprint whilst I implement and
> then wait for release of the strategic solution, probably in libgit2.
I don't think using a new record type is the way to go.  You only want
to change the behaviour of git-fetch into git-fetch/additional-refs.

> I suspect the reason for the failure is that I'd have to import my
> new duplicated module somewhere in the Guix core code to make this
> work - i.e. having the code in the channel is never going to work?
> 
> I was wondering if anyway could confirm this and/or give me a pointer
> of where the compliation occurs (where the record in the source is
> handled and compiled into a git clone) - even if my approach is
> (quite possibly) unviable, I'd like to understand why!
The source field of a package is not thunked, so it is compiled in the
package definition itself, rather than handed off.  Note that every
hack of doing something fancyful usually invokes at least a delay form,
see e.g. the computed-origin-method used by linux-libre.  Hope that
helps.

Cheers

Re: Help to workaround libgit2 fetch refs issue

[Phil]

[-- Attachment #1: Type: text/plain, Size: 13780 bytes --]

Thanks for the reply Liliana,

On Wed, 2 Mar 2022 at 21:06, Liliana Marie Prikler <
liliana.prikler@gmail.com> wrote:

>
> >> In Guix this means that the first time I build a PR it fails, and I
> >> have to do something like "guix build  foo | guix build foo" which is
> >> at best a clumsy hack, but it works!
> >Note that you could alternatively just use the requesting repo URL in
> >the git-reference.  Ah, but that would be too boring, wouldn't it?
>

Ha ha - indeed far too boring :-) If you're suggesting I use an HTTP(S)/URL
to access the repository, then annoingly in my specific case the repo is
password protected - this is why I turned to SSH in the first place so I
could use keys to authenticate.  Or I'm missing the point?



> >> I was wondering if anyway could confirm this and/or give me a pointer
> >> of where the compliation occurs (where the record in the source is
> >> handled and compiled into a git clone) - even if my approach is
> >>(quite possibly) unviable, I'd like to understand why!
> >The source field of a package is not thunked, so it is compiled in the
> >package definition itself, rather than handed off.  Note that every
> >hack of doing something fancyful usually invokes at least a delay form,
> >see e.g. the computed-origin-method used by linux-libre.  Hope that
> >helps.
>
>
Yes - thanks for the hints, I got there in the end.  Just to confirm that
although perhaps not the most elegant workaround, I eventually got the idea
to work.

My original effort lacked the exports for the below, and a few other
missing items private to (guix git).
update-cached-checkout-x-ref
latest-repository-commit-x-ref

Having dug a bit deeper into how the hash table for %gexp-compilers is
setup as a mapping of to record type descriptior to gexp-compiler, I've got
a better understanding now of how package compilation works so it was a
worthy if experiment :-)

I've included what I think is a true minimal implementation, borrowing from
(guix git) where possible to minimize duplication - in case anyone else
ever stumbles into the same issue (although it's pretty niche, I admit!).

Now to go and fix it properly in libgit2....


;; -*- mode: scheme; eval: (guix-devel-mode 1);
geiser-scheme-implementation: guile -*-


;; This is an alternative to guix-checkout record type, which always does a
fetch
;; even after the initial clone.
;; This is required because of a bug in libgit2 which means that fresh
clones
;; don't pull down any additional refs from the git config:
;; https://github.com/libgit2/libgit2/issues/6183

;; Once this is fixed and Guix builds against the fixed version this should
;; be removed.

(define-module (my-tools git)
  #:use-module (git) ;; openable-repository
  #:use-module (guix git) ;; avoid duplication - use all public members
from here
  #:use-module (guix cache) ;; maybe-remove-expired-cache-entries
  #:use-module (guix store) ;; add-to-store
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (ice-9 match)
  #:use-module (ice-9 ftw) ;; scandir
  #:use-module (srfi srfi-1) ;; filter-map
  #:use-module (srfi srfi-11) ;; let*-values
  #:export (
            update-cached-checkout-x-ref
            latest-repository-commit-x-ref

            git-checkout-x-refs
            git-checkout-x-refs?
            git-checkout-x-refs-url
            git-checkout-x-refs-branch
            git-checkout-x-refs-commit
            git-checkout-x-refs-recursive?))


;; Avoid duplicating required private functions
(define make-default-fetch-options (@@ (guix git)
make-default-fetch-options))
(define resolve-reference (@@ (guix git) resolve-reference))
(define clone/swh-fallback (@@ (guix git) clone/swh-fallback))
(define switch-to-ref (@@ (guix git) switch-to-ref))
(define update-submodules (@@ (guix git) update-submodules))
(define reference-available? (@@ (guix git) reference-available?))
(define cached-checkout-expiration (@@ (guix git)
cached-checkout-expiration))
(define %checkout-cache-cleanup-period (@@ (guix git)
%checkout-cache-cleanup-period))
(define delete-checkout (@@ (guix git) delete-checkout))
(define print-git-error (@@ (guix git) print-git-error))


(define* (update-cached-checkout-x-ref url
                                       #:key
                                       (ref '())
                                       recursive?
                                       (check-out? #t)
                                       starting-commit
                                       (log-port (%make-void-port "w"))
                                       (cache-directory
                                        (url-cache-directory
                                         url (%repository-cache-directory)
                                         #:recursive? recursive?)))
  "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return
three
values: the cache directory name, and the SHA1 commit (a string)
corresponding
to REF, and the relation of the new commit relative to STARTING-COMMIT (if
provided) as returned by 'commit-relation'.

REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
the associated data: [<branch name> | <sha1> | <tag name> | <string>].
If REF is the empty list, the remote HEAD is used.

When RECURSIVE? is true, check out submodules as well, if any.

When CHECK-OUT? is true, reset the cached working tree to REF; otherwise
leave
it unchanged."
  (define (cache-entries directory)
    (filter-map (match-lambda
                  ((or "." "..")
                   #f)
                  (file
                   (string-append directory "/" file)))
                (or (scandir directory) '())))

  (define canonical-ref
    ;; We used to require callers to specify "origin/" for each branch,
which
    ;; made little sense since the cache should be transparent to them.  So
    ;; here we append "origin/" if it's missing and otherwise keep it.
    (match ref
      (() '(symref . "refs/remotes/origin/HEAD"))
      (('branch . branch)
       `(branch . ,(if (string-prefix? "origin/" branch)
                       branch
                       (string-append "origin/" branch))))
      (_ ref)))

  ((@@ (guix git) with-libgit2)
   (let* ((cache-exists? (openable-repository? cache-directory))
          (repository    (if cache-exists?
                             (repository-open cache-directory)
                             (clone/swh-fallback url ref cache-directory))))
     ;; Always fetch remote, even if it has been cloned just before.
     (when ;; <---- THIS IS WHERE THE CHANGE IS FROM DEFAULT BEHAVIOR
         (not (reference-available? repository ref))
       (remote-fetch (remote-lookup repository "origin")
                     #:fetch-options (make-default-fetch-options)))
     (when recursive?
       (update-submodules repository #:log-port log-port
                          #:fetch-options (make-default-fetch-options)))

     ;; Note: call 'commit-relation' from here because it's more efficient
     ;; 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))))
            (new      (and starting-commit
                           (commit-lookup repository oid)))
            (old      (and starting-commit
                           (false-if-git-not-found
                            (commit-lookup repository
                                           (string->oid starting-commit)))))
            (relation (and starting-commit
                           (if old
                               (commit-relation old new)
                               'unrelated))))

       ;; Reclaim file descriptors and memory mappings associated with
       ;; REPOSITORY as soon as possible.
       (repository-close! repository)

       ;; Update CACHE-DIRECTORY's mtime to so the cache logic sees it.
       (match (gettimeofday)
         ((seconds . microseconds)
          (let ((nanoseconds (* 1000 microseconds)))
            (utime cache-directory
                   seconds seconds
                   nanoseconds nanoseconds))))

       ;; When CACHE-DIRECTORY is a sub-directory of the default cache
       ;; directory, remove expired checkouts that are next to it.
       (let ((parent (dirname cache-directory)))
         (when (string=? parent (%repository-cache-directory))
           (maybe-remove-expired-cache-entries parent cache-entries
                                               #:entry-expiration
                                               cached-checkout-expiration
                                               #:delete-entry
delete-checkout
                                               #:cleanup-period

 %checkout-cache-cleanup-period)))

       (values cache-directory (oid->string oid) relation)))))



(define* (latest-repository-commit-x-ref store url
                                         #:key
                                         recursive?
                                         (log-port (%make-void-port "w"))
                                         (cache-directory
                                          (%repository-cache-directory))
                                         (ref '()))
  "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.
REF is pair whose key is [branch | commit | tag] and value the associated
data, respectively [<branch name> | <sha1> | <tag name>].  If REF is the
empty
list, the remote HEAD is used.

When RECURSIVE? is true, check out submodules as well, if any.

Git repositories are kept in the cache directory specified by
%repository-cache-directory parameter.

Log progress and checkout info to LOG-PORT."
  (define (dot-git? file stat)
    (and (string=? (basename file) ".git")
         (or (eq? 'directory (stat:type stat))

             ;; Submodule checkouts end up with a '.git' regular file that
             ;; contains metadata about where their actual '.git' directory
             ;; lives.
             (and recursive?
                  (eq? 'regular (stat:type stat))))))

  (format log-port "updating checkout of '~a'...~%" url)
  (let*-values
      (((checkout commit _)
        (update-cached-checkout-x-ref url
                                      #:recursive? recursive?
                                      #:ref ref
                                      #:cache-directory
                                      (url-cache-directory url
cache-directory
                                                           #:recursive?
                                                           recursive?)
                                      #:log-port log-port))
       ((name)
        (url+commit->name url commit)))
    (format log-port "retrieved commit ~a~%" commit)
    (values (add-to-store store name #t "sha256" checkout
                          #:select? (negate dot-git?))
            commit)))


(set-exception-printer! 'git-error print-git-error)


;;;
;;; Checkouts.
;;;



;; Representation of the "latest" checkout of a branch or a specific commit.
(define-record-type* <git-checkout-x-refs>
  git-checkout-x-refs make-git-checkout-x-refs
  git-checkout-x-refs?
  (url     git-checkout-x-refs-url)
  (branch  git-checkout-x-refs-branch (default #f))
  (commit  git-checkout-x-refs-commit (default #f))      ;#f | tag | commit
  (recursive? git-checkout-x-refs-recursive? (default #f)))



(define* (latest-repository-commit* url #:key ref recursive? log-port)
  ;; Monadic variant of 'latest-repository-commit'.
  (lambda (store)
    ;; The caller--e.g., (guix scripts build)--may not handle 'git-error' so
    ;; translate it into '&message' conditions that we know will be properly
    ;; handled.
    (catch 'git-error
      (lambda ()
        (values (latest-repository-commit-x-ref store url
                                                #:ref ref
                                                #:recursive? recursive?
                                                #:log-port log-port)
                store))
      (lambda (key error . _)
        (raise (condition
                (&message
                 (message
                  (match ref
                    (('commit . commit)
                     (format #f (G_ "cannot fetch commit ~a from ~a: ~a")
                             commit url (git-error-message error)))
                    (('branch . branch)
                     (format #f (G_ "cannot fetch branch '~a' from ~a: ~a")
                             branch url (git-error-message error)))
                    (_
                     (format #f (G_ "Git failure while fetching ~a: ~a")
                             url (git-error-message error))))))))))))



(define-gexp-compiler (git-checkout-x-refs-compiler (checkout
<git-checkout-x-refs>)
                                                    system target)
  ;; "Compile" CHECKOUT by updating the local checkout and adding it to the
  ;; store.
  (match checkout
    (($ <git-checkout-x-refs> url branch commit recursive?)
     (latest-repository-commit* url
                                #:ref (cond (commit
                                             `(tag-or-commit . ,commit))
                                            (branch
                                             `(branch . ,branch))
                                            (else '()))
                                #:recursive? recursive?
                                #:log-port (current-error-port)))))

[-- Attachment #2: Type: text/html, Size: 17617 bytes --]

Re: Help to workaround libgit2 fetch refs issue

[Phil]

Just to add....

Duplicating of guix-checkout in a private channel has side-effects - if
anyone has any ideas of how to workaround this, I'd be love to
discuss... alas, at this point I think I have 3 temporary options:

1) Patch in my local Guix and roll my own build of Guix (see below)
2) Workaround outside of Guix by cloning the repo for Guix not using libgit2
3) Tell my CI/CD to continue to build all my PRs twice if the first
build fails.

Details below.

Phil writes:

> Thanks for the reply Liliana,
>
> On Wed, 2 Mar 2022 at 21:06, Liliana Marie Prikler <liliana.prikler@gmail.com> wrote:
>
> I've included what I think is a true minimal implementation, borrowing from (guix git) where possible to minimize duplication - in
> case anyone else ever stumbles into the same issue (although it's pretty niche, I admit!).

Whilst my original post works it restricts the use of --with-branch and
--with-commit options with packages that use my new record type.

It's now obvious why, looking at package-git-url it only handles origin
and git-checkout records.  I need to add my git-checkout-x-ref here too:

(define (package-git-url package)
  "Return the URL of the Git repository for package, or raise an error if
the source of PACKAGE is not fetched from a Git repository."
  (let ((source (package-source package)))
    (cond ((and (origin? source)
                (git-reference? (origin-uri source)))
           (git-reference-url (origin-uri source)))
          ((git-checkout? source)
           (git-checkout-url source))
          (else
           (raise
            (formatted-message (G_ "the source of ~a is not a Git reference")
                               (package-full-name package)))))))

Re: Help to workaround libgit2 fetch refs issue

[Liliana Marie Prikler]

Am Freitag, dem 04.03.2022 um 09:34 +0000 schrieb Phil:
> Just to add....
> 
> Duplicating of guix-checkout in a private channel has side-effects -
> if anyone has any ideas of how to workaround this, I'd be love to
> discuss... alas, at this point I think I have 3 temporary options:
> 
> 1) Patch in my local Guix and roll my own build of Guix (see below)
> 2) Workaround outside of Guix by cloning the repo for Guix not using
> libgit2
> 3) Tell my CI/CD to continue to build all my PRs twice if the first
> build fails.
> 
> [...]
Again I wonder what the introduction of a new record type solves here.
Wouldn't it be easier to just adapt git-fetch to handle that edge case
and use normal git-references?  Origin methods have network access, so
you can pretty much do whatever.

Cheers

Re: Help to workaround libgit2 fetch refs issue

[Phil]

Thanks Liliana for the reply,

Liliana Marie Prikler writes:

> Am Freitag, dem 04.03.2022 um 09:34 +0000 schrieb Phil:
> Again I wonder what the introduction of a new record type solves here.
> Wouldn't it be easier to just adapt git-fetch to handle that edge case
> and use normal git-references?  Origin methods have network access, so
> you can pretty much do whatever.
>
> Cheers

The problem with an origin record using git-fetch is that it doesn't
seem to work for key-authenticated repos using SSH.

If I try to change the git-checkout for the standard git-fetch
incantation:

Original:

(git-checkout
        (url "ssh://git@bitbucket:7999/foo/bar.git")
        (commit commit-production)))

Proposed:

      (source
       (origin
         (method git-fetch)
         (uri (git-reference
               (url "ssh://git@bitbucket:7999/foo/bar.git")
               (commit commit-production)))
         (sha256
          (base32 "0s9dpj0jdkqcg552f00jhd722czji4pffabmpys5pgi6djckq4f4"))))


This fails because git-fetch is unable to use ssh because it seems to
run inside a container?

Initialized empty Git repository in /gnu/store/dbcl57jcrvaavjrj8qwpwskl7sfpzqb4-git-checkout/.git/
error: cannot run ssh: No such file or directory
fatal: unable to fork
Failed to do a shallow fetch; retrying a full fetch...
error: cannot run ssh: No such file or directory
fatal: unable to fork

Even if it did find ssh, it would not have access from the daemon to the SSH Agent
environment variables setup by the user to allow access to the SSH Key.

This is covered here I think, and a patch was proposed, but it was
dropped in favour for the original solution above in the original thread:
http://issues.guix.gnu.org/issue/31285

I did think about perhaps resurrecting the proposed "git-fetch/impure"
as shown in the patch of guix-download.scm in the link immediately
above, but I was hoping for a quicker win with duplicating the record -
alas that has it's own significant limitations tho.

If I'm missing another trick with git-fetch I'd glady be proved wrong!
:-)

Cheers

Re: Help to workaround libgit2 fetch refs issue

[zimoun]

Hi Phil,

On Sat, 05 Mar 2022 at 11:57, Phil <phil@beadling.co.uk> wrote:

> (git-checkout
>         (url "ssh://git@bitbucket:7999/foo/bar.git")
>         (commit commit-production)))

Why this is not enough for your use case?  As mentioned in [1].

1: <https://issues.guix.gnu.org/issue/31285#4>


> This is covered here I think, and a patch was proposed, but it was
> dropped in favour for the original solution above in the original thread:
> http://issues.guix.gnu.org/issue/31285

The closing message says:

        Yes, this does work.  Combined with the fact that it is now
        possible to "guix pull" channels over SSH, there is no need for
        this patch any more.  The "git-checkout" gexp-compiler basically
        does the same thing that I was trying to do (it is still
        "impure" in that the fetching happens outside the store), but it
        does it more elegantly.

        <https://issues.guix.gnu.org/issue/31285#6>

so instead of…

> I did think about perhaps resurrecting the proposed "git-fetch/impure"
> as shown in the patch of guix-download.scm in the link immediately
> above, but I was hoping for a quicker win with duplicating the record -
> alas that has it's own significant limitations tho.

…maybe the location is “git-checkout” gexp-compiler and see what is
missing for covering your use-case.


Cheers,
simon