From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id yPoGMV+9H2K9GgEAgWs5BA (envelope-from ) for ; Wed, 02 Mar 2022 19:54:23 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id QM+fLV+9H2IpRQEAauVa8A (envelope-from ) for ; Wed, 02 Mar 2022 19:54:23 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 41B85134E0 for ; Wed, 2 Mar 2022 19:54:23 +0100 (CET) Received: from localhost ([::1]:58836 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nPU7C-0001Mn-Dq for larch@yhetil.org; Wed, 02 Mar 2022 13:54:22 -0500 Received: from eggs.gnu.org ([209.51.188.92]:36912) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nPTku-0002EE-5r for guix-devel@gnu.org; Wed, 02 Mar 2022 13:31:20 -0500 Received: from [2607:f8b0:4864:20::135] (port=39618 helo=mail-il1-x135.google.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nPTkq-0000Nc-S3 for guix-devel@gnu.org; Wed, 02 Mar 2022 13:31:19 -0500 Received: by mail-il1-x135.google.com with SMTP id i1so2109835ilu.6 for ; Wed, 02 Mar 2022 10:31:15 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=beadling-co-uk.20210112.gappssmtp.com; s=20210112; h=mime-version:from:date:message-id:subject:to; bh=rEdFt7XUioE4E3nBMR2XRqRXXP73pEC/5lc1i46VHN0=; b=OTORHO2gc+vgD1CiQnBSYyAyf0P/gJiP5mI9aGY2bPkB1EKA/gBennG9Hwid0rch9P Qb4yy9DJ9ap+8XyO30hjpvjSUXHsHIGhZ3dnujtJCkIIKTKX/k3YHaDCplujRTv3GTQE hUo4nfirNydY1Sk99KliUcGWnMsHOkqnVcRqnSRGLdaotF5kbbOPNxXoMf9VwLPUrflZ dSS/IvcxxlgbTjSVr4VDXyouDI6X7IXOFW75avoAI+1o8AD/efIw1FeXg8ZpB+4gYyWV cKRd2ZP7889SorINFf/R2wVsG5lbLpijWzsb2X1I2oQ+Io0oiCnAj27EakBx6Oebg9Uc S+xg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:mime-version:from:date:message-id:subject:to; bh=rEdFt7XUioE4E3nBMR2XRqRXXP73pEC/5lc1i46VHN0=; b=dEuaE9ylEE+WouRhkIsl4RgcSPe/7DnUDsphGASjsEEdxztPUGj7rdYaORydExMDKZ 3T1U1u9HKHL46tpt3v0mlMQbVPMA1MUgH7iS4m5SmuGaVPuhLwff+IIRrm2FBXu5H/cl 3T6Q0EDaGDagna9IDsf1+6WZ/8Suyjyzc4hfw09+owNe1To6gdMgE+0p4u8SlF/hS/Kb wkGGjcP0KcJvb47tshAcI4G59xbH+8Vi7BevACCNEcSJaoWHGeHEEUml89u3M39xN4NO oHCsT7GtqQzooTTwI4koJSRj3r7xydBafbIZWBMuGGzmhUuwwCVrjrLmgXvdlZTfFnPL upJA== X-Gm-Message-State: AOAM5337P+G0IJO2JbclAU5RjbqNg4HYlPyNNxybwRCvZW0Mem9UYR5n WyBUrFHQ1zM4/8mqCaAn1gL/8VyrhNCtpilI6GKLJcLd6l1TI+4x X-Google-Smtp-Source: ABdhPJzit2sFUVWYjpZxsn18q0x5wCvqLH+0onUUY0D5xgFZdUD3h9edPVRBsrE+PjilrZ0uS8f4Ma/gY9D9lzpWMDY= X-Received: by 2002:a05:6e02:1647:b0:2c2:c19b:8b1e with SMTP id v7-20020a056e02164700b002c2c19b8b1emr20699266ilu.30.1646245874793; Wed, 02 Mar 2022 10:31:14 -0800 (PST) MIME-Version: 1.0 From: Phil Date: Wed, 2 Mar 2022 18:31:03 +0000 Message-ID: Subject: Help to workaround libgit2 fetch refs issue To: Guix Devel Content-Type: multipart/alternative; boundary="000000000000949d6c05d9407c44" X-Host-Lookup-Failed: Reverse DNS lookup failed for 2607:f8b0:4864:20::135 (failed) Received-SPF: none client-ip=2607:f8b0:4864:20::135; envelope-from=phil@beadling.co.uk; helo=mail-il1-x135.google.com X-Spam_score_int: -4 X-Spam_score: -0.5 X-Spam_bar: / X-Spam_report: (-0.5 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, HTML_MESSAGE=0.001, PDS_HP_HELO_NORDNS=0.659, RCVD_IN_DNSWL_NONE=-0.0001, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_NONE=0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+larch=yhetil.org@gnu.org Sender: "Guix-devel" X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1646247263; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=rEdFt7XUioE4E3nBMR2XRqRXXP73pEC/5lc1i46VHN0=; b=KfrlIFRCIzHSvU+QoNLsTokm7snaC9JaTn7FgcRwWuptrkK+tzhG4aNG0YPN4N9NGh2w5R MAQGQls+CJvvyTVC93qlIZmDsMf7gIy2thSFmd3S9E+1+9kjQu+13ehGt4+ubFVynzkqO+ wQt5gSqWzyda3IRXDNQSPibP7nEpQxYXjwH4uV2bsFxXfTwqc33fhBS4pjTmSgYY1vJyIQ KNkZqrcXddTJBI3I1bTiPVqLpX9syeG+vhJDiYbuh/DERq2HQmTWujxXgSNyv44LNx93IO fgloGxj2yzsyF5ARuUm8orVjK9KYSm80ifJSRRXI7xvWnZS4RvVAzSeju9URvg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1646247263; a=rsa-sha256; cv=none; b=sYo7nkE48nlZFiXUKHIeUz/jYWCP3k5ExGkK1yUx5ai+IuYWGahBuCMMlyBU1WcDes/Pdk IZINpJGI4SHEjJKs10NU6Se59zbCc3G942Ka36dipHviqyWr/um4i21E1WUx9/3hK9wHmG gESBEpoYCtf7rK9EY6MovknkCL/gRNXvgAVmxWaO014O+mpGPdoMAGaMc6I7WYP4PpHp8m bMDoXl+hMChA1cbmdFC8CVthzEl8eFy9ZHPNZatHinKAiv0+kVkca7Qfff6HTXAzUu39sZ 40yT9CEWxH0MNwl7Po0a4tLr6R1hDvFH6pbeKJkQmeyfMR1BZbjpkbydYDOsNw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=beadling-co-uk.20210112.gappssmtp.com header.s=20210112 header.b=OTORHO2g; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -8.58 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=beadling-co-uk.20210112.gappssmtp.com header.s=20210112 header.b=OTORHO2g; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-devel-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-devel-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 41B85134E0 X-Spam-Score: -8.58 X-Migadu-Scanner: scn0.migadu.com X-TUID: if1iqOvPmVJg --000000000000949d6c05d9407c44 Content-Type: text/plain; charset="UTF-8" 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 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: [ | | | ]. 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 [ | | ]. 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 ) 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 (($ 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))))) --000000000000949d6c05d9407c44 Content-Type: text/html; charset="UTF-8" Content-Transfer-Encoding: quoted-printable
Hi Guixers,

I raised an issu= e on libgit2 which effects the use of Guix with SSH git clones and addition= al references:
<= br>
The issue in summary is that if I want to build off a non-sta= ndard git reference (say, a Pull Request), then even if I update my git con= fig to include that, eg:
remote.origin.fetch=3D+refs/pull-request= s/*/merge:refs/remotes/origin/pr/*

libgit2's initial clone will not pull down the extra refs, despite this being t= he behaviour of the git command line tool proper.=C2=A0 After the initial c= lone, the git config is adhered to.

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

Whilst the proper so= lution 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):

If nothing else= I was hoping to learn a bit more about how packages were compiled as the d= etails are a bit of blindspot for me!=C2=A0 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=C2=A0 update-cached-checkout when the source is r= ead from the package.

(I should also mention t= hat the far simpler option of providing a new "fetch" function li= ke url-fetch or git-fetch doesn't work for me as the repo I'm acces= sing happens to require SSH authentication and thus I'm using the metho= d as outlined here:=C2=A0 http://issues.guix.gnu.org/issue/31285#4 )

So I have something like:
=C2=A0 =C2=A0 (package
=C2=A0 =C2= =A0 =C2=A0 (name "my-test-repo")
=C2=A0 =C2=A0 =C2=A0 (version= production-version)
=C2=A0 =C2=A0 =C2=A0 (source
=C2=A0 =C2=A0 =C2= =A0 =C2=A0(git-checkout-x-refs
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (url &= quot;ssh://git@bitbucket:7999/ea/my-test-repo.git")
=C2=A0 =C2=A0 = =C2=A0 =C2=A0 (commit commit-production)))
=C2=A0 =C2=A0 =C2=A0 (build-s= ystem python-build-system)
=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 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.=C2=A0 Having the record = and git code as part of my local channel is wrong, I know, but I'm look= ing a short term workaround with the least disruptive footprint whilst I im= plement and then wait for release of the strategic solution, probably in li= bgit2.

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 coul= d confirm this and/or give me a pointer of where the compliation occurs (wh= ere the record in the source is handled and compiled into a git clone) - ev= en if my approach is (quite possibly) unviable, I'd like to understand = why!


Thanks,
Phil.
<= div>

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

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

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

__= _______________________________________________

I = put this in=20 /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= )
=C2=A0 #:use-module (git) ;; libgit
=C2=A0 #:use-module (guix git) = ;; CAREFUL could clash!
=C2=A0 #:use-module (guix records) ;; define-rec= ord-type*
=C2=A0 #:use-module (guix gexp)
=C2=A0 #:use-module (ice-9 = ftw) ;; scandir
=C2=A0 #:use-module (ice-9 match)
=C2=A0 #:use-module= (srfi srfi-11) ;; let*-values
=C2=A0 #:export (git-checkout-x-refs
= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 git-checkout-x-refs?
=C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 git-checkout-x-refs-url
=C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0 git-checkout-x-refs-branch
=C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 git-checkout-x-refs-commit
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 git-checkout-z-refs-recursive?))

;; local f= unctions stolen from guix git
(define clone/swh-fallback (@@ (guix git) = clone/swh-fallback))
(define with-libgit2 (@@ (guix git) with-libgit2))<= br>
;;;
;;; Checkouts.
;;;

;; Representation of the "l= atest" checkout of a branch or a specific commit.
;; Shadows git-ch= eckout but uses difference function to get the repo.
(define-record-type= * <git-checkout-x-refs>
=C2=A0 git-checkout-x-refs make-git-checko= ut-x-refs
=C2=A0 git-checkout-x-refs?
=C2=A0 (url =C2=A0 =C2=A0 git-c= heckout-x-refs-url)
=C2=A0 (branch =C2=A0git-checkout-x-refs-branch (def= ault #f))
=C2=A0 (commit =C2=A0git-checkout-x-refs-commit (default #f)) = =C2=A0 =C2=A0 =C2=A0;#f | tag | commit
=C2=A0 (recursive? git-checkout-x= -refs-recursive? (default #f)))


(define* (update-cached-checkout= -x-ref url
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0#:key
=C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(ref '())
=C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0recursive?
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0(check-out? #t)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0st= arting-commit
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(log-port (%m= ake-void-port "w"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0(cache-directory
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (url-cac= he-directory
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0url (%rep= ository-cache-directory)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0#:recursive? recursive?)))
=C2=A0 "Update the cached checkout= of URL to REF in CACHE-DIRECTORY.=C2=A0 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 [br= anch | commit | tag | tag-or-commit ] and value
the associated data: [&l= t;branch name> | <sha1> | <tag name> | <string>].
I= f REF is the empty list, the remote HEAD is used.
When RECURSIVE? is tru= e, check out submodules as well, if any.
When CHECK-OUT? is true, reset = the cached working tree to REF; otherwise leave
it unchanged."
= =C2=A0 (define (cache-entries directory)
=C2=A0 =C2=A0 (filter-map (matc= h-lambda
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = ((or "." "..")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0#f)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0 (file
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(string-append directory "/" fi= le)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (or (scand= ir directory) '())))

=C2=A0 (define canonical-ref
=C2=A0 =C2= =A0 ;; We used to require callers to specify "origin/" for each b= ranch, which
=C2=A0 =C2=A0 ;; made little sense since the cache should b= e transparent to them.=C2=A0 So
=C2=A0 =C2=A0 ;; here we append "or= igin/" if it's missing and otherwise keep it.
=C2=A0 =C2=A0 (ma= tch ref
=C2=A0 =C2=A0 =C2=A0 (() '(symref . "refs/remotes/origi= n/HEAD"))
=C2=A0 =C2=A0 =C2=A0 (('branch . branch)
=C2=A0 = =C2=A0 =C2=A0 =C2=A0`(branch . ,(if (string-prefix? "origin/" bra= nch)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0branch
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(string-append "origin/" branc= h))))
=C2=A0 =C2=A0 =C2=A0 (_ ref)))

=C2=A0 (with-libgit2
=C2= =A0 =C2=A0(let* ((cache-exists? (openable-repository? cache-directory))
= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (repository =C2=A0 =C2=A0(if cache-exist= s?
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(repository-open cache-directory)
=C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0(clone/swh-fallback url ref cache-directory)))) = ;; if the cache doesn't exist, clone
=C2=A0 =C2=A0 =C2=A0;; Alway= s fetch remote, even if it has not been cloned just before.
=C2=A0 =C2= =A0 =C2=A0(when ;;(and cache-exists?
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 (not (reference-available? repository ref)) ;;)=C2=A0 =C2=A0 =C2=A0 =C2=A0(remote-fetch (remote-lookup repository "o= rigin")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0#:fetch-options (make-default-fetch-options)))
=C2=A0 = =C2=A0 =C2=A0(when recursive?
=C2=A0 =C2=A0 =C2=A0 =C2=A0(update-submodu= les repository #:log-port log-port
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 #:fetch-options (ma= ke-default-fetch-options)))

=C2=A0 =C2=A0 =C2=A0;; Note: call 'c= ommit-relation' from here because it's more efficient
=C2=A0 =C2= =A0 =C2=A0;; than letting users re-open the checkout later on.
=C2=A0 = =C2=A0 =C2=A0(let* ((oid =C2=A0 =C2=A0 =C2=A0(if check-out?
=C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 (switch-to-ref repository canonical-ref)
=C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (object-= id
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0(resolve-reference repository canonical-ref))))=
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (new =C2=A0 =C2=A0 =C2=A0(and= starting-commit
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(commit-lookup repository oid)))<= br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (old =C2=A0 =C2=A0 =C2=A0(and = starting-commit
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(false-if-git-not-found
=C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (commit-lookup repository
=C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(string->oid startin= g-commit)))))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (relation (and s= tarting-commit
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(if old
=C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0(commit-relation old new)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0'unrelated))))

=C2=A0 =C2=A0 =C2=A0 =C2=A0;; Reclaim f= ile descriptors and memory mappings associated with
=C2=A0 =C2=A0 =C2=A0= =C2=A0;; REPOSITORY as soon as possible.
=C2=A0 =C2=A0 =C2=A0 =C2=A0(re= pository-close! repository)

=C2=A0 =C2=A0 =C2=A0 =C2=A0;; Update CAC= HE-DIRECTORY's mtime to so the cache logic sees it.
=C2=A0 =C2=A0 = =C2=A0 =C2=A0(match (gettimeofday)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0((s= econds . microseconds)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (let ((nanosec= onds (* 1000 microseconds)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (= utime cache-directory
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0seconds seconds
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0nanoseconds nanoseconds))))

=C2=A0= =C2=A0 =C2=A0 =C2=A0;; When CACHE-DIRECTORY is a sub-directory of the defa= ult cache
=C2=A0 =C2=A0 =C2=A0 =C2=A0;; directory, remove expired checko= uts that are next to it.
=C2=A0 =C2=A0 =C2=A0 =C2=A0(let ((parent (dirna= me cache-directory)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(when (string=3D= ? parent (%repository-cache-directory))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0(maybe-remove-expired-cache-entries parent cache-entries
=C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0#:entry-expiration
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0cached-checkout-= expiration
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0#:delete-entry delete-checkout
=C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0#:cleanup-period
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0%checkout-cache-cleanup= -period)))

=C2=A0 =C2=A0 =C2=A0 =C2=A0(values cache-directory (oid-&= gt;string oid) relation)))))



(define* (latest-repository-com= mit-x-ref store url
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0#:= key
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0recursive?
= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(log-port (%make-void-p= ort "w"))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(c= ache-directory
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (%rep= ository-cache-directory))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0(ref '()))
=C2=A0 "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.=C2=A0 The
reference to be checkout, = once the repository is fetched, is specified by REF.
REF is pair whose k= ey is [branch | commit | tag] and value the associated
data, respectivel= y [<branch name> | <sha1> | <tag name>].=C2=A0 If REF is = the empty
list, the remote HEAD is used.
When RECURSIVE? is true, che= ck out submodules as well, if any.
Git repositories are kept in the cach= e directory specified by
%repository-cache-directory parameter.
Log p= rogress and checkout info to LOG-PORT."
=C2=A0 (define (dot-git? fi= le stat)
=C2=A0 =C2=A0 (and (string=3D? (basename file) ".git"= )
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(or (eq? 'directory (stat:type s= tat))

=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0;; Submodule c= heckouts end up with a '.git' regular file that
=C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0;; contains metadata about where their ac= tual '.git' directory
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0;; lives.
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(and rec= ursive?
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (= eq? 'regular (stat:type stat))))))

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



(define* (latest-repository-commit-x-re= fs* url #:key ref recursive? log-port)
=C2=A0 ;; Monadic variant of '= ;latest-repository-commit-x-refs'.
=C2=A0 (lambda (store)
=C2=A0 = =C2=A0 ;; The caller--e.g., (guix scripts build)--may not handle 'git-e= rror' so
=C2=A0 =C2=A0 ;; translate it into '&message' c= onditions that we know will be properly
=C2=A0 =C2=A0 ;; handled.
=C2= =A0 =C2=A0 (catch 'git-error
=C2=A0 =C2=A0 =C2=A0 (lambda ()
=C2= =A0 =C2=A0 =C2=A0 =C2=A0 (values (latest-repository-commit-x-ref store url<= br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0#:ref ref
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0#:recursive? recursi= ve?
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0#:log-port log-port)
=C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 store))
=C2=A0 =C2=A0 =C2=A0 (lambda (ke= y error . _)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (raise (condition
=C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (&message
=C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(message
=C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (match ref
=C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (('commi= t . commit)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0(format #f (G_ "cannot fetch commit ~a from ~a: ~a&qu= ot;)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0commit url (git-error-message error))= )
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = (('branch . branch)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0(format #f (G_ "cannot fetch branch '~= a' from ~a: ~a")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0branch url (git-= error-message error)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 (_
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 =C2=A0(format #f (G_ "Git failure while fetching= ~a: ~a")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0url (git-error-message erro= r))))))))))))



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

--000000000000949d6c05d9407c44--