libssh2::libssh2-invalid-code-error when using both scp and execute-command

[simkoc]

I am using trivial-ssh to execute commands and copy files from a virtual machine. However, sometimes after copying a large file I get an exception:

Condition LIBSSH2::LIBSSH2-INVALID-ERROR-CODE was signalled.
   [Condition of type LIBSSH2::LIBSSH2-INVALID-ERROR-CODE]

Restarts:
 0: [ABORT] Abort thread (#<THREAD "mover" RUNNING {1015EF72E3}>)

Backtrace:
  0: (LIBSSH2:CHANNEL-OPEN #.(SB-SYS:INT-SAP #X7FFF34002050) :CHANNEL-TYPE "session" :WINDOW-SIZE 262144 :PACKET-SIZE 32768 :MESSAGE "")
  1: ((:METHOD LIBSSH2:EXECUTE (LIBSSH2:SSH-CONNECTION STRING)) #<LIBSSH2:SSH-CONNECTION {1015E55043}> "mkdir /tmp/test-1/ 2>&1") [fast-method]
  2: ((FLET SB-THREAD::WITH-MUTEX-THUNK :IN RUN-REMOTE-SHELL-COMMAND))
  3: ((FLET #:WITHOUT-INTERRUPTS-BODY-537 :IN SB-THREAD::CALL-WITH-MUTEX))
  4: (SB-THREAD::CALL-WITH-MUTEX #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK :IN RUN-REMOTE-SHELL-COMMAND) {7FFDB546E5CB}> #<SB-THREAD:MUTEX "ssh-mutex" owner: #<SB-THREAD:THREAD "mover" RUNNING {1015EF72E..
  5: (RUN-REMOTE-SHELL-COMMAND "mkdir /tmp/test-1/" #<FUNCTION (LAMBDA (STREAM) :IN DISCARD-DATA-LAMBDA) {1014817A1B}> #<FUNCTION (LAMBDA (STRING) :IN #:DROP-THRU-TAG-1) {101597F21B}>)
  6: (BACKUP-ALL-FILES-FROM "/opt/bitnami/php/tmp/" "/tmp/test-1/" #<FUNCTION (LAMBDA (STRING) :IN #:DROP-THRU-TAG-1) {101597F21B}>)
  7: ((LAMBDA NIL :IN #:DROP-THRU-TAG-1))
  8: ((FLET #:WITHOUT-INTERRUPTS-BODY-1117 :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
  9: ((FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
 10: ((FLET #:WITHOUT-INTERRUPTS-BODY-537 :IN SB-THREAD::CALL-WITH-MUTEX))
 11: (SB-THREAD::CALL-WITH-MUTEX #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE) {7FFDB546EC2B}> #<SB-THREAD:MUTEX "thread result lock" owner: #<SB-THREAD:THR..
 12: (SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE #<SB-THREAD:THREAD "mover" RUNNING {1015EF72E3}> #S(SB-THREAD:SEMAPHORE :NAME "Thread setup semaphore" :%COUNT 0 :WAITCOUNT 0 :MUTEX #<SB-THREAD:MUTEX (f..
 13: ("foreign function: call_into_lisp")
 14: ("foreign function: new_thread_trampoline")

Inspecting the error:

#<LIBSSH2::LIBSSH2-INVALID-ERROR-CODE {1002AA0083}>
--------------------
The object is a CONDITION of type LIBSSH2::LIBSSH2-INVALID-ERROR-CODE.
CODE: :ERROR-TIMEOUT

To reproduce the issue you need:

• a VM with ssh (I use bitnami oxid vdmk but any other should work/local host might work as well though not as reliable for me)
• a file of size on the machine >= 260MB (smaller files tend not to trigger the exception for some reason)

The poc that leads to the exception:

• the bitnami file is the large >= 260MB file
• the /opt/bitnami/php/tmp/ folder is empty

The code:

(ql:quickload "trivial-ssh")

(defparameter *run-p* T)

(defparameter *ssh-mutex* (sb-thread:make-mutex :name "ssh-mutex"))

(defparameter *ssh-file-mutex* (sb-thread:make-mutex :name "ssh-mutex"))	    

(defparameter +scp-buffer-file-path+ "/tmp/trival-ssh-buffer-file")

(defparameter *global-ssh-connection* nil)

(defmacro with-active-ssh-connection ((username host password) &body body)
  (let ((connection (gensym)))
    `(unwind-protect
          (ssh:with-connection (,connection ,host (ssh:pass ,username ,password))
            (setf *global-ssh-connection* ,connection)
            ,@body)
       (setf *global-ssh-connection* nil))))


(defun run-remote-shell-command (command result-handler &optional (logger #'(lambda(string)
                                                                              (FORMAT (make-broadcast-stream) "~a~%" string))))
  "executes a shell command on the given host and gives the resulting stream
to the result handler. The result of the result-handler will be returned"  
  (sb-thread:with-mutex (*ssh-mutex*)
    (unwind-protect
         (progn 
           (funcall logger (FORMAT nil "running remote command ~a" command))
           (ssh:with-command (*global-ssh-connection* stream command)        
             (funcall result-handler stream))))
    (funcall logger (FORMAT nil "finished remote command ~a" command))))


(defun scp (remote-name local-name &optional (logger #'(lambda(string)
                                                         (FORMAT (make-broadcast-stream) "~a~%" string))))
  (sb-thread:with-mutex (*ssh-mutex*)
    (funcall logger (FORMAT nil "ssh-session ~a - about to start scp for ~a -> ~a" 
                            *global-ssh-connection*
                            remote-name
                            local-name))
    (libssh2:with-scp-input (in *global-ssh-connection* remote-name stat)
      (with-open-file (out local-name
                           :direction :output
                           :if-exists :supersede
                           :if-does-not-exist :create
                           :element-type '(unsigned-byte 8))
        (cl-fad:copy-stream in out)))))


(defun get-file-as-blob (file-path &optional (logger #'(lambda(string)
                                                         (FORMAT (make-broadcast-stream) "~a~%" string))))
  "returns the binary data that represents the content of the file specified as file-path
using ssh connection with provided username host and password"
  (sb-thread:with-mutex (*ssh-file-mutex*)
    (scp file-path +scp-buffer-file-path+)  
    (with-open-file (tmp-stream +scp-buffer-file-path+ :element-type '(unsigned-byte 8))
      (funcall logger (FORMAT nil "transfered ~a bytes from ~a" (file-length tmp-stream) file-path))
      (let ((sequence (make-array (file-length tmp-stream) :element-type '(unsigned-byte 8) :adjustable nil)))
        (read-sequence sequence tmp-stream)
        sequence))))

(defun discard-data-lambda ()
  #'(lambda(stream)
      (do* ((line (read-line stream nil nil nil)
		  (read-line stream nil nil nil)))
	   ((not line)))))


(defun backup-all-files-from (folder target-folder &optional (logger #'(lambda(string)
                                                                         (FORMAT (make-broadcast-stream) "~a~%" string))))
  (run-remote-shell-command (FORMAT nil "mkdir ~a" target-folder) (discard-data-lambda) logger)
  (run-remote-shell-command (FORMAT nil "cp ~a/* ~a" folder target-folder) (discard-data-lambda) logger))


(defun backup-file (file target-folder &optional (logger #'(lambda(string)
                                                             (FORMAT (make-broadcast-stream) "~a~%" string))))
  (run-remote-shell-command (FORMAT nil "mkdir ~a" target-folder) (discard-data-lambda) logger)
  (run-remote-shell-command (FORMAT nil "cp ~a ~a" file target-folder) (discard-data-lambda) logger))


(with-active-ssh-connection ("root" "192.168.56.101" "bitnami")
  (let ((thread-2 (sb-thread:make-thread 
                   #'(lambda ()
                       (do ()
                           ((not *run-p*) nil)
                         (backup-all-files-from "/opt/bitnami/php/tmp/" 
                                                "/tmp/test-1/" 
                                                #'(lambda (string)
                                                    (FORMAT T "~a~%" string)))
                         (backup-file "/tmp/xdebug.xt" 
                                      "/tmp/test-xdebug-1/" 
                                      #'(lambda (string)
                                          (FORMAT T "~a~%" string)))))
                   :name "mover"))
        (thread-1 (sb-thread:make-thread 
                   #'(lambda ()
                       (do ()
                           ((not *run-p*) nil)
                         (get-file-as-blob "/tmp/xdebug.xt" 
                                           #'(lambda (string)
                                               (FORMAT T "~a~%" string)))))
                   :name "saver")))
    (sb-thread:join-thread thread-1)
    (sb-thread:join-thread thread-2)))

I suspect that there is some timeout variable that is not properly reset when such a large scp occurs.