From 8f70c642f55137f3df769e5a1c24f911eeff00c3 Mon Sep 17 00:00:00 2001
From: Alexander Artemenko <svetlyak.40wt@gmail.com>
Date: Sun, 24 May 2020 22:24:38 +0300
Subject: [PATCH] Support for libssh2_channel_request_auth_agent in
 with-ssh-connection macro

When `:forward-agent t` argument is passed to `with-ssh-connection` macro,
it will use libssh2_channel_request_auth_agent call before execution the body.

The function [was merged](https://github.com/libssh2/libssh2/pull/219) on 13 August 2019
and should be included into the libssh2 > 1.9.0 which is not released yet.
---
 src/libssh2-cffi.lisp |  7 +++++++
 src/package.lisp      |  1 +
 src/streams.lisp      | 27 ++++++++++++++++-----------
 3 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/src/libssh2-cffi.lisp b/src/libssh2-cffi.lisp
index efd1dd0..464091b 100644
--- a/src/libssh2-cffi.lisp
+++ b/src/libssh2-cffi.lisp
@@ -818,3 +818,10 @@
   (with-foreign-strings (((fs-filename fs-filename-len) filename))
     (result-or-error
       (%libssh2-sftp-open-ex sftp fs-filename (- fs-filename-len 1) flags mode open-type))))
+
+(defcfun ("libssh2_channel_request_auth_agent" %channel-request-auth-agent) +ERROR-CODE+
+  (session +session+))
+
+(defun channel-request-auth-agent (session)
+  (let ((result (%channel-request-auth-agent session)))
+    (result-or-error result)))
diff --git a/src/package.lisp b/src/package.lisp
index 6159af8..e4f2ef7 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -50,6 +50,7 @@
            :channel-send-eof
            :channel-exit-status
            :channel-scp-recv
+           :channel-request-auth-agent
 
            ;; SFTP
            :sftp-list-directory
diff --git a/src/streams.lisp b/src/streams.lisp
index 6cd743b..aa822cf 100644
--- a/src/streams.lisp
+++ b/src/streams.lisp
@@ -97,17 +97,22 @@
       (session-free (session ssh)))))
 
 (defmacro with-ssh-connection (session (host auth-data &rest connection-args) &body body)
-  `(let* ((,session (create-ssh-connection ,host ,@connection-args))
-          (*ssh-connection* ,session))
-     (unwind-protect
-          (if (authentication ,session ,auth-data)
-	      (handler-bind ((libssh2-invalid-error-code
-			      (lambda (condition)
-				(declare (ignore condition))
-				(throw-last-error (session ,session)))))
-		,@body)
-	      (error 'ssh-authentication-failure))
-       (destroy-ssh-connection ,session))))
+  (let ((forward-agent (getf connection-args :forward-agent)))
+    (alexandria:remove-from-plistf connection-args
+                                   :forward-agent)
+    `(let* ((,session (create-ssh-connection ,host ,@connection-args))
+            (*ssh-connection* ,session))
+       (unwind-protect
+            (if (authentication ,session ,auth-data)
+                (handler-bind ((libssh2-invalid-error-code
+                                 (lambda (condition)
+                                   (declare (ignore condition))
+                                   (throw-last-error (session ,session)))))
+                  ,@(when forward-agent
+                      `((channel-request-auth-agent (session ,session))))
+                  ,@body)
+                (error 'ssh-authentication-failure))
+         (destroy-ssh-connection ,session)))))
 
 (defmethod ssh-session-key ((ssh ssh-connection))
   (session-hostkey (session ssh)))