[bug#38541] [PATCH] ssh: Add Kerberos-support to ssh:// daemon URLs

[Lars-Dominik Braun]

* gnu/packages/ssh.scm (libssh): Depend on mit-krb5
(guile-ssh): Support gssapi functions, see
https://github.com/artyom-poptsov/guile-ssh/pull/15
* guix/ssh.scm (open-ssh-session): Fall back to GSSAPI if public key
authentication does not work
---
 doc/guix.texi                               |   5 +-
 gnu/packages/patches/guile-ssh-gssapi.patch | 115 ++++++++++++++++++++
 gnu/packages/ssh.scm                        |   4 +-
 guix/ssh.scm                                |  15 ++-
 4 files changed, 131 insertions(+), 8 deletions(-)
 create mode 100644 gnu/packages/patches/guile-ssh-gssapi.patch

diff --git a/doc/guix.texi b/doc/guix.texi
index 7d50f31d20..81ea5153b6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6753,8 +6753,9 @@ instruct it to listen for TCP connections 
(@pxref{Invoking guix-daemon,
 @item ssh
 @cindex SSH access to build daemons
 These URIs allow you to connect to a remote daemon over
-SSH@footnote{This feature requires Guile-SSH (@pxref{Requirements}).}.
-A typical URL might look like this:
+SSH. This feature requires Guile-SSH (@pxref{Requirements}) and a working
+@code{guile} binary in @code{PATH} on the destination machine. It supports
+public key and GSSAPI authentication. A typical URL might look like this:
 
 @example
 ssh://charlie@@guix.example.org:22
diff --git a/gnu/packages/patches/guile-ssh-gssapi.patch 
b/gnu/packages/patches/guile-ssh-gssapi.patch
new file mode 100644
index 0000000000..522687d589
--- /dev/null
+++ b/gnu/packages/patches/guile-ssh-gssapi.patch
@@ -0,0 +1,115 @@
+commit 8b728dc144ea12f3a339a2009e403e9bbd8fd39c
+Author: Lars-Dominik Braun <address@hidden>
+Date:   Thu Dec 5 10:31:00 2019 +0100
+
+    Add GSSAPI user authentication method
+    
+    Bind to libssh’s ssh_userauth_gssapi().
+
+diff --git a/doc/api-auth.texi b/doc/api-auth.texi
+index b2975d2..9f2884d 100644
+--- a/doc/api-auth.texi
++++ b/doc/api-auth.texi
+@@ -125,6 +125,26 @@ In nonblocking mode, you've got to call this again later.
+ 
+ @end deffn
+ 
++@deffn {Scheme Procedure} userauth-gssapi! session
++Try to authenticate through the @code{gssapi-with-mic} method.
++
++Return one of the following symbols: 
++
++@table @samp
++@item success
++Authentication success.
++@item partial
++You've been partially authenticated, you still have to use another method.
++@item again
++In nonblocking mode, you've got to call this again later.
++@item denied
++Authentication failed: use another method.
++@item error
++A serious error happened.
++@end table
++
++@end deffn
++
+ @deffn {Scheme Procedure} userauth-none! session
+ Try to authenticate through the @code{none} method.
+ 
+diff --git a/libguile-ssh/auth.c b/libguile-ssh/auth.c
+index 52d3262..e9efe9e 100644
+--- a/libguile-ssh/auth.c
++++ b/libguile-ssh/auth.c
+@@ -206,6 +206,27 @@ Throw `wrong-type-arg' if a disconnected SESSION is 
passed as an argument.\
+ }
+ #undef FUNC_NAME
+ 
++SCM_DEFINE (guile_ssh_userauth_gssapi_x,
++            "userauth-gssapi!", 1, 0, 0,
++            (SCM session),
++            "\
++Try to authenticate through the \"gssapi-with-mic\" method.\
++Throw `wrong-type-arg' if a disconnected SESSION is passed as an argument.\
++")
++#define FUNC_NAME s_guile_ssh_userauth_gssapi_x
++{
++  struct session_data *sd = _scm_to_session_data (session);
++
++  int res;
++
++  GSSH_VALIDATE_CONNECTED_SESSION (sd, session, SCM_ARG1);
++
++  res = ssh_userauth_gssapi (sd->ssh_session);
++
++  return ssh_auth_result_to_symbol (res);
++}
++#undef FUNC_NAME
++
+ 
+ /* Try to authenticate through the "none" method.
+ 
+diff --git a/modules/ssh/auth.scm b/modules/ssh/auth.scm
+index 158cab1..7a4be10 100644
+--- a/modules/ssh/auth.scm
++++ b/modules/ssh/auth.scm
+@@ -29,6 +29,7 @@
+ ;;   userauth-public-key/try
+ ;;   userauth-agent!
+ ;;   userauth-password!
++;;   userauth-gssapi!
+ ;;   userauth-none!
+ ;;   userauth-get-list
+ 
+@@ -46,6 +47,7 @@
+             userauth-public-key/try
+             userauth-agent!
+             userauth-password!
++            userauth-gssapi!
+             userauth-none!
+             userauth-get-list
+             openssh-agent-start
+diff --git a/tests/client-server.scm b/tests/client-server.scm
+index 2704280..d8f490a 100644
+--- a/tests/client-server.scm
++++ b/tests/client-server.scm
+@@ -429,6 +429,19 @@
+   (userauth-public-key/auto! (make-session-for-test)))
+ 
+ 
++;;; 'userauth-gssapi!'
++
++;; The procedure called with a wrong object as a parameter which leads to an
++;; exception.
++(test-error-with-log "userauth-gssapi!, wrong parameter" 'wrong-type-arg
++  (userauth-gssapi! "Not a session."))
++
++;; Client tries to authenticate using a non-connected session which leads to
++;; an exception.
++(test-error-with-log "userauth-gssapi!, not connected" 'wrong-type-arg
++  (userauth-gssapi! (make-session-for-test)))
++
++
+ ;;;
+ 
+ 
diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm
index b82d280089..5a001525d0 100644
--- a/gnu/packages/ssh.scm
+++ b/gnu/packages/ssh.scm
@@ -99,7 +99,8 @@
        ;; TODO: Add 'CMockery' and '-DWITH_TESTING=ON' for the test suite.
        #:tests? #f))
     (inputs `(("zlib" ,zlib)
-              ("libgcrypt" ,libgcrypt)))
+              ("libgcrypt" ,libgcrypt)
+              ("mit-krb5" ,mit-krb5)))
     (synopsis "SSH client library")
     (description
      "libssh is a C library implementing the SSHv2 and SSHv1 protocol for 
client
@@ -244,6 +245,7 @@ Additionally, various channel-specific options can be 
negotiated.")
               (sha256
                (base32
                 "03bv3hwp2s8f0bqgfjaan9jx4dyab0abv27n2zn2g0izlidv0vl6"))
+              (patches (search-patches "guile-ssh-gssapi.patch"))
               (modules '((guix build utils)))
               (snippet
                '(begin
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 291ce20b61..56b49b177f 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -157,11 +157,16 @@ server at '~a': ~a")
           (session-set! session 'timeout timeout)
           session)
          (x
-          (disconnect! session)
-          (raise (condition
-                  (&message
-                   (message (format #f (G_ "SSH authentication failed for 
'~a': ~a~%")
-                                    host (get-error session)))))))))
+          (match (userauth-gssapi! session)
+            ('success
+             (session-set! session 'timeout timeout)
+             session)
+            (x
+             (disconnect! session)
+             (raise (condition
+                     (&message
+                      (message (format #f (G_ "SSH authentication failed for 
'~a': ~a~%")
+                                       host (get-error session)))))))))))
       (x
        ;; Connection failed or timeout expired.
        (raise (condition
-- 
2.20.1