Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Mon, 11 Sep 2023 14:25:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Ludovic Courtès <ludo <at> gnu.org> Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>, Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>, 65866 <at> debbugs.gnu.org, Christopher Baines <guix <at> cbaines.net> Subject: [bug#65866] [PATCH 0/8] Add built-in builder for Git checkouts Date: Wed, 20 Sep 2023 12:05:23 -0400
Hi Ludovic, Ludovic Courtès <ludo <at> gnu.org> writes: > * guix/build/git.scm (git-fetch-with-fallback): New procedure, with code > taken from… > * guix/git-download.scm (git-fetch): … here. > [modules]: Remove modules that are no longer directly used in ‘build’. > [build]: Use ‘git-fetch-with-fallback’. [...] > + > +(define* (git-fetch-with-fallback url commit directory > + #:key (git-command "git") recursive?) > + "Like 'git-fetch', fetch COMMIT from URL into DIRECTORY, but fall back to > +alternative methods when fetching from URL fails: attempt to download a nar, > +and if that also fails, download from the Software Heritage archive." > + (or (git-fetch url commit directory > + #:recursive? recursive? > + #:git-command git-command) > + (download-nar directory) > + > + ;; As a last resort, attempt to download from Software Heritage. > + ;; Disable X.509 certificate verification to avoid depending > + ;; on nss-certs--we're authenticating the checkout anyway. > + ;; XXX: Currently recursive checkouts are not supported. > + (and (not recursive?) I know this is code moved from elsewhere, but it seems it'd be useful to fail hard here with a proper error instead of returning #f silently? Or add support for recursive clones; was is missing to enable that? It's at least easy from the git CLI. > + (parameterize ((%verify-swh-certificate? #f)) > + (format (current-error-port) > + "Trying to download from Software Heritage...~%") > + > + (swh-download url commit directory) > + (when (file-exists? > + (string-append directory "/.gitattributes")) > + ;; Perform CR/LF conversion and other changes > + ;; specificied by '.gitattributes'. > + (invoke git-command "-C" directory "init") > + (invoke git-command "-C" directory "config" "--local" > + "user.email" "you <at> example.org") > + (invoke git-command "-C" directory "config" "--local" > + "user.name" "Your Name") > + (invoke git-command "-C" directory "add" ".") > + (invoke git-command "-C" directory "commit" "-am" "init") > + (invoke git-command "-C" directory "read-tree" "--empty") > + (invoke git-command "-C" directory "reset" "--hard") > + (delete-file-recursively > + (string-append directory "/.git"))))))) I'm not familiar with this code, but was wondering why we need to do this post processing and handle .gitattributes. I never care about this on my GNU/Linux machine when using 'git clone'. Perhaps 'git fetch' is used directly, which is why? Time passes... Ah! I misread -- that's peculiar to Software Heritage. > ;;; git.scm ends here > diff --git a/guix/git-download.scm b/guix/git-download.scm > index d88f4c40ee..8989b1b463 100644 > --- a/guix/git-download.scm > +++ b/guix/git-download.scm > @@ -116,19 +116,16 @@ (define* (git-fetch ref hash-algo hash > (define modules > (delete '(guix config) > (source-module-closure '((guix build git) > - (guix build utils) > - (guix build download-nar) > - (guix swh))))) > + (guix build utils))))) > > (define build > (with-imported-modules modules > - (with-extensions (list guile-json gnutls ;for (guix swh) > + (with-extensions (list guile-json gnutls ;for (guix swh) > guile-lzlib) > #~(begin > (use-modules (guix build git) > - (guix build utils) > - (guix build download-nar) > - (guix swh) > + ((guix build utils) > + #:select (set-path-environment-variable)) > (ice-9 match)) > > (define recursive? > @@ -151,38 +148,10 @@ (define* (git-fetch ref hash-algo hash > (setvbuf (current-output-port) 'line) > (setvbuf (current-error-port) 'line) > > - (or (git-fetch (getenv "git url") (getenv "git commit") > - #$output > - #:recursive? recursive? > - #:git-command "git") > - (download-nar #$output) > - > - ;; As a last resort, attempt to download from Software Heritage. > - ;; Disable X.509 certificate verification to avoid depending > - ;; on nss-certs--we're authenticating the checkout anyway. > - ;; XXX: Currently recursive checkouts are not supported. > - (and (not recursive?) > - (parameterize ((%verify-swh-certificate? #f)) > - (format (current-error-port) > - "Trying to download from Software Heritage...~%") > - > - (swh-download (getenv "git url") (getenv "git commit") > - #$output) > - (when (file-exists? > - (string-append #$output "/.gitattributes")) > - ;; Perform CR/LF conversion and other changes > - ;; specificied by '.gitattributes'. > - (invoke "git" "-C" #$output "init") > - (invoke "git" "-C" #$output "config" "--local" > - "user.email" "you <at> example.org") > - (invoke "git" "-C" #$output "config" "--local" > - "user.name" "Your Name") > - (invoke "git" "-C" #$output "add" ".") > - (invoke "git" "-C" #$output "commit" "-am" "init") > - (invoke "git" "-C" #$output "read-tree" "--empty") > - (invoke "git" "-C" #$output "reset" "--hard") > - (delete-file-recursively > - (string-append #$output "/.git")))))))))) > + (git-fetch-with-fallback (getenv "git url") (getenv "git commit") > + #$output > + #:recursive? recursive? > + #:git-command "git"))))) > > (mlet %store-monad ((guile (package->derivation guile system))) > (gexp->derivation (or name "git-checkout") build LGTM. -- Thanks, Maxim
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.