bug#38320: Cuirass: Allow to use authenticated Git repositories as inputs

["Ludovic Courtès" <ludo@gnu.org>]

Hi!

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> Here's a patch that add support for ssh authenticated repositories in
> "clone" and "remote-fetch" methods of Guile-Git.

Woow, awesome!

> At first, I used Guile-SSH in the tests to start an SSH server, but as
> "make-server" call of Guile-SSH is really low level, this is not very
> realistic. I just ended up with a half-broken ssh server, poorly
> implemented, after (too many hours) spent reading ssh dumps.

Oh, I thought it’d be easier to scrap bits from the example SSH server
that’s in Guile-SSH, perhaps a wishlist item for them.

> So the strategy is to spawn an openssh server for the tests. It seems to
> work alright, using key based or ssh-agent authentication.

Anyway, if it works with sshd, that’s great.

> From ae3c5a9851b02e78096963616d4e2f999119fc4d Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Mon, 9 Dec 2019 16:16:45 +0100
> Subject: [PATCH] Add ssh authentication support.
>
> * Makefile.am (SOURCES): Add git/auth.scm,
> (TESTS): add tests/clone.scm.
> * configure.ac: Check for git and ssh binaries.
> * git.scm (%public-modules): Add (git auth) and (git bindings).
> * git/auth.scm: New file.
> * git/clone.scm (clone): Add an auth-method argument. Pass it to
> new init-fetch-options call, before proceeding to clone.
> * git/remote.scm (remote-fetch): Add an auth-method. Pass it to
> init-fetch-options before proceeding to fetch.
> * git/structs.scm (clone-options-fetch-options): Do not return a copy of
> fetch-options nested inside clone-options. Instead, find the offset of
> fetch-options and use it to create a pointer to fetch-options.
> * git/fetch.scm (init-fetch-options): New exported procedure,
> (make-fetch-options): call the procedure above to initialize fetch-options,
> (set-fetch-auth-with-ssh-agent!): handle the case where username is not set
> and libgit2 asks for one.
> (set-fetch-auth-with-default-ssh-key!): remove this procedure,
> (set-fetch-auth-with-ssh-key): new procedure.
> * tests/.ssh/id_rsa_client: New file.
> * tests/.ssh/id_rsa_client.pub: New file.
> * tests/.ssh/id_rsa_server: New file.
> * tests/clone.scm: New file.
> * tests/ssh.scm.in: New file.

[...]

>  (define-module (git fetch)
>    #:use-module (system foreign)
> +  #:use-module (git auth)
>    #:use-module (git bindings)
>    #:use-module (git cred)
>    #:use-module (git structs)
>    #:use-module (git types)
>    #:use-module (srfi srfi-26)
>  
> -  #:export (make-fetch-options
> +  #:export (init-fetch-options
> +            make-fetch-options

I think we should keep ‘init-fetch-options’ private.

>              fetch-init-options   ;deprecated!

‘init-fetch-options’, ‘fetch-init-options’, hmm…  o_O

> new file mode 100644
> index 0000000..7e16000
> --- /dev/null
> +++ b/tests/.ssh/id_rsa_client

I wonder if we should generate those upon ‘make check’.  Thoughts?
(It shouldn’t be a blocker though.)

> +(with-sshd-server ssh-server-port
> + (with-repository "simple-bare" directory
> +   (test-equal "clone-auth-ssh-credentials"
> +     "3f848a1a52416ac99a5c5bf2e6bd55eb7b99d55b"
> +     (clone-test directory (make-client-ssh-auth))))
> +
> + (with-repository "simple-bare" directory
> +   (test-equal "clone-auth-ssh-agent"
> +     "3f848a1a52416ac99a5c5bf2e6bd55eb7b99d55b"
> +     (with-ssh-agent
> +      (clone-test directory (%make-auth-ssh-agent)))))
> +
> + (with-repository "simple-bare" directory
> +   (test-assert "clone-and-fetch-auth-ssh-credentials"
> +     (let* ((auth (make-client-ssh-auth))
> +            (do-clone (clone-test directory auth))
> +            (clone-dir (in-vicinity directory "out"))
> +            (repository (repository-open clone-dir))
> +            (remote (remote-lookup repository "origin")))
> +       (remote-fetch remote #:auth-method auth)
> +       #t))))

I think we should add something like:

  (define (sshd-available?)
    ;; Return #t if sshd is available (it does not support
    ;; ‘--version’ or anything similar though).
    (not (= 127 (system* sshd "--something-not-supported"))))

  (unless (sshd-available?) (test-skip 1))
  ;; …

Apart from this detail, it looks great to me!

You have push access, right?

Speaking of which, we really need to push a release at some point.
Erik, would you be available to do that, or would you like to delegate?

Thanks,
Ludo’.