[bug#65866] [PATCH 0/8] Add built-in builder for Git checkouts

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

Hi Ludovic,

Ludovic Courtès <ludo@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@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@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