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

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

[Clément Lassieur]

Hi,

I'd like to use private Git repositories as inputs, authenticated with
SSH.

I think it is important because it would encourage users to use Cuirass
for other purposes than just a CI tool to build Guix packages.  I'd like
to see it as an alternative to Jenkins, it would make its user base
broader.

My use of Cuirass, for example, is to do continuous integration on my
own personal projects.  So each of my inputs is a personnal private
repository, and each time one of those inputs has a new commit, the
'proc' will give Cuirass a derivation of the Guix package corresponding
to the updated input, with a modified 'origin' so that it matches the
new input.

My workaround for authentication is to use local repositories, updated
with an external cron task.

I think there are small modifications to do to (guix git) and (git
clone).

Cheers,
Clément

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

[Mathieu Othacehe]

Hello Clément,

> I think there are small modifications to do to (guix git) and (git
> clone).

I did integrate a part of libgit2 ssh authentification mechanism in
Guile-Git in 2017. You can find it in (git fetch) module.

It is currently broken, because of a regression. See
https://lists.gnu.org/archive/html/guix-devel/2019-11/msg00415.html.

What would be missing to have support for authenticated Git repositories
as Cuirass inputs is:

* Fix the regression mentionned above.

* Add support for a fetch-options argument in clone method of (git clone).

* In (guix git), "latest-repository-commit" method would take parameters
to setup ssh authentication (such as ssh private key path at least) and
pass them to "fetch" and "clone" methods of Guile-Git.

* Finally in Cuirass, the ssh authentication parameters could be
specified in the specification file (maybe for each input?) and passed
to "latest-repository-commit" method accordingly.

So there's still some work to do :)

Mathieu

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

[Mathieu Othacehe]

> * Fix the regression mentionned above.

I would need some help for this regression I don't understand, but I
will take care of the work needed in Guile-Git and (guix git) once this
is fixed.

I think too that extending Cuirass to support new use-cases would be
really great :).

Thanks,

Mathieu

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

[Clément Lassieur]

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

>> * Fix the regression mentionned above.
>
> I would need some help for this regression I don't understand, but I
> will take care of the work needed in Guile-Git and (guix git) once this
> is fixed.

Thank you Mathieu for your replies!  I'm looking forward to your work :)

> I think too that extending Cuirass to support new use-cases would be
> really great :).

And some of the new use-cases are low-hanging fruits actually.

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

[Ludovic Courtès]

Hi Mathieu,

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

>> I think there are small modifications to do to (guix git) and (git
>> clone).
>
> I did integrate a part of libgit2 ssh authentification mechanism in
> Guile-Git in 2017. You can find it in (git fetch) module.
>
> It is currently broken, because of a regression. See
> https://lists.gnu.org/archive/html/guix-devel/2019-11/msg00415.html.

Oh I missed that message of yours.  Do you have a complete example using
that functionality that I could use as a test?

It would be great to have a test for that in Guile-Git.  We could use
Guile-SSH, when it’s available, to spawn an SSH server.

> What would be missing to have support for authenticated Git repositories
> as Cuirass inputs is:
>
> * Fix the regression mentionned above.
>
> * Add support for a fetch-options argument in clone method of (git clone).
>
> * In (guix git), "latest-repository-commit" method would take parameters
> to setup ssh authentication (such as ssh private key path at least) and
> pass them to "fetch" and "clone" methods of Guile-Git.
>
> * Finally in Cuirass, the ssh authentication parameters could be
> specified in the specification file (maybe for each input?) and passed
> to "latest-repository-commit" method accordingly.

I’d like to see that happen!

Thanks,
Ludo’.

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

[Mathieu Othacehe]

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


Hello,

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

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.

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

WDYT?

Mathieu

[-- Attachment #2: 0001-Add-ssh-authentication-support.patch --]
[-- Type: text/x-diff, Size: 26557 bytes --]

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.
---
 .gitignore                   |   4 ++
 Makefile.am                  |   2 +
 configure.ac                 |   9 ++-
 git.scm                      |   3 +-
 git/auth.scm                 |  38 ++++++++++++
 git/clone.scm                |  17 ++++--
 git/fetch.scm                |  77 +++++++++++++++--------
 git/remote.scm               |  11 ++--
 git/structs.scm              |  13 +++-
 guix.scm                     |   5 +-
 tests/.ssh/id_rsa_client     |  27 ++++++++
 tests/.ssh/id_rsa_client.pub |   1 +
 tests/.ssh/id_rsa_server     |  27 ++++++++
 tests/clone.scm              |  68 +++++++++++++++++++++
 tests/ssh.scm.in             | 115 +++++++++++++++++++++++++++++++++++
 15 files changed, 378 insertions(+), 39 deletions(-)
 create mode 100644 git/auth.scm
 create mode 100644 tests/.ssh/id_rsa_client
 create mode 100644 tests/.ssh/id_rsa_client.pub
 create mode 100644 tests/.ssh/id_rsa_server
 create mode 100644 tests/clone.scm
 create mode 100644 tests/ssh.scm.in

diff --git a/.gitignore b/.gitignore
index 5d6d9c7..d32d05a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -28,3 +28,7 @@ doc/guile-git.info
 doc/version.texi
 doc/.dirstamp
 doc/stamp-vti
+
+tests/ssh.scm
+tests/.ssh/authorized_keys
+tests/.ssh/sshd.conf
diff --git a/Makefile.am b/Makefile.am
index fba200a..facf9fa 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -28,6 +28,7 @@ SOURCES =                           \
   git.scm                           \
   git/annotated.scm                 \
   git/attr.scm                      \
+  git/auth.scm                      \
   git/bindings.scm                  \
   git/blame.scm                     \
   git/blob.scm                      \
@@ -75,6 +76,7 @@ TESTS_UTILS =                                   \
 
 TESTS =                                         \
   tests/branch.scm                              \
+  tests/clone.scm                               \
   tests/commit.scm                              \
   tests/describe.scm                            \
   tests/oid.scm                                 \
diff --git a/configure.ac b/configure.ac
index 5171aba..933679c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -42,7 +42,14 @@ AS_IF([test "x$LIBGIT2_LIBDIR" = "x"], [
 ])
 AC_SUBST([LIBGIT2_LIBDIR])
 
-AC_CONFIG_FILES([Makefile git/config.scm])
+dnl Those binaries are required for ssh authentication tests.
+AC_PATH_PROG([SSHD], [sshd])
+AC_PATH_PROG([SSH_AGENT], [ssh-agent])
+AC_PATH_PROG([SSH_ADD], [ssh-add])
+AC_PATH_PROG([GIT_UPLOAD_PACK], [git-upload-pack])
+AC_SUBST([SSHD])
+
+AC_CONFIG_FILES([Makefile git/config.scm tests/ssh.scm])
 AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
 
 AC_OUTPUT
diff --git a/git.scm b/git.scm
index 1559504..873101e 100644
--- a/git.scm
+++ b/git.scm
@@ -23,7 +23,8 @@
 (eval-when (eval load compile)
   (begin
     (define %public-modules
-      '((git bindings)
+      '((git auth)
+        (git bindings)
         (git branch)
         (git clone)
         (git commit)
diff --git a/git/auth.scm b/git/auth.scm
new file mode 100644
index 0000000..c43af6e
--- /dev/null
+++ b/git/auth.scm
@@ -0,0 +1,38 @@
+;;; Guile-Git --- GNU Guile bindings of libgit2
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of Guile-Git.
+;;;
+;;; Guile-Git is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Guile-Git is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guile-Git.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (git auth)
+  #:use-module (srfi srfi-9)
+  #:export (%make-auth-ssh-credentials
+            auth-ssh-credentials?
+            auth-ssh-credentials-public-key
+            auth-ssh-credentials-private-key
+            auth-ssh-credentials-password-key
+
+            %make-auth-ssh-agent
+            auth-ssh-agent?))
+
+(define-record-type <auth-ssh-credentials>
+  (%make-auth-ssh-credentials public-key private-key)
+  auth-ssh-credentials?
+  (public-key    auth-ssh-credentials-public-key)
+  (private-key   auth-ssh-credentials-private-key))
+
+(define-record-type <auth-ssh-agent>
+  (%make-auth-ssh-agent)
+  auth-ssh-agent?)
diff --git a/git/clone.scm b/git/clone.scm
index 7f06528..a42c1f7 100644
--- a/git/clone.scm
+++ b/git/clone.scm
@@ -21,6 +21,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (system foreign)
   #:use-module (git bindings)
+  #:use-module (git fetch)
   #:use-module (git structs)
   #:use-module (git types)
   #:use-module (git repository)
@@ -34,11 +35,17 @@
 
 (define clone
   (let ((proc (libgit2->procedure* "git_clone" '(* * * *))))
-    (lambda* (url directory #:optional (clone-options (make-clone-options)))
-      "Clones a remote repository found at URL into DIRECTORY.
-
-Returns the repository on success or throws an error on failure."
-      (let ((out (make-double-pointer)))
+    (lambda* (url directory
+                  #:optional (clone-options (make-clone-options))
+                  #:key (auth-method #f))
+      "Clones a remote repository found at URL into DIRECTORY.  An
+authentication method from (git auth) can be passed optionally if the
+repository is protected.  Returns the repository on success or throws an error
+on failure."
+      (let* ((out (make-double-pointer))
+             (fetch-options
+              (clone-options-fetch-options clone-options)))
+        (init-fetch-options fetch-options auth-method)
         (proc out
               (string->pointer url)
               (string->pointer directory)
diff --git a/git/fetch.scm b/git/fetch.scm
index da18bbe..1ac0bf8 100644
--- a/git/fetch.scm
+++ b/git/fetch.scm
@@ -1,5 +1,5 @@
 ;;; Guile-Git --- GNU Guile bindings of libgit2
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2017, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of Guile-Git.
 ;;;
@@ -18,25 +18,37 @@
 
 (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
             fetch-init-options   ;deprecated!
             set-fetch-auth-with-ssh-agent!
+            set-fetch-auth-with-ssh-key!
             set-fetch-auth-with-default-ssh-key!))
 
 (define FETCH-OPTIONS-VERSION 1)
 
-(define make-fetch-options
-  (let ((proc (libgit2->procedure* "git_fetch_init_options" `(* ,unsigned-int))))
-    (lambda ()
-      (let ((fetch-options (make-fetch-options-bytestructure)))
-        (proc (fetch-options->pointer fetch-options) FETCH-OPTIONS-VERSION)
-        fetch-options))))
+(define init-fetch-options
+  (let ((proc (libgit2->procedure* "git_fetch_init_options"
+                                   `(* ,unsigned-int))))
+    (lambda* (fetch-options #:optional auth-method)
+      (proc (fetch-options->pointer fetch-options) FETCH-OPTIONS-VERSION)
+      (cond
+       ((auth-ssh-credentials? auth-method)
+        (set-fetch-auth-with-ssh-key! fetch-options auth-method))
+       ((auth-ssh-agent? auth-method)
+        (set-fetch-auth-with-ssh-agent! fetch-options)))
+      fetch-options)))
+
+(define* (make-fetch-options #:optional auth-method)
+  (let ((fetch-options (make-fetch-options-bytestructure)))
+    (init-fetch-options fetch-options auth-method)))
 
 (define fetch-init-options
   ;; Deprecated alias for compatibility with 0.2.
@@ -52,20 +64,37 @@
    fetch-options
    (cred-acquire-cb
     (lambda (cred url username allowed payload)
-      (cred-ssh-key-from-agent cred
-                               (pointer->string username))))))
+      (let ((username (if (eq? username %null-pointer)
+                          ""
+                          (pointer->string username))))
+        (cond
+         ;; If no username were specified in URL, we will be asked for
+         ;; one. Try with the current user login.
+         ((= allowed CREDTYPE-SSH-USERNAME)
+          (cred-username-new cred (getlogin)))
+         (else
+          (cred-ssh-key-from-agent cred username))))))))
 
-(define (set-fetch-auth-with-default-ssh-key! fetch-options)
-  (let* ((home (getenv "HOME"))
-         (ssh-dir (in-vicinity home ".ssh"))
-         (pub-key (in-vicinity ssh-dir "id_rsa.pub"))
-         (pri-key (in-vicinity ssh-dir "id_rsa")))
-    (set-fetch-auth-callback
-     fetch-options
-     (cred-acquire-cb
-      (lambda (cred url username allowed payload)
-        (cred-ssh-key-new cred
-                          (pointer->string username)
-                          pub-key
-                          pri-key
-                          ""))))))
+(define* (set-fetch-auth-with-ssh-key! fetch-options
+                                       auth-ssh-credentials)
+  (set-fetch-auth-callback
+   fetch-options
+   (cred-acquire-cb
+    (lambda (cred url username allowed payload)
+      (cond
+       ;; Same as above.
+       ((= allowed CREDTYPE-SSH-USERNAME)
+        (cred-username-new cred (getlogin)))
+       (else
+        (let* ((pri-key-file
+                (auth-ssh-credentials-private-key auth-ssh-credentials))
+               (pub-key-file
+                (auth-ssh-credentials-public-key auth-ssh-credentials))
+               (username (if (eq? username %null-pointer)
+                             ""
+                             (pointer->string username))))
+          (cred-ssh-key-new cred
+                            username
+                            pub-key-file
+                            pri-key-file
+                            ""))) )))))
diff --git a/git/remote.scm b/git/remote.scm
index b889dd2..e39aaf6 100644
--- a/git/remote.scm
+++ b/git/remote.scm
@@ -21,6 +21,7 @@
   #:use-module (srfi srfi-9 gnu)
   #:use-module (system foreign)
   #:use-module (git bindings)
+  #:use-module (git fetch)
   #:use-module (git structs)
   #:use-module (git types)
   #:export (remote-name
@@ -99,13 +100,15 @@
 
 (define remote-fetch
   (let ((proc (libgit2->procedure* "git_remote_fetch" '(* * * *))))
-    (lambda* (remote #:key (reflog-message "") (fetch-options #f))
+    (lambda* (remote #:key
+                     (reflog-message "")
+                     (fetch-options (make-fetch-options))
+                     (auth-method #f))
+      (init-fetch-options fetch-options auth-method)
       (proc (remote->pointer remote)
             ;; FIXME https://libgit2.github.com/libgit2/#HEAD/type/git_strarray
             %null-pointer
-            (if fetch-options
-                (fetch-options->pointer fetch-options)
-                %null-pointer)
+            (fetch-options->pointer fetch-options)
             (string->pointer reflog-message)))))
 
 ;; FIXME https://libgit2.github.com/libgit2/#HEAD/group/reset/git_reset_default
diff --git a/git/structs.scm b/git/structs.scm
index e854d51..9e1597a 100644
--- a/git/structs.scm
+++ b/git/structs.scm
@@ -53,7 +53,7 @@
             fetch-options-download-tags set-fetch-options-download-tags!
             set-fetch-options-callbacks! set-remote-callbacks-credentials!
 
-            make-clone-options-bytestructure clone-options->pointer clone-options-fetch-options
+            make-clone-options-bytestructure clone-options-bytestructure clone-options->pointer clone-options-fetch-options
 
             make-describe-options-bytestructure describe-options->pointer describe-options->bytestructure
             set-describe-options-max-candidates-tag! set-describe-options-strategy!
@@ -466,8 +466,15 @@ tag policy in FETCH-OPTIONS."
   (bytestructure->pointer (clone-options-bytestructure clone-options)))
 
 (define (clone-options-fetch-options clone-options)
-  (%make-fetch-options
-   (bytestructure-ref (clone-options-bytestructure clone-options) 'fetch-opts)))
+  (let* ((fetch-options-bs
+          (bytestructure-ref
+           (clone-options-bytestructure clone-options) 'fetch-opts))
+         (fetch-options-offset (bytestructure-offset fetch-options-bs))
+         (fetch-options-pointer (bytevector->pointer
+                                 (bytestructure-bytevector fetch-options-bs)
+                                 fetch-options-offset)))
+    (%make-fetch-options
+     (pointer->bytestructure fetch-options-pointer %fetch-options))))
 
 ;; git remote head
 
diff --git a/guix.scm b/guix.scm
index aad396f..e388296 100644
--- a/guix.scm
+++ b/guix.scm
@@ -7,6 +7,7 @@
              (gnu packages compression)
              (gnu packages guile)
              (gnu packages pkg-config)
+             (gnu packages ssh)
              (gnu packages texinfo)
              (gnu packages tls)
              (gnu packages version-control))
@@ -20,7 +21,9 @@
    `(("autoconf" ,autoconf)
      ("automake" ,automake)
      ("pkg-config" ,pkg-config)
-     ("texinfo" ,texinfo)))
+     ("texinfo" ,texinfo)
+     ("openssh" ,openssh)
+     ("git" ,git)))
   (inputs
    `(("guile" ,guile-2.2)
      ("libgit2" ,libgit2)
diff --git a/tests/.ssh/id_rsa_client b/tests/.ssh/id_rsa_client
new file mode 100644
index 0000000..7e16000
--- /dev/null
+++ b/tests/.ssh/id_rsa_client
@@ -0,0 +1,27 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIIEpAIBAAKCAQEA6kWDytF6KQO46BPJj7nJQfATeae2l/U/lyE3HuZhCg3sitCN
+Lf8GaICsHvPT1SpMHnfjgqsT/ZbYhIXvfbFjDKimNru9d8TwcOynUR/w3+eIOvKl
+EVzp+nYfCUOahe0qKLAm+21iYt1UinhfkqpnnF2fa9Zhf+CROIMZCjX9/Fhd2WV5
+1YMsD3NUiRUK4Xx7gnm3pSAFW9EldqVozB2JwydCXx/WboU7wJqtcUZbxeMK27+D
+DRu4Kufnf11bJTb6+9dSEtKuKhahKbcRpQUlcgReCul8x8M8ufskkBatxMgyUuC1
+ey8gv1fC2FvQ6ct3skBFO8B3cIF2nYhb6+s75wIDAQABAoIBAQDU7WXB++8aRCXV
+2dZDactAwSISWpsdNm0bwbbFwQLGDq3F5ZPMEJUUeo72ews4Hf+dWb5RT4kV3frh
+SJLKHWY3ZTndWXn11+vp106j73IRL/GkElJxm4+Wc7H1y5owy8Sbwq9LqrnXve9P
+A+Vp+rO9bWKusuVfQw763DzwCO7WYQWHVfS/XpSJW3pgofuTLq8Esd/AMRrB0H3m
+EQ4zd+HR2f+cCux0geuOS0Yt3Ki7h6JKs+Nzhas26FBpyOTYJEQaJQhY5NNHO2p7
+ulk6H6AHHajgW9RBzNLXqpQuGR1ISNSZKvXVzPo/LxK8lPNTFY2iDmyzzjoPD51O
+Y05zFHEhAoGBAPfel/Nlz2nu9hVtTCMrm/4wFKzlTSQ1c2psUsOzYcr1PmmM0yrv
+IPnOZ0HbyKr9QomOQsgAzZm/iPS9Q7Owxzy1IrFHK+H68c853cod9N+L2pIkouSr
+CYUafjsdc+y+eCzYmX4pJMCU4E/AipJXSOUSWiv5ac7KAtzdio9W9nHJAoGBAPH0
+vJMOtGuqO3DBdi5aF8z/DH9sqJXkaoE5e3a9IXWC91L42RnmmKWeYet/VjV2kGgO
+ZTrZPjbGz9pqUTir5gZmOqFEwdjPiqb68SUgV/V8I5cu5WtZMLGLOxaSQMj6Y9+L
+sdAyZ9NnuJqXQ6jdPFGO7CWKhzckIu+/fX++tZgvAoGBAMYjZYvngpnHr2cJa6dh
+oNzcSmq7EaM0JwKXfMF7j1zSFgYB0Hutk8qct+Xpbstgj+OtmKyQF8ojVbNt58So
+N1vL3+OeZPHLy6g/NY/vymM4RIw2RRBNuNpxhx5yOMyypRYUPv6enQZk+7pEy4CX
+zWlv9izYvz/SM9+iKLTUa0QhAoGAI4flCVNne0gMYoqGaFgilp/9ndi/CQP5//AJ
+CW7Msw0AdNbGSt9qGygfCQ4yArfejOlQREwSrsiTTWe/dasIpHfutC/8p3IS0mKX
+dvRA9nO8Zj8kwZbfZ7MigjYH/XuHnxRMkF5WkNzyZwE/llSmvvNWCk1Ffft4heyA
+6XmAAVECgYBGNlXFaSgwDXX00LkRCSaC5zT7iKn6b7AJS+YT5lxDnaJZcM2C+2LG
+fF91Jxmvbhv5Fc3V2jzb24ypS8Y8GgV2C6ki8GzQnzZu5gtm0hwGItFPeZYgttyp
+g6I/2tV/hgctBOQQxKO2ZC0bJFgFZxHP3sPrFQFXyuEjHoem0QYwkQ==
+-----END RSA PRIVATE KEY-----
diff --git a/tests/.ssh/id_rsa_client.pub b/tests/.ssh/id_rsa_client.pub
new file mode 100644
index 0000000..fc0f530
--- /dev/null
+++ b/tests/.ssh/id_rsa_client.pub
@@ -0,0 +1 @@
+ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDqRYPK0XopA7joE8mPuclB8BN5p7aX9T+XITce5mEKDeyK0I0t/wZogKwe89PVKkwed+OCqxP9ltiEhe99sWMMqKY2u713xPBw7KdRH/Df54g68qURXOn6dh8JQ5qF7SoosCb7bWJi3VSKeF+SqmecXZ9r1mF/4JE4gxkKNf38WF3ZZXnVgywPc1SJFQrhfHuCebelIAVb0SV2pWjMHYnDJ0JfH9ZuhTvAmq1xRlvF4wrbv4MNG7gq5+d/XVslNvr711IS0q4qFqEptxGlBSVyBF4K6XzHwzy5+ySQFq3EyDJS4LV7LyC/V8LYW9Dpy3eyQEU7wHdwgXadiFvr6zvn mathieu@meru
diff --git a/tests/.ssh/id_rsa_server b/tests/.ssh/id_rsa_server
new file mode 100644
index 0000000..192b703
--- /dev/null
+++ b/tests/.ssh/id_rsa_server
@@ -0,0 +1,27 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIIEogIBAAKCAQEAzBpyIyno1lg4Qn4FuutRaP+2r8HTSjDij1hzj6zOBhyuGMG1
+C8cK9gkEbDsnKU4J3e4boZ/AYvMe/oXcsVq20VvWelOcrYtZAa+oi+RdXWQOzxCg
+5VJRl5L+bon3uuNTRLicj2a0F1fcskqgget1XzkSiOyUFKA+lwjk8UScm2s8teaI
+yTNJTkZiQ1JO3H5oHTgY0fV1tst7RS5HOZcH3CQXCBHm0/ss4d3Pn3QO9ahsO3sD
+flGtXJdfbf/Twjg0CeZQBhb9x9D0s8RC37k2eJprU6yhhJzsGdMeH2xfrARWOm9P
+EzcTRWGLPuAR+wG/OpHdk06SYkF9T/SXqcZ2fQIDAQABAoIBABJQuTdQlnVNm1bU
+Kj14ymhqsgEZmpVIx7vnSw90iVRhFHpiP5Xb+a7UZlI0CLKbLyV8LXyWclQuzvQ2
+HPTJWCh3XkrB4AhuvcD5+1z6VCqCRRXtvxJ1DZ9VcIGI3fMmXR2Il3wC0lxZ5RMW
+wUqHT5QI8hHZcPxc2OECylCgQJFtqA2UTs/KufT1YEsSWoPQ+zwUGgOtA4CV0W11
+3z2OYrBwtMAsnI6qS5ptUQkVAqZl/kL+1Yo6WaFdX49fcUo/9nUUCDYT5hd8aWH7
+aQ9DcLyeNhqnBwFkPd6Pa7fgMVNUYODkJglt0VFWPo7DOZ961OKCIHMLhEnwRt8g
+I20usSECgYEA6xA6zIG+6Rkpz8VeWmkWYNucEuiq78ZvRLF08Y5q46tB3tDMo275
+UFvchiE1OCIUY+Gqc8bCq7lAmD0BJQYRNeqt7xxmVKuYANhCfoT/zRxZv02P9Pjs
+lQoNUFnbXMFW0NZ9JYutkK1Coy/M7lbNRP5n2fl1Hh1izr3eSGFCv6kCgYEA3khI
+g3fWJ7gfWOHepKckVkK6At+2mbgP3GoNfb27hL+DqgIxE7eXEhPUTOonhMxTA3nZ
+PnzBHZjC0qac4qLZsjQuLhClB9u7jF6Vs7JUEt0ajUELwXchxJd8kv5KOQuZcdVt
+cT3kBSJN1h/MvAJiV50mAtp+M2O1P+ZcXnYV1LUCgYA4mFC/2mE/uCpD9w4vkGut
+6FIcj15QmqNBk8RHQHXl2N7kKbuLgfWO7n8a4DXzDOmB3txuQaWvOMwfm1iCNILC
+S32TO3A75JCVa3wfACCinrfRAnitj51OiPwJo4jYPUiMwYeiGY4xbjXEGocpv0Zu
+3R3d8lzLYmHeywIQxTIP+QKBgAWiNVxHpEDbdMfu6ZKovc4F4OsDuoAI3zYJ5g+i
+yGbj57VeWtoSFB0cLYxJfvjpqMz0wKHJzacvYPivylggIn5WvjjiqRwa4JT9LLQi
+N+lGe07LMD4WA+AUqs6a7Uym05vD+gMdu3K53NkpcynssYtg6z61RO+OfmCBOSQX
+wBPlAoGADTtG5KbjnOBa+7DcdbBKz5lHxutJkjXKnFFKsLeQcKkmF9UEs13XoTTa
+dMdolZBk/MmWEwVLFZmC0Gaio4iYMI4KcVMbKM357HnOqKt8mRNi4mGxHIxGUtGQ
+I9jDlrUelBFWHdBEUHUzmtY96ye6y37SD6iCydT3prj4kjpWwyY=
+-----END RSA PRIVATE KEY-----
diff --git a/tests/clone.scm b/tests/clone.scm
new file mode 100644
index 0000000..6ec7320
--- /dev/null
+++ b/tests/clone.scm
@@ -0,0 +1,68 @@
+;;; Guile-Git --- GNU Guile bindings of libgit2
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of Guile-Git.
+;;;
+;;; Guile-Git is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Guile-Git is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guile-Git.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests clone)
+  #:use-module (git)
+  #:use-module (tests helpers)
+  #:use-module (tests ssh)
+  #:use-module (srfi srfi-64))
+
+(test-begin "clone")
+
+(libgit2-init!)
+
+(define (make-ssh-url dir port)
+  (format #f "ssh://localhost:~a/~a" port dir))
+
+(define ssh-server-port 8899)
+
+(define (clone-test directory auth-method)
+  (let* ((repo-dir (in-vicinity (getcwd) directory))
+         (clone-dir (in-vicinity repo-dir "out")))
+    (clone (make-ssh-url repo-dir ssh-server-port)
+           clone-dir
+           #:auth-method auth-method)
+    (let* ((repository (repository-open clone-dir))
+           (oid (reference-target (repository-head repository))))
+      (oid->string (commit-id (commit-lookup repository oid))))))
+
+(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))))
+
+(libgit2-shutdown!)
+
+(test-end)
diff --git a/tests/ssh.scm.in b/tests/ssh.scm.in
new file mode 100644
index 0000000..ef71524
--- /dev/null
+++ b/tests/ssh.scm.in
@@ -0,0 +1,115 @@
+;;; Guile-Git --- GNU Guile bindings of libgit2
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of Guile-Git.
+;;;
+;;; Guile-Git is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Guile-Git is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guile-Git.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests ssh)
+  #:use-module (git auth)
+  #:use-module (tests helpers)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:export (with-sshd-server
+            with-ssh-agent
+            make-client-ssh-auth))
+
+(define sshd "@SSHD@")
+(define %ssh-dir (path-join (getenv "srcdir") "/tests/.ssh"))
+(define (in-ssh-folder . args)
+  (apply path-join %ssh-dir args))
+
+(define (start-sshd port)
+  (define (write-authorized-keys file)
+    (call-with-output-file file
+      (lambda (port)
+        ;; We need to pass PATH so that git binary (git-upload-pack) can be
+        ;; found from sshd.
+        (format port "environment=\"PATH=~a\" ~a"
+                (getenv "PATH")
+                (call-with-input-file (in-ssh-folder "id_rsa_client.pub")
+                  read-string)))))
+
+  (define (write-sshd-conf conf authorized-keys)
+    (call-with-output-file conf
+      (lambda (port)
+        (format port "AuthorizedKeysFile ~a
+PidFile ~a
+PermitUserEnvironment yes~%"
+                authorized-keys
+                (in-ssh-folder "sshd_pid")))))
+
+  (let ((sshd-conf (in-ssh-folder "sshd.conf"))
+        (sshd-key (in-ssh-folder "id_rsa_server"))
+        (authorized-keys (in-ssh-folder "authorized_keys")))
+    (write-authorized-keys authorized-keys)
+    (write-sshd-conf sshd-conf authorized-keys)
+    (system* sshd "-p" (number->string port) "-f" sshd-conf "-h" sshd-key)))
+
+(define (stop-sshd)
+  (define (read-pid port)
+    (string-trim-right (read-string port) #\newline))
+
+  (let ((pid
+         (call-with-input-file (in-ssh-folder "sshd_pid")
+           read-pid)))
+    (system* "kill" pid)))
+
+(define-syntax-rule (with-sshd-server port body ...)
+  (dynamic-wind
+    (lambda ()
+      (start-sshd port))
+    (lambda ()
+      body ...)
+    (lambda ()
+      (stop-sshd))))
+
+(define %ssh-auth-sock-regexp
+  (make-regexp "SSH_AUTH_SOCK=(.*); export SSH_AUTH_SOCK;"))
+
+(define %ssh-agent-pid-regexp
+  (make-regexp "SSH_AGENT_PID=(.*); export SSH_AGENT_PID;"))
+
+(define (start-ssh-agent)
+  (let* ((p (open-input-pipe "ssh-agent -s"))
+         (ssh-auth-sock-data (read-line p))
+         (ssh-agent-pid-data (read-line p))
+         (sock
+          (let ((match (regexp-exec %ssh-auth-sock-regexp
+                                    ssh-auth-sock-data)))
+            (match:substring match 1)))
+         (pid (let ((match (regexp-exec %ssh-agent-pid-regexp
+                                        ssh-agent-pid-data)))
+                (match:substring match 1))))
+    (setenv "SSH_AUTH_SOCK" sock)
+    pid))
+
+(define (ssh-agent-add-client-key)
+  (system* "ssh-add" (in-ssh-folder "id_rsa_client")))
+
+(define-syntax-rule (with-ssh-agent body ...)
+  (let ((pid (start-ssh-agent)))
+    (dynamic-wind
+      (const #f)
+      (lambda ()
+        (ssh-agent-add-client-key)
+        body ...)
+      (lambda ()
+        (system* "kill" pid)))))
+
+(define (make-client-ssh-auth)
+  (%make-auth-ssh-credentials
+   (in-ssh-folder "id_rsa_client.pub")
+   (in-ssh-folder "id_rsa_client")))
-- 
2.24.0


[-- Attachment #3: Type: text/plain, Size: 1447 bytes --]



Ludovic Courtès writes:

> Hi Mathieu,
>
> Mathieu Othacehe <m.othacehe@gmail.com> skribis:
>
>>> I think there are small modifications to do to (guix git) and (git
>>> clone).
>>
>> I did integrate a part of libgit2 ssh authentification mechanism in
>> Guile-Git in 2017. You can find it in (git fetch) module.
>>
>> It is currently broken, because of a regression. See
>> https://lists.gnu.org/archive/html/guix-devel/2019-11/msg00415.html.
>
> Oh I missed that message of yours.  Do you have a complete example using
> that functionality that I could use as a test?
>
> It would be great to have a test for that in Guile-Git.  We could use
> Guile-SSH, when it’s available, to spawn an SSH server.
>
>> What would be missing to have support for authenticated Git repositories
>> as Cuirass inputs is:
>>
>> * Fix the regression mentionned above.
>>
>> * Add support for a fetch-options argument in clone method of (git clone).
>>
>> * In (guix git), "latest-repository-commit" method would take parameters
>> to setup ssh authentication (such as ssh private key path at least) and
>> pass them to "fetch" and "clone" methods of Guile-Git.
>>
>> * Finally in Cuirass, the ssh authentication parameters could be
>> specified in the specification file (maybe for each input?) and passed
>> to "latest-repository-commit" method accordingly.
>
> I’d like to see that happen!
>
> Thanks,
> Ludo’.

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

[Ludovic Courtès]

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’.

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

[Erik Edrosa]

> 
> 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’.
> 

Sure, I was planning on creating a release soon. So once this is in I
can start testing on some different distros to make sure there isn't any
issues.

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

[Ludovic Courtès]

Hi Erik,

Erik Edrosa <erik.edrosa@gmail.com> skribis:

>> 
>> 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’.
>> 
>
> Sure, I was planning on creating a release soon. So once this is in I
> can start testing on some different distros to make sure there isn't any
> issues.

Awesome, sounds great!

I was interested in getting support for progress reports (for ‘clone’ in
particular), but I don’t think I’ll work on it soon enough, and that can
surely wait until the next release.

Thank you!

Ludo’.

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

[Mathieu Othacehe]

Hey!

> 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?

Great, thanks for reviewing :). I couldn't get it to work with a generated
client rsa key for an unknown reason, but pushed anyway.

Now regarding (guix git) integration, I have a question. It would be nice
to have "guix pull" and Cuirass support ssh authenticated
directories.

So "latest-repository-commit" could be call with ssh authentication
parameters. However, the guix-daemon won't be able to communicate with the
user ssh-agent, and storing an unencrypted private ssh key in the store
doesn't feel great to me.

Do you see any workaround?

Thanks,

Mathieu

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

[Clément Lassieur]

Hi everyone,

Whoo, nice, thank you so much Mathieu!  I'll test everything this
week-end probably, and start working on the (guix git) / Cuirass
counterpart (which is 1% of the work :D).

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

> Now regarding (guix git) integration, I have a question. It would be nice
> to have "guix pull" and Cuirass support ssh authenticated
> directories.

Indeed :)  Almost there!

> So "latest-repository-commit" could be call with ssh authentication
> parameters. However, the guix-daemon won't be able to communicate with the
> user ssh-agent, and storing an unencrypted private ssh key in the store
> doesn't feel great to me.
>
> Do you see any workaround?

As far as I understand, LATEST-REPOSITORY-COMMIT is never called by the
daemon, it downloads stuff first and then calls ADD-TO-STORE.  So both
using the SSH agent or passing a private SSH key should be
straightforward.

Clément

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

[Ludovic Courtès]

Hey ho!

Clément Lassieur <clement@lassieur.org> skribis:

> Whoo, nice, thank you so much Mathieu!  I'll test everything this
> week-end probably, and start working on the (guix git) / Cuirass
> counterpart (which is 1% of the work :D).

Neat!

>> So "latest-repository-commit" could be call with ssh authentication
>> parameters. However, the guix-daemon won't be able to communicate with the
>> user ssh-agent, and storing an unencrypted private ssh key in the store
>> doesn't feel great to me.
>>
>> Do you see any workaround?
>
> As far as I understand, LATEST-REPOSITORY-COMMIT is never called by the
> daemon, it downloads stuff first and then calls ADD-TO-STORE.  So both
> using the SSH agent or passing a private SSH key should be
> straightforward.

Indeed.  ‘guix pull --url’ and ‘guix build --with-git-url’ (and similar)
should work just fine.

Thanks!

Ludo’.

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

[Mathieu Othacehe]

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


Hello,

Here's a small patch to (guix git) so that cloning/fetching from ssh
authenticated repositories is supported using ssh agent.

I tested:

* guix pull --url=git@gitlab.com:mothacehe/private.git
* guix pull with the following channel configuration

--8<---------------cut here---------------start------------->8---
(cons* (channel
        (name 'gitlab)
        (url "git@gitlab.com:mothacehe/test-channel.git"))
       %default-channels)
--8<---------------cut here---------------end--------------->8---

This works fine, but we still need to see how it works for Cuirass
inputs and (guix git-download) module.

Mathieu

[-- Attachment #2: 0001-git-Add-ssh-authentication-support.patch --]
[-- Type: text/x-diff, Size: 2503 bytes --]

From ae380c15f1c37e2c94e0954975f5f712e76340ac Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Mon, 3 Feb 2020 18:05:02 +0100
Subject: [PATCH] git: Add ssh authentication support.

SSH agent authentication method is used.

* guix/git.scm (auth-method): New variable,
(clone*): pass previous variable in clone options,
(update-cached-checkout): pass previous variable in fetch options.
---
 guix/git.scm | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index a12f1eec8e..aee7b325e0 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -108,6 +108,9 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
                               (string-append "R:" url)
                               url))))))
 
+;; Default authentication method.
+(define auth-method (%make-auth-ssh-agent))
+
 (define (clone* url directory)
   "Clone git repository at URL into DIRECTORY.  Upon failure,
 make sure no empty directory is left behind."
@@ -119,7 +122,9 @@ make sure no empty directory is left behind."
       ;; value in Guile-Git: <https://bugs.gnu.org/29238>.
       (if (module-defined? (resolve-interface '(git))
                            'clone-init-options)
-          (clone url directory (clone-init-options))
+          (clone url directory
+                 (make-clone-options
+                  #:fetch-options (make-fetch-options auth-method)))
           (clone url directory)))
     (lambda _
       (false-if-exception (rmdir directory)))))
@@ -281,7 +286,8 @@ When RECURSIVE? is true, check out submodules as well, if any."
      ;; Only fetch remote if it has not been cloned just before.
      (when (and cache-exists?
                 (not (reference-available? repository ref)))
-       (remote-fetch (remote-lookup repository "origin")))
+       (remote-fetch (remote-lookup repository "origin")
+                     #:fetch-options (make-fetch-options auth-method)))
      (when recursive?
        (update-submodules repository #:log-port log-port))
      (let ((oid (switch-to-ref repository canonical-ref)))
-- 
2.25.0


[-- Attachment #3: Type: text/plain, Size: 979 bytes --]


Ludovic Courtès writes:

> Hey ho!
>
> Clément Lassieur <clement@lassieur.org> skribis:
>
>> Whoo, nice, thank you so much Mathieu!  I'll test everything this
>> week-end probably, and start working on the (guix git) / Cuirass
>> counterpart (which is 1% of the work :D).
>
> Neat!
>
>>> So "latest-repository-commit" could be call with ssh authentication
>>> parameters. However, the guix-daemon won't be able to communicate with the
>>> user ssh-agent, and storing an unencrypted private ssh key in the store
>>> doesn't feel great to me.
>>>
>>> Do you see any workaround?
>>
>> As far as I understand, LATEST-REPOSITORY-COMMIT is never called by the
>> daemon, it downloads stuff first and then calls ADD-TO-STORE.  So both
>> using the SSH agent or passing a private SSH key should be
>> straightforward.
>
> Indeed.  ‘guix pull --url’ and ‘guix build --with-git-url’ (and similar)
> should work just fine.
>
> Thanks!
>
> Ludo’.

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

[Ludovic Courtès]

Hello!

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

> Here's a small patch to (guix git) so that cloning/fetching from ssh
> authenticated repositories is supported using ssh agent.
>
> I tested:
>
> * guix pull --url=git@gitlab.com:mothacehe/private.git
> * guix pull with the following channel configuration
>
> (cons* (channel
>         (name 'gitlab)
>         (url "git@gitlab.com:mothacehe/test-channel.git"))
>        %default-channels)

Woohoo!  Really nice.

> This works fine, but we still need to see how it works for Cuirass
> inputs and (guix git-download) module.

Ah yes, ‘git-fetch’.

> From ae380c15f1c37e2c94e0954975f5f712e76340ac Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Mon, 3 Feb 2020 18:05:02 +0100
> Subject: [PATCH] git: Add ssh authentication support.
>
> SSH agent authentication method is used.
>
> * guix/git.scm (auth-method): New variable,
> (clone*): pass previous variable in clone options,
> (update-cached-checkout): pass previous variable in fetch options.

[...]

> +;; Default authentication method.
> +(define auth-method (%make-auth-ssh-agent))
> +
>  (define (clone* url directory)
>    "Clone git repository at URL into DIRECTORY.  Upon failure,
>  make sure no empty directory is left behind."
> @@ -119,7 +122,9 @@ make sure no empty directory is left behind."
>        ;; value in Guile-Git: <https://bugs.gnu.org/29238>.
>        (if (module-defined? (resolve-interface '(git))
>                             'clone-init-options)
> -          (clone url directory (clone-init-options))
> +          (clone url directory
> +                 (make-clone-options
> +                  #:fetch-options (make-fetch-options auth-method)))
>            (clone url directory)))
>      (lambda _
>        (false-if-exception (rmdir directory)))))
> @@ -281,7 +286,8 @@ When RECURSIVE? is true, check out submodules as well, if any."
>       ;; Only fetch remote if it has not been cloned just before.
>       (when (and cache-exists?
>                  (not (reference-available? repository ref)))
> -       (remote-fetch (remote-lookup repository "origin")))
> +       (remote-fetch (remote-lookup repository "origin")
> +                     #:fetch-options (make-fetch-options auth-method)))

It LGTM, and I like that it’s actually a small patch.

Until now, we had conditionals like the ‘module-defined?’ thing above to
allow for a smooth transition from older Guile-Git versions.  Do we want
to keep doing that?

If we do, then perhaps you should arrange so that uses of the new
Guile-Git APIs that appeared in 0.3.0 are conditional.

I’d say we should do it if it’s easy to do and not too intrusive.
Otherwise, let’s just require 0.3.0 and be done with it.  (‘guix pull’
gets 0.3.0 anyway.)

Thoughts?

Ludo’.

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

[Mathieu Othacehe]

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


Hey Ludo,

Thanks for reviewing :)

> It LGTM, and I like that it’s actually a small patch.
>
> Until now, we had conditionals like the ‘module-defined?’ thing above to
> allow for a smooth transition from older Guile-Git versions.  Do we want
> to keep doing that?
>
> If we do, then perhaps you should arrange so that uses of the new
> Guile-Git APIs that appeared in 0.3.0 are conditional.
>
> I’d say we should do it if it’s easy to do and not too intrusive.
> Otherwise, let’s just require 0.3.0 and be done with it.  (‘guix pull’
> gets 0.3.0 anyway.)

Here's a version with optional authentication support. I do not find it
too intrusive, but let me know what you think!

Thanks,

Mathieu

[-- Attachment #2: 0001-git-Add-ssh-authentication-support.patch --]
[-- Type: text/x-diff, Size: 2921 bytes --]

From 4554baf59564eb0c31cfe235acd078d54afef6d7 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Mon, 3 Feb 2020 18:05:02 +0100
Subject: [PATCH] git: Add ssh authentication support.

SSH agent authentication method is used.

* guix/git.scm (auth-method): New variable,
(clone*): pass previous variable in clone options,
(update-cached-checkout): pass previous variable in fetch options.
---
 guix/git.scm | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index a12f1eec8e..2165e612f1 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -108,6 +108,14 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
                               (string-append "R:" url)
                               url))))))
 
+;; Authentication appeared in Guile-Git 0.3.0, check if it is available.
+(define auth-supported?
+  (false-if-exception (resolve-interface '(git auth))))
+
+;; Default authentication method.
+(define auth-method (and auth-supported?
+                         (%make-auth-ssh-agent)))
+
 (define (clone* url directory)
   "Clone git repository at URL into DIRECTORY.  Upon failure,
 make sure no empty directory is left behind."
@@ -119,7 +127,11 @@ make sure no empty directory is left behind."
       ;; value in Guile-Git: <https://bugs.gnu.org/29238>.
       (if (module-defined? (resolve-interface '(git))
                            'clone-init-options)
-          (clone url directory (clone-init-options))
+          (clone url directory
+                 (if auth-supported?
+                     (make-clone-options
+                      #:fetch-options (make-fetch-options auth-method))
+                     (clone-init-options)))
           (clone url directory)))
     (lambda _
       (false-if-exception (rmdir directory)))))
@@ -281,7 +293,10 @@ When RECURSIVE? is true, check out submodules as well, if any."
      ;; Only fetch remote if it has not been cloned just before.
      (when (and cache-exists?
                 (not (reference-available? repository ref)))
-       (remote-fetch (remote-lookup repository "origin")))
+       (if auth-supported?
+           (remote-fetch (remote-lookup repository "origin")
+                         #:fetch-options (make-fetch-options auth-method))
+           (remote-fetch (remote-lookup repository "origin"))))
      (when recursive?
        (update-submodules repository #:log-port log-port))
      (let ((oid (switch-to-ref repository canonical-ref)))
-- 
2.25.0

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

[Ludovic Courtès]

Hi!

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

> Here's a version with optional authentication support. I do not find it
> too intrusive, but let me know what you think!

Yup, looks good!

> From 4554baf59564eb0c31cfe235acd078d54afef6d7 Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Mon, 3 Feb 2020 18:05:02 +0100
> Subject: [PATCH] git: Add ssh authentication support.
>
> SSH agent authentication method is used.
>
> * guix/git.scm (auth-method): New variable,
> (clone*): pass previous variable in clone options,
> (update-cached-checkout): pass previous variable in fetch options.

[...]

> +;; Default authentication method.
> +(define auth-method (and auth-supported?
> +                         (%make-auth-ssh-agent)))

Perhaps we should not call it at the top level, in case it throws an
exception or has unwanted side effects?  I’d suggest moving it to
the procedures where it’s used.  Thoughts?

Apart from that it LGTM, thanks!

Ludo’.

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

[Mathieu Othacehe]

Hey,

> Perhaps we should not call it at the top level, in case it throws an
> exception or has unwanted side effects?  I’d suggest moving it to
> the procedures where it’s used.  Thoughts?
>
> Apart from that it LGTM, thanks!

Fixed and pushed! Shall we inform users (guix pull news?) that they can
now use ssh authenticated repositories for guix pull + channels if they
have a running ssh-agent?

Mathieu

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

[Ludovic Courtès]

Hi!

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

>> Perhaps we should not call it at the top level, in case it throws an
>> exception or has unwanted side effects?  I’d suggest moving it to
>> the procedures where it’s used.  Thoughts?
>>
>> Apart from that it LGTM, thanks!
>
> Fixed and pushed! Shall we inform users (guix pull news?) that they can
> now use ssh authenticated repositories for guix pull + channels if they
> have a running ssh-agent?

Yes, good idea, could you add an entry in etc/news.txt?  That’d be great.

(Double-check you got the commit ID and syntax right before pushing, it’s
easy to make mistakes there.)

Thank you!

Ludo’.