├── .gitignore ├── Vagrantfile ├── trivial-ssh-test.asd ├── libssh2 ├── libssh2-libc-cffi.lisp ├── examples.lisp ├── solutions.lisp ├── util.lisp ├── package.lisp ├── types.lisp ├── streams.lisp └── libssh2-cffi.lisp ├── README.md ├── trivial-ssh.asd ├── .travis.yml ├── t └── trivial-ssh.lisp ├── trivial-ssh-libssh2.asd └── src └── trivial-ssh.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /Vagrantfile: -------------------------------------------------------------------------------- 1 | # -*- Mode: Ruby -*- 2 | 3 | Vagrant.configure("2") do |config| 4 | config.vm.box = "ubuntu-precise64" 5 | config.vm.box_url = "http://files.vagrantup.com/precise64.box" 6 | 7 | config.vm.network :private_network, ip: "192.168.123.123" 8 | 9 | config.vm.synced_folder ".", "/vagrant", disabled: true 10 | config.vm.synced_folder ".", "/home/vagrant/" 11 | end 12 | -------------------------------------------------------------------------------- /trivial-ssh-test.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage trivial-ssh-test-asd 3 | (:use :cl :asdf)) 4 | (in-package :trivial-ssh-test-asd) 5 | 6 | (defsystem trivial-ssh-test 7 | :author "Fernando Borretti" 8 | :license "MIT" 9 | :depends-on (:trivial-ssh 10 | :fiveam) 11 | :components ((:module "t" 12 | :components 13 | ((:file "trivial-ssh"))))) 14 | -------------------------------------------------------------------------------- /libssh2/libssh2-libc-cffi.lisp: -------------------------------------------------------------------------------- 1 | (in-package :libssh2) 2 | 3 | (include "sys/types.h" "sys/stat.h") 4 | (cstruct +stat+ "struct stat" 5 | (dev "st_dev" :type :unsigned-int) 6 | (ino "st_ino" :type :unsigned-int) 7 | (mode "st_mode" :type :unsigned-int) 8 | (nlink "st_nlink" :type :unsigned-int) 9 | (uid "st_uid" :type :unsigned-int) 10 | (gid "st_gid" :type :unsigned-int) 11 | (rdev "st_rdev" :type :unsigned-int) 12 | (size "st_size" :type :unsigned-int) 13 | (atime "st_atime" :type :unsigned-int) 14 | (mtime "st_mtime" :type :unsigned-int) 15 | (ctime "st_ctime" :type :unsigned-int)) 16 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # trivial-ssh 2 | 3 | [![Build Status](https://travis-ci.org/eudoxia0/trivial-ssh.svg?branch=master)](https://travis-ci.org/eudoxia0/trivial-ssh) 4 | 5 | A simple SSH/SCP library for Common Lisp. 6 | 7 | # Usage 8 | 9 | ## Overview 10 | 11 | ~~~lisp 12 | (ssh:with-connection (conn "example.com" (ssh:pass "username" "password")) 13 | (ssh:with-command (conn iostream "ls -a") 14 | ;; Write or read to/from the iostream 15 | ) 16 | (ssh:download-file conn #p"/remote/file" #p"/local/file") 17 | (ssh:upload-file conn #p"/local/file" #p"/remote-file")) 18 | ~~~ 19 | 20 | # License 21 | 22 | Copyright (c) 2014-2015 Fernando Borretti (eudoxiahp@gmail.com) 23 | 24 | Licensed under the MIT License. 25 | -------------------------------------------------------------------------------- /trivial-ssh.asd: -------------------------------------------------------------------------------- 1 | (defsystem trivial-ssh 2 | :author "Fernando Borretti " 3 | :maintainer "Fernando Borretti " 4 | :license "MIT" 5 | :version "0.1" 6 | :homepage "https://github.com/eudoxia0/trivial-ssh" 7 | :bug-tracker "https://github.com/eudoxia0/trivial-ssh/issues" 8 | :source-control (:git "git@github.com:eudoxia0/trivial-ssh.git") 9 | :depends-on (:trivial-ssh-libssh2) 10 | :components ((:module "src" 11 | :components 12 | ((:file "trivial-ssh")))) 13 | :description "An abstraction layer over cl-libssh2." 14 | :long-description 15 | #.(uiop:read-file-string 16 | (uiop:subpathname *load-pathname* "README.md")) 17 | :in-order-to ((test-op (test-op trivial-ssh-test)))) 18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | 3 | env: 4 | matrix: 5 | - LISP=sbcl 6 | 7 | install: 8 | # Install cl-travis 9 | - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash 10 | # Install the SSH server 11 | - sudo apt-get install openssh-server 12 | # Install libssh2 13 | - sudo apt-get install libssh2-1 14 | 15 | script: 16 | - cl -e '(ql:quickload :fiveam)' 17 | -e '(ql:quickload :cffi-grovel)' 18 | -e '(setf fiveam:*debug-on-error* t 19 | fiveam:*debug-on-failure* t)' 20 | -e '(setf *debugger-hook* 21 | (lambda (c h) 22 | (declare (ignore c h)) 23 | (uiop:quit -1)))' 24 | -e '(ql:quickload :trivial-ssh-test)' 25 | 26 | notifications: 27 | email: 28 | - eudoxiahp@gmail.com 29 | -------------------------------------------------------------------------------- /t/trivial-ssh.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage trivial-ssh-test 3 | (:use :cl :fiveam)) 4 | (in-package :trivial-ssh-test) 5 | 6 | (defparameter +system-pathname+ 7 | (asdf:component-pathname (asdf:find-system :trivial-ssh))) 8 | 9 | (defparameter +host+ "localhost") 10 | 11 | (defun execute-in-directory (cmd) 12 | (uiop:run-program 13 | (format nil "cd ~S; ~A" (namestring +system-pathname+) cmd))) 14 | 15 | (def-suite trivial-ssh) 16 | (in-suite trivial-ssh) 17 | 18 | (test hosts-db 19 | (is (equal (trivial-ssh:hosts-db "known_hosts") 20 | (merge-pathnames 21 | #p".ssh/known_hosts" 22 | (user-homedir-pathname))))) 23 | 24 | ;(test simple-connection 25 | ; (is-true 26 | ; (trivial-ssh:with-connection 27 | ; (c +host+ (trivial-ssh:pass "vagrant" "vagrant")) 28 | ; t))) 29 | 30 | (run! 'trivial-ssh) 31 | -------------------------------------------------------------------------------- /trivial-ssh-libssh2.asd: -------------------------------------------------------------------------------- 1 | (eval-when (:load-toplevel :execute) 2 | (asdf:load-system :cffi-grovel)) 3 | 4 | (defsystem trivial-ssh-libssh2 5 | :author "Oleksii Shevchuk " 6 | :maintainer "Fernando Borretti " 7 | :license "Public Domain" 8 | :version "0.1" 9 | :depends-on (:cffi 10 | :usocket 11 | :cl-fad 12 | :trivial-gray-streams 13 | :babel 14 | :split-sequence) 15 | :defsystem-depends-on (:cffi-grovel) 16 | :description "Trivial libssh2 bindings" 17 | :components ((:module "libssh2" 18 | :serial t 19 | :components 20 | ((:file "package") 21 | (:file "types") 22 | (cffi-grovel:grovel-file "libssh2-libc-cffi") 23 | (:file "util") 24 | (:file "libssh2-cffi") 25 | (:file "streams") 26 | (:file "solutions"))))) 27 | -------------------------------------------------------------------------------- /libssh2/examples.lisp: -------------------------------------------------------------------------------- 1 | (libssh2:with-ssh-connection sshc 2 | ("192.168.30.193" 3 | (libssh2:make-password-auth "root" "12345677") 4 | :hosts-db (namestring 5 | (merge-pathnames 6 | (make-pathname :directory '(:relative ".ssh") 7 | :name "libssh2-known_hosts") 8 | (user-homedir-pathname)))) 9 | (let ((local/remote "/tmp/image") 10 | (remote/local "/os-devel/BUILDER/builds/np1U/root.img") 11 | (stream/type '(unsigned-byte 8))) 12 | (print "---1---") 13 | (libssh2:with-scp-input (in sshc remote/local stat) 14 | (with-open-file (out local/remote 15 | :direction :output 16 | :if-exists :supersede 17 | :if-does-not-exist :create 18 | :element-type stream/type) 19 | (cl-fad:copy-stream in out))) 20 | (print "---2--") 21 | (with-open-file (in local/remote 22 | :direction :input 23 | :element-type stream/type) 24 | (libssh2:with-scp-output (out sshc local/remote 25 | (file-length in)) 26 | (cl-fad:copy-stream in out))) 27 | (print "---3---") 28 | (libssh2:with-execute* (in sshc (format nil "md5sum ~a ~a" 29 | remote/local 30 | local/remote)) 31 | (loop for line = (read-line in nil) 32 | while line do (print line))))) 33 | -------------------------------------------------------------------------------- /libssh2/solutions.lisp: -------------------------------------------------------------------------------- 1 | (in-package :libssh2) 2 | 3 | (defvar *session* nil) 4 | 5 | (defmethod method-of ((auth auth-password)) :PASSWORD) 6 | (defmethod method-of ((auth auth-publickey)) :PUBLICKEY) 7 | (defmethod method-of ((auth auth-agent)) :PUBLICKEY) 8 | 9 | (defmethod authentication ((ssh ssh-connection) (auth-list list)) 10 | (unless (or (null auth-list) (not (listp auth-list))) 11 | (let ((auth-methods (authentication-methods ssh (login (car auth-list)))) 12 | (*errors-list* (remove :ERROR-AUTHENTICATION-FAILED *errors-list*))) 13 | (loop for auth in auth-list 14 | do (when (and (find (method-of auth) 15 | auth-methods) 16 | (authentication ssh auth)) 17 | (return t)))))) 18 | 19 | (defun make-auth-data (login &key 20 | (key-directories 21 | (list (default-config-directory))) 22 | (keys '(("id_rsa") ("id_dsa"))) 23 | (passwords '())) 24 | (unless (or (null keys) 25 | (not (listp keys)) 26 | (null (car keys)) 27 | (not (listp (car keys))) 28 | (null key-directories) 29 | (not (listp key-directories))) 30 | (cons (make-agent-auth login) 31 | (apply #'concatenate 32 | (append 33 | (cons 'list 34 | (loop for dir in key-directories 35 | collect (loop for key in keys 36 | when (let ((path 37 | (merge-pathnames (car key) 38 | dir))) 39 | (when (probe-file path) 40 | (make-publickey-auth 41 | login (namestring dir) 42 | (car key) (if (cdr key) 43 | (cdr key) "")))) 44 | collect it))) 45 | (list 46 | (when (and passwords 47 | (listp passwords)) 48 | (loop for password in passwords 49 | collect (make-password-auth login 50 | password))))))))) 51 | -------------------------------------------------------------------------------- /libssh2/util.lisp: -------------------------------------------------------------------------------- 1 | (in-package :libssh2) 2 | 3 | ;; From: 4 | ;; http://common-lisp.net/~loliveira/ediware/hunchentoot/set-timeouts.lisp 5 | (defun set-timeouts (usocket read-timeout write-timeout) 6 | "Sets up timeouts on the given USOCKET object. READ-TIMEOUT is the 7 | read timeout period, WRITE-TIMEOUT is the write timeout, specified in 8 | \(fractional) seconds. The timeouts can either be implemented using 9 | the low-level socket options SO_RCVTIMEO and SO_SNDTIMEO or some 10 | other, implementation specific mechanism. On platforms that do not 11 | support separate read and write timeouts, both must be equal or an 12 | error will be signaled. READ-TIMEOUT and WRITE-TIMEOUT may be NIL, 13 | which means that the corresponding socket timeout value will not be 14 | set." 15 | (declare (ignorable usocket read-timeout write-timeout)) 16 | ;; add other Lisps here if necessary 17 | #+(or :sbcl :cmu) 18 | (unless (eql read-timeout write-timeout) 19 | (parameter-error "Read and write timeouts for socket must be equal.")) 20 | #+:clisp 21 | (when read-timeout 22 | (socket:socket-options (usocket:socket usocket) :SO-RCVTIMEO read-timeout)) 23 | #+:clisp 24 | (when write-timeout 25 | (socket:socket-options (usocket:socket usocket) :SO-SNDTIMEO write-timeout)) 26 | #+:openmcl 27 | (when read-timeout 28 | (setf (ccl:stream-input-timeout (usocket:socket usocket)) 29 | read-timeout)) 30 | #+:openmcl 31 | (when write-timeout 32 | (setf (ccl:stream-output-timeout (usocket:socket usocket)) 33 | write-timeout)) 34 | #+:sbcl 35 | (when read-timeout 36 | (setf (sb-impl::fd-stream-timeout (usocket:socket-stream usocket)) 37 | (coerce read-timeout 'single-float))) 38 | #+:cmu 39 | (setf (lisp::fd-stream-timeout (usocket:socket-stream usocket)) 40 | (coerce read-timeout 'integer)) 41 | #-(or :clisp :allegro :openmcl :sbcl :lispworks :cmu) 42 | (not-implemented 'set-timeouts)) 43 | 44 | 45 | (defun usocket-get-fd (uso) 46 | #+:sbcl 47 | (slot-value (usocket:socket uso) 'sb-bsd-sockets::file-descriptor) 48 | #+:ccl 49 | (ccl:socket-os-fd (usocket:socket uso))) 50 | 51 | (defvar *config-directory* nil) 52 | (defun default-config-directory () 53 | (if *config-directory* *config-directory* 54 | (namestring (merge-pathnames ".ssh/" (user-homedir-pathname))))) 55 | 56 | (defun default-known-hosts () 57 | (namestring (merge-pathnames "known_hosts" 58 | (default-config-directory)))) 59 | 60 | (defun default-private-key () 61 | (namestring (merge-pathnames "id_rsa" 62 | (default-config-directory)))) 63 | 64 | (defun default-public-key () 65 | (namestring (merge-pathnames "id_rsa.pub" 66 | (default-config-directory)))) 67 | -------------------------------------------------------------------------------- /src/trivial-ssh.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage trivial-ssh 3 | (:use :cl) 4 | (:nicknames :ssh) 5 | (:export :hosts-db 6 | :*automatically-accept-keys* 7 | :pass 8 | :key 9 | :agent 10 | :with-connection 11 | :with-command 12 | :download-file 13 | :upload-file)) 14 | (in-package :trivial-ssh) 15 | 16 | ;;; Hosts database 17 | 18 | (defun hosts-db (name) 19 | "Path of the hosts database." 20 | (merge-pathnames 21 | (make-pathname :directory (list :relative ".ssh") 22 | :name name) 23 | (user-homedir-pathname))) 24 | 25 | (defparameter +default-hosts-db+ (hosts-db "trivial_ssh_hosts")) 26 | 27 | ;; Ensure hosts database exists 28 | (unless (probe-file +default-hosts-db+) 29 | (with-open-file (file +default-hosts-db+ :if-does-not-exist :create))) 30 | 31 | ;;; Key handling 32 | 33 | (defparameter *automatically-accept-keys* t 34 | "Determine whether remote keys are automatically accepted. Defaults to true.") 35 | 36 | (defun accept-key (conn) 37 | (libssh2:with-known-hosts (known-hosts 38 | ((libssh2:session conn) 39 | (libssh2:hosts-db conn))) 40 | (if (or *automatically-accept-keys* 41 | (yes-or-no-p "Accept key for ~A?" (libssh2::ssh-host+port-format conn))) 42 | (progn 43 | (libssh2:known-hosts-add known-hosts 44 | (libssh2::ssh-host+port-format conn) 45 | (libssh2:ssh-session-key conn) 46 | :comment "") 47 | (libssh2:known-hosts-writefile known-hosts 48 | (libssh2::hosts-db conn)))))) 49 | 50 | ;;; Connection 51 | 52 | (defun pass (username password) 53 | "Authenticate using a username and password" 54 | (libssh2:make-password-auth username password)) 55 | 56 | (defun key (username private-key-path) 57 | (libssh2:make-publickey-auth username 58 | (namestring 59 | (make-pathname 60 | :directory (pathname-directory private-key-path))) 61 | (pathname-name private-key-path))) 62 | 63 | (defun agent (username) 64 | (libssh2:make-agent-auth username)) 65 | 66 | (defmacro with-connection ((conn host auth 67 | &optional (hosts-db-path +default-hosts-db+) 68 | (port 22)) 69 | &rest body) 70 | "Execute `body` within the context of the SSH connection `conn`. `host` is the 71 | host to connect to, `auth` is an authentication object (For example, generated 72 | with the `pass` function). `hosts-db` is the file storing the known SSH hosts, 73 | and defaults to `~/.ssh/known_hosts`." 74 | `(let* ((ssh-conn 75 | (libssh2:create-ssh-connection 76 | ,host :hosts-db (namestring ,hosts-db-path) :port ,port))) 77 | (handler-case 78 | (libssh2:ssh-verify-session ssh-conn) 79 | (libssh2:ssh-bad-hostkey nil (accept-key ssh-conn))) 80 | (libssh2:destroy-ssh-connection ssh-conn) 81 | (libssh2:with-ssh-connection ,conn 82 | (,host 83 | ,auth 84 | :hosts-db (namestring ,hosts-db-path) :port ,port) 85 | ,@body))) 86 | 87 | ;;; Command execution 88 | 89 | (defmacro with-command ((conn iostream command) &rest body) 90 | `(libssh2:with-execute* (,iostream ,conn ,command) 91 | ,@body)) 92 | 93 | ;;; SCP file transfers 94 | 95 | (defun download-file (conn local remote 96 | &key (if-exists :supersede) (if-does-not-exist :create)) 97 | (libssh2:with-scp-input (download-stream conn (namestring remote) stat) 98 | (with-open-file (file-stream (namestring local) 99 | :direction :output 100 | :if-exists if-exists 101 | :if-does-not-exist if-does-not-exist 102 | :element-type '(unsigned-byte 8)) 103 | (uiop:copy-stream-to-stream download-stream file-stream)))) 104 | 105 | (defun upload-file (conn local remote) 106 | (with-open-file (file-stream (namestring local) 107 | :direction :input 108 | :element-type '(unsigned-byte 8)) 109 | (libssh2:with-scp-output (upload-stream conn 110 | (namestring remote) 111 | (file-length file-stream)) 112 | (uiop:copy-stream-to-stream file-stream upload-stream 113 | :element-type '(unsigned-byte 8))))) 114 | -------------------------------------------------------------------------------- /libssh2/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage libssh2 2 | (:use :cffi :cl :trivial-gray-streams) 3 | (:export ;; LIBSSH2 API 4 | :with-session 5 | :session-init 6 | :session-disconnect 7 | :session-handshake 8 | :session-last-error 9 | :session-auth-methods-list 10 | 11 | :with-agent 12 | :agent-init 13 | :agent-free 14 | :agent-connect 15 | :agent-disconnect 16 | :agent-list-identies 17 | :agent-identities-iterator 18 | :foreach-agent-identity 19 | 20 | :with-known-hosts 21 | :known-hosts-add 22 | :known-hosts-init 23 | :known-hosts-free 24 | :known-hosts-readfile 25 | :known-hosts-writefile 26 | :known-hosts-check 27 | :session-hostkey 28 | :session-hostkey-fingerprint 29 | 30 | :user-auth-agent 31 | :user-auth-password 32 | :user-auth-publickey 33 | 34 | :channel-open 35 | :channel-close 36 | :channel-free 37 | :channel-wait-closed 38 | :channel-setenv 39 | :channel-process-start 40 | :channel-exec 41 | :channel-shell 42 | :channel-subsystem 43 | :channel-flush 44 | :channel-read 45 | :channel-write 46 | :channel-write-string 47 | :channel-eofp 48 | :channel-send-eof 49 | :channel-exit-status 50 | :channel-scp-recv 51 | 52 | ;; STREAMS API // BLOCKING 53 | 54 | :AUTH-DATA 55 | :SSH-CONNECTION 56 | :SESSION 57 | :SOCKET 58 | :HOST 59 | :PORT 60 | :HOSTS-DB 61 | :AUTH-PASSED 62 | :SSH-HANDSHAKE-ERROR 63 | :SSH-BAD-HOSTKEY 64 | :REASON 65 | :HASH 66 | :CREATE-SSH-CONNECTION 67 | :DESTROY-SSH-CONNECTION 68 | :WITH-SSH-CONNECTION 69 | :SSH-SESSION-KEY 70 | :AUTH-PASSWORD 71 | :SSH-VERIFY-SESSION 72 | :AUTHENTICATION-METHODS 73 | :AUTHENTICATION 74 | :AUTH-PUBLICKEY 75 | :PUBLIC-KEY 76 | :PRIVATE-KEY 77 | :PASSWORD 78 | :AUTH-AGENT 79 | :MAKE-PUBLICKEY-AUTH 80 | :MAKE-AGENT-AUTH 81 | :MAKE-PASSWORD-AUTH 82 | :MAKE-PASSWORD-EMUL-AUTH 83 | :MAKE-AUTH-DATA 84 | :SSH-CHANNEL-STREAM 85 | :SSH-CHANNEL-STREAM-OUTPUT 86 | :SSH-CHANNEL-STREAM-INPUT 87 | :SSH-CHANNEL-STREAM-INPUT/OUTPUT 88 | :SSH-CHANNEL-EXEC 89 | :SSH-CHANNEL-RECV 90 | :SSH-CHANNEL-SEND 91 | :CHANNEL 92 | :INPUT-BUFFER 93 | :INPUT-SIZE 94 | :OUTPUT-BUFFER 95 | :OUTPUT-SIZE 96 | :INTPUT-POS 97 | :OUTPUT-POS 98 | :STREAM-ELEMENT-TYPE 99 | :OPEN-STREAM-P 100 | :STREAM-LISTEN 101 | :STREAM-READ-BYTE 102 | :STREAM-READ-SEQUENCE 103 | :STREAM-READ-LINE 104 | :STREAM-FORCE-OUTPUT 105 | :STREAM-FINISH-OUTPUT* 106 | :STREAM-FINISH-OUTPUT 107 | :STREAM-WRITE-BYTE 108 | :STREAM-WRITE-CHAR 109 | :STREAM-WRITE-SEQUENCE 110 | :CLOSE 111 | :EXECUTE 112 | :SCP-INPUT 113 | :SCP-OUTPUT 114 | :WITH-EXECUTE 115 | :WITH-EXECUTE* 116 | :WITH-SCP-INPUT 117 | :WITH-SCP-OUTPUT 118 | 119 | ;; CONDITIONS & SLOTS 120 | :KNOWN-HOSTS-READING-ERROR 121 | :HOST-NOT-ALLOWED-TO-CONNECT 122 | :+TRACE-OPTIONS+ 123 | :+DISCONNECT-CODE+ 124 | :+ERROR-CODE+ 125 | :+BLOCKING+ 126 | :+IDENTITY-AMOUNT+ 127 | :+STREAM-ID+ 128 | :+HASH-TYPE+ 129 | :+CHECK-VERDICT+ 130 | :+SESSION+ 131 | :+KEY+ 132 | :+SSH-AGENT+ 133 | :+KNOWN-HOSTS+ 134 | :+KEYHASH+ 135 | :+CHANNEL+ 136 | :+KNOWN-HOSTS-FLAGS+ 137 | :+KNOWN-HOST+ 138 | :KEY 139 | :SSH-GENERIC-ERROR 140 | :MESSAGE 141 | :CODE :FILE 142 | 143 | ;; Restarts 144 | :TRY-CREATE-FILE 145 | :ACCEPT 146 | :ACCEPT-ONCE 147 | :ACCEPT-ALWAYS 148 | :DROP 149 | 150 | ;; Dynamic customizations 151 | :*CHANNEL-READ-TYPE* 152 | :*CHANNEL-READ-ZERO-AS-EOF* 153 | :*ERRORS-LIST* 154 | :*DEFAULT-ERRORS-LIST*)) 155 | -------------------------------------------------------------------------------- /libssh2/types.lisp: -------------------------------------------------------------------------------- 1 | (in-package :libssh2) 2 | 3 | (defcenum +DISCONNECT-CODE+ 4 | (:HOST-NOT-ALLOWED-TO-CONNECT 1) 5 | (:PROTOCOL-ERROR 2) 6 | (:KEY-EXCHANGE-FAILED 3) 7 | (:RESERVED 4) 8 | (:MAC-ERROR 5) 9 | (:COMPRESSION-ERROR 6) 10 | (:SERVICE-NOT-AVAILABLE 7) 11 | (:PROTOCOL-VERSION-NOT-SUPPORTED 8) 12 | (:HOST-KEY-NOT-VERIFIABLE 9) 13 | (:CONNECTION-LOST 10) 14 | (:BY-APPLICATION 11) 15 | (:TOO-MANY-CONNECTIONS 12) 16 | (:AUTH-CANCELLED-BY-USER 13) 17 | (:NO-MORE-AUTH-METHODS-AVAILABLE 14) 18 | (:ILLEGAL-USER-NAME 15)) 19 | 20 | (defcenum +ERROR-CODE+ 21 | (:ERROR-NONE 0) 22 | (:ERROR-SOCKET-NONE -1) 23 | (:ERROR-BANNER-RECV -2) 24 | (:ERROR-BANNER-SEND -3) 25 | (:ERROR-INVALID-MAC -4) 26 | (:ERROR-KEX-FAILURE -5) 27 | (:ERROR-ALLOC -6) 28 | (:ERROR-SOCKET-SEND -7) 29 | (:ERROR-KEY-EXCHANGE-FAILURE -8) 30 | (:ERROR-TIMEOUT -9) 31 | (:ERROR-HOSTKEY-INIT -10) 32 | (:ERROR-HOSTKEY-SIGN -11) 33 | (:ERROR-DECRYPT -12) 34 | (:ERROR-SOCKET-DISCONNECT -13) 35 | (:ERROR-PROTO -14) 36 | (:ERROR-PASSWORD-EXPIRED -15) 37 | (:ERROR-FILE -16) 38 | (:ERROR-METHOD-NONE -17) 39 | (:ERROR-AUTHENTICATION-FAILED -18) 40 | (:ERROR-PUBLICKEY-UNVERIFIED -19) 41 | (:ERROR-CHANNEL-OUTOFORDER -20) 42 | (:ERROR-CHANNEL-FAILURE -21) 43 | (:ERROR-CHANNEL-REQUEST-DENIED -22) 44 | (:ERROR-CHANNEL-UNKNOWN -23) 45 | (:ERROR-CHANNEL-WINDOW-EXCEEDED -24) 46 | (:ERROR-CHANNEL-PACKET-EXCEEDED -25) 47 | (:ERROR-CHANNEL-CLOSED -26) 48 | (:ERROR-CHANNEL-EOF-SENT -27) 49 | (:ERROR-SCP-PROTOCOL -28) 50 | (:ERROR-ZLIB -29) 51 | (:ERROR-SOCKET-TIMEOUT -30) 52 | (:ERROR-SFTP-PROTOCOL -31) 53 | (:ERROR-REQUEST-DENIED -32) 54 | (:ERROR-METHOD-NOT-SUPPORTED -33) 55 | (:ERROR-INVAL -34) 56 | (:ERROR-INVALID-POLL-TYPE -35) 57 | (:ERROR-PUBLICKEY-PROTOCOL -36) 58 | (:ERROR-EAGAIN -37) 59 | (:ERROR-BUFFER-TOO-SMALL -38) 60 | (:ERROR-BAD-USE -39) 61 | (:ERROR-COMPRESS -40) 62 | (:ERROR-OUT-OF-BOUNDARY -41) 63 | (:ERROR-AGENT-PROTOCOL -42) 64 | (:ERROR-SOCKET-RECV -43) 65 | (:ERROR-ENCRYPT -44) 66 | (:ERROR-BAD-SOCKET -45) 67 | (:ERROR-KNOWN-HOSTS -46)) 68 | 69 | (defcenum +DISCONNECT-CODE+ 70 | (:HOST-NOT-ALLOWED-TO-CONNECT 1) 71 | (:PROTOCOL-ERROR 2) 72 | (:KEY-EXCHANGE-FAILED 3) 73 | (:RESERVED 4) 74 | (:MAC-ERROR 5) 75 | (:COMPRESSION-ERROR 6) 76 | (:SERVICE-NOT-AVAILABLE 7) 77 | (:PROTOCOL-VERSION-NOT-SUPPORTED 8) 78 | (:HOST-KEY-NOT-VERIFIABLE 9) 79 | (:CONNECTION-LOST 10) 80 | (:BY-APPLICATION 11) 81 | (:TOO-MANY-CONNECTIONS 12) 82 | (:AUTH-CANCELLED-BY-USER 13) 83 | (:NO-MORE-AUTH-METHODS-AVAILABLE 14) 84 | (:ILLEGAL-USER-NAME 15)) 85 | 86 | (defcenum +BLOCKING+ 87 | (:BLOCKING 1) 88 | (:NON-BLOCKING 0)) 89 | 90 | (defcenum +IDENTITY-AMOUNT+ 91 | (:MORE 0) 92 | (:END 1)) 93 | 94 | (defcenum +CHANNEL-EOF+ 95 | (:NOT-EOF 0) 96 | (:EOF 1)) 97 | 98 | (defcenum +STREAM-ID+ 99 | (:STDOUT 0) 100 | (:STDERR 1) 101 | (:EXTENDED -1) 102 | (:ALL -2)) 103 | 104 | (defcenum +HASH-TYPE+ 105 | (:MD5 1) 106 | (:SHA1 2)) 107 | 108 | (defcenum +CHECK-VERDICT+ 109 | (:FAILURE 3) 110 | (:NOT-FOUND 2) 111 | (:MISMATCH 1) 112 | (:MATCH 0)) 113 | 114 | (defctype +session+ :pointer) 115 | (defctype +key+ :pointer) 116 | (defctype +ssh-agent+ :pointer) 117 | (defctype +known-hosts+ :pointer) 118 | (defctype +keyhash+ :pointer) 119 | (defctype +channel+ :pointer) 120 | 121 | (defbitfield +TRACE-OPTIONS+ 122 | (.TRANS. 2) 123 | (.KEX. 4) 124 | (.AUTH. 8) 125 | (.CONN. 16) 126 | (.SCP. 32) 127 | (.SFTP. 64) 128 | (.ERROR. 128) 129 | (.PUBLICKEY 256) 130 | (.SOCKET 512)) 131 | 132 | (defbitfield +known-hosts-flags+ 133 | (.type-plain. 1) 134 | (.type-sha1. 2) 135 | (.raw. 65536) 136 | (.base64. 131072) 137 | (.rsa1. 262144) 138 | (.ssh. 524288)) 139 | 140 | (defcstruct +known-host+ 141 | (magic :unsigned-int) 142 | (node :pointer) 143 | (name :string) 144 | (key :string) 145 | (type +known-hosts-flags+)) 146 | 147 | (defcstruct +kbd-prompt+ 148 | (text :pointer) 149 | (length :unsigned-int) 150 | (echo :unsigned-char)) 151 | 152 | (defcstruct +kbd-response+ 153 | (text :pointer) 154 | (length :unsigned-int)) 155 | 156 | (defstruct key 157 | (data 0 :read-only t) 158 | (size 0 :read-only t) 159 | (type 0 :read-only t)) 160 | 161 | (define-condition ssh-generic-error (error) 162 | ((message :type string 163 | :initarg :message 164 | :accessor message) 165 | (code :type +ERROR-CODE+ 166 | :accessor code 167 | :initarg :code))) 168 | 169 | (defmethod print-object ((sge ssh-generic-error) stream) 170 | (format stream "Libssh2: ~a (~a)" (message sge) (code sge))) 171 | 172 | (eval-when (:compile-toplevel :load-toplevel :execute) 173 | (defvar *default-errors-list* 174 | (cons :UNKNOWN 175 | (remove :ERROR-NONE 176 | (foreign-enum-keyword-list '+ERROR-CODE+))))) 177 | 178 | (defvar *errors-list* *default-errors-list*) 179 | 180 | (define-condition libssh2-invalid-error-code (error) 181 | ((code :type keyword 182 | :accessor code 183 | :initarg :code))) 184 | -------------------------------------------------------------------------------- /libssh2/streams.lisp: -------------------------------------------------------------------------------- 1 | (in-package :libssh2) 2 | 3 | ;; clos facade: for blocking streams!! ;; 4 | 5 | (defun throw-last-error (session) 6 | (multiple-value-bind (message code) 7 | (session-last-error session) 8 | (error 'ssh-generic-error 9 | :message message 10 | :code code))) 11 | 12 | (defmacro with-last-error ((session error-type) &rest args) 13 | `(multiple-value-bind (message code) 14 | (session-last-error ,session) 15 | (error (quote ,error-type) 16 | :message message 17 | :code code 18 | ,@args))) 19 | 20 | (defclass auth-data () 21 | ((login :type string 22 | :initarg :login 23 | :initform "" 24 | :reader login))) 25 | 26 | (defclass ssh-connection () 27 | ((session :type +session+ 28 | :initarg :session 29 | :initform (null-pointer) 30 | :reader session) 31 | (socket :type usocket:socket 32 | :initarg :socket 33 | :accessor socket) 34 | (host :type string 35 | :initarg :host 36 | :accessor host) 37 | (port :type int 38 | :initarg :port 39 | :accessor port) 40 | (hosts-db :type string 41 | :initarg :hosts-db 42 | :accessor hosts-db) 43 | (auth-passed :type boolean 44 | :initform nil 45 | :accessor auth-passed))) 46 | 47 | (define-condition ssh-handshake-error (ssh-generic-error) ()) 48 | 49 | (define-condition ssh-bad-hostkey (error) 50 | ((reason :type +check-verdict+ 51 | :accessor reason 52 | :initarg :reason) 53 | (hash :type string 54 | :accessor hash 55 | :initarg :hash))) 56 | 57 | (defmethod create-ssh-connection (host 58 | &key 59 | (hosts-db (default-known-hosts)) 60 | (port 22) 61 | (read-timeout 5) 62 | (write-timeout 5)) 63 | (let ((new-session nil) 64 | (new-socket nil) 65 | (retval :error-none)) 66 | (unwind-protect 67 | (progn 68 | (setq new-session (session-init)) 69 | (setq new-socket (usocket:socket-connect host port)) 70 | (set-timeouts new-socket read-timeout write-timeout) 71 | (session-set-blocking new-session :blocking) 72 | 73 | (setq retval 74 | (session-handshake new-session (usocket-get-fd new-socket))) 75 | 76 | (if (eq retval :error-none) 77 | (make-instance 'ssh-connection 78 | :session new-session 79 | :socket new-socket 80 | :host host 81 | :port port 82 | :hosts-db hosts-db) 83 | (throw-last-error new-session))) 84 | (unless (eq retval :error-none) 85 | (unless (null-pointer-p new-session) 86 | (session-free new-session)) 87 | (unless (null new-socket) 88 | (usocket:socket-close new-socket)) 89 | nil)))) 90 | 91 | 92 | (defmethod destroy-ssh-connection ((ssh ssh-connection) &key (description "") (lang "")) 93 | (unwind-protect 94 | (session-disconnect (session ssh) 95 | :description description 96 | :lang lang) 97 | (progn 98 | (usocket:socket-close (socket ssh)) 99 | (session-free (session ssh))))) 100 | 101 | (defmacro with-ssh-connection (session (host auth-data &rest connection-args) &body body) 102 | `(let ((,session (create-ssh-connection ,host ,@connection-args))) 103 | (unwind-protect 104 | (when (authentication ,session ,auth-data) 105 | (handler-bind ((libssh2-invalid-error-code 106 | (lambda (condition) 107 | (declare (ignore condition)) 108 | (throw-last-error (session ,session))))) 109 | ,@body)) 110 | (destroy-ssh-connection ,session)))) 111 | 112 | (defmethod ssh-session-key ((ssh ssh-connection)) 113 | (session-hostkey (session ssh))) 114 | 115 | (defmethod ssh-host+port-format ((ssh ssh-connection)) 116 | (format nil "[~a]:~a" 117 | (host ssh) 118 | (port ssh))) 119 | 120 | (defclass auth-password (auth-data) 121 | ((password :type string 122 | :initarg :password 123 | :initform "" 124 | :reader password))) 125 | 126 | (defmethod ssh-verify-session ((ssh ssh-connection)) 127 | (with-known-hosts (known-hosts ((session ssh) (hosts-db ssh))) 128 | (let* ((host-key (ssh-session-key ssh)) 129 | (host-key-status (known-hosts-check known-hosts 130 | (host ssh) 131 | host-key 132 | :port (port ssh)))) 133 | (if (eq host-key-status :match) 134 | t 135 | (restart-case 136 | (error 'ssh-bad-hostkey 137 | :reason host-key-status 138 | :hash (session-hostkey-fingerprint (session ssh))) 139 | (accept () t) 140 | (drop () nil) 141 | (accept-once (&optional (comment "")) 142 | (progn 143 | (known-hosts-add known-hosts (ssh-host+port-format ssh) host-key 144 | :comment comment) 145 | t)) 146 | (accept-always (&optional (comment "")) 147 | (progn 148 | (known-hosts-add known-hosts (ssh-host+port-format ssh) host-key 149 | :comment comment) 150 | (known-hosts-writefile known-hosts (hosts-db ssh)) 151 | t))))))) 152 | 153 | (defmethod authentication-methods ((ssh ssh-connection) (login string)) 154 | (session-auth-methods-list (session ssh) login)) 155 | 156 | (defmethod authentication :around ((ssh ssh-connection) (auth auth-data)) 157 | (let ((*errors-list* (remove :ERROR-AUTHENTICATION-FAILED *errors-list*))) 158 | (if (auth-passed ssh) 159 | t 160 | (if (ssh-verify-session ssh) 161 | (setf (auth-passed ssh) 162 | (call-next-method)))))) 163 | 164 | (defmethod authentication ((ssh ssh-connection) (auth auth-password)) 165 | (eq (user-auth-password (session ssh) 166 | (login auth) 167 | (password auth)) 168 | :ERROR-NONE)) 169 | 170 | (defclass auth-password-emul (auth-data) 171 | ((password :type string 172 | :initarg :password 173 | :initform "" 174 | :reader password))) 175 | 176 | (defmethod authentication ((ssh ssh-connection) (auth auth-password-emul)) 177 | (eq (user-auth-interactive-trivial 178 | (session ssh) 179 | (login auth) 180 | (password auth)) 181 | :ERROR-NONE)) 182 | 183 | (defclass auth-publickey (auth-data) 184 | ((public-key :type string 185 | :initarg :public-key 186 | :initform "id_rsa.pub" 187 | :accessor public-key) 188 | (private-key :type string 189 | :initarg :private-key 190 | :initform "id_rsa" 191 | :accessor private-key) 192 | (password :type string 193 | :initarg :password 194 | :initform "" 195 | :accessor password))) 196 | 197 | (defmethod authentication ((ssh ssh-connection) (auth auth-publickey)) 198 | (with-slots (login public-key private-key password) auth 199 | (eq (user-auth-publickey (session ssh) 200 | login public-key private-key password) 201 | :ERROR-NONE))) 202 | 203 | (defclass auth-agent (auth-data) ()) 204 | 205 | (defmethod authentication ((ssh ssh-connection) (auth auth-agent)) 206 | (let ((agent (agent-init (session ssh))) 207 | (username (login auth))) 208 | (unwind-protect 209 | (if (and agent (eq (agent-connect agent) 210 | :ERROR-NONE)) 211 | (let ((next-identity (agent-identities-iterator agent))) 212 | (when next-identity 213 | (with-foreign-string (fs-username username) 214 | (loop for identity = (funcall next-identity) 215 | while identity do 216 | (if (eq 217 | (%agent-userauth agent fs-username identity) 218 | :ERROR-NONE) 219 | (return t)))))) 220 | (throw-last-error (session ssh))) 221 | (when agent 222 | (agent-free agent))))) 223 | 224 | (defun make-publickey-auth (login directory private-key-name &optional (password "")) 225 | (let ((private-key 226 | (namestring (make-pathname :directory directory 227 | :name private-key-name))) 228 | (public-key 229 | (namestring (make-pathname :directory directory 230 | :name private-key-name 231 | :type "pub")))) 232 | (make-instance 'auth-publickey 233 | :login login 234 | :public-key public-key 235 | :private-key private-key 236 | :password password))) 237 | 238 | (defun make-agent-auth (login) 239 | (make-instance 'auth-agent 240 | :login login)) 241 | 242 | (defun make-password-auth (login password) 243 | (make-instance 'auth-password 244 | :login login 245 | :password password)) 246 | 247 | (defun make-password-emul-auth (login password) 248 | (make-instance 'auth-password-emul 249 | :login login 250 | :password password)) 251 | 252 | (defvar *ssh-channel-buffer-size* 8196) 253 | 254 | (defclass ssh-channel-stream 255 | (trivial-gray-stream-mixin) 256 | ((socket :initarg :socket 257 | :accessor socket) 258 | (channel :type +CHANNEL+ 259 | :initarg :channel 260 | :accessor channel))) 261 | 262 | (defclass ssh-channel-stream-output 263 | (ssh-channel-stream) 264 | ((output-buffer :initform (make-shareable-byte-vector 265 | *ssh-channel-buffer-size*) 266 | :accessor output-buffer) 267 | (output-size :initform 0 268 | :accessor output-size 269 | :type int) 270 | (output-pos :type int 271 | :initform 0 272 | :accessor output-pos))) 273 | 274 | (defclass ssh-channel-stream-input 275 | (ssh-channel-stream) 276 | ((input-buffer :initform (make-shareable-byte-vector 277 | *ssh-channel-buffer-size*) 278 | :accessor input-buffer) 279 | (input-size :initform 0 280 | :accessor input-size 281 | :type int) 282 | (input-pos :type int 283 | :initform 0 284 | :accessor input-pos))) 285 | 286 | (defclass ssh-channel-stream-input/output 287 | (ssh-channel-stream-input 288 | ssh-channel-stream-output) 289 | ()) 290 | 291 | (defclass ssh-channel-exec 292 | (ssh-channel-stream-input/output 293 | fundamental-binary-output-stream 294 | fundamental-character-output-stream 295 | fundamental-binary-input-stream 296 | fundamental-character-input-stream) 297 | ()) 298 | 299 | (defclass ssh-channel-recv 300 | (ssh-channel-stream-input 301 | fundamental-binary-input-stream) 302 | ()) 303 | 304 | (defclass ssh-channel-send 305 | (ssh-channel-stream-output 306 | fundamental-binary-output-stream) 307 | ()) 308 | 309 | (defmethod stream-element-type ((stream ssh-channel-stream)) 310 | (declare (ignore stream)) 311 | '(unsigned-byte 8)) 312 | 313 | (defmethod open-stream-p ((stream ssh-channel-stream)) 314 | (not (null-pointer-p (channel stream)))) 315 | 316 | (defmethod stream-listen ((stream ssh-channel-stream)) 317 | (listen (usocket:socket-stream (socket stream)))) 318 | 319 | (defmethod stream-read-byte ((stream ssh-channel-stream-input)) 320 | (cond 321 | ((< (input-pos stream) (input-size stream)) 322 | (prog1 (elt (input-buffer stream) (input-pos stream)) 323 | (incf (input-pos stream)))) 324 | (t (progn 325 | (multiple-value-bind (amount eof) 326 | (channel-read (channel stream) 327 | (input-buffer stream)) 328 | (if eof :eof 329 | (progn 330 | (setf (input-pos stream) 1) 331 | (setf (input-size stream) amount) 332 | (elt (input-buffer stream) 0)))))))) 333 | 334 | ;; Looks like libssh2 sends 0 byte as EOF. Crazy shit :] 335 | (defmethod stream-read-sequence ((stream ssh-channel-recv) thing start end &key) 336 | (multiple-value-bind (start eof) 337 | (call-next-method) 338 | (values 339 | (- start (if (and (> start 0) 340 | eof) 341 | 1 0)) 342 | eof))) 343 | 344 | (defmethod stream-read-sequence ((stream ssh-channel-stream-input) thing start end &key) 345 | (let ((request-size (- end start)) 346 | (this-eof nil)) 347 | (with-slots (channel input-size input-buffer input-pos) stream 348 | (labels 349 | ((buffer-to-output () 350 | (let* ((buffered-portion-size (- input-size input-pos )) 351 | (replaced-size (min buffered-portion-size request-size))) 352 | (when (> replaced-size 0) 353 | (replace thing input-buffer 354 | :start1 start :end1 (+ start 355 | replaced-size) 356 | :start2 input-pos :end2 (+ input-pos 357 | replaced-size)) 358 | (incf input-pos replaced-size) 359 | (incf start replaced-size) 360 | (decf request-size replaced-size)))) 361 | 362 | (fill-buffer-and-output () 363 | (multiple-value-bind (amount eof) 364 | (channel-read channel input-buffer) 365 | 366 | (setf input-size amount) 367 | (setf input-pos 0) 368 | 369 | (buffer-to-output) 370 | (unless (or (= request-size 0) eof) 371 | (fill-buffer-and-output)) 372 | (when eof (setq this-eof t))))) 373 | 374 | (buffer-to-output) 375 | (when (> request-size 0) 376 | (fill-buffer-and-output)) 377 | (values 378 | start 379 | this-eof))))) 380 | 381 | (defmethod stream-read-line ((stream ssh-channel-stream-input)) 382 | (let ((output '())) 383 | (labels 384 | ((repeat-not-wait () 385 | ;; Search for new line in cached tail 386 | (let* ((nl-pos (position (char-code '#\Newline) 387 | (input-buffer stream) 388 | :start (input-pos stream) 389 | :end (input-size stream))) 390 | (co-end (if nl-pos nl-pos (input-size stream)))) 391 | ;; Save substring or whole vector if any 392 | (when (> (input-size stream) 0) 393 | (push (subseq (input-buffer stream) 394 | (input-pos stream) 395 | co-end) 396 | output)) 397 | 398 | (if nl-pos 399 | ;; If newline found - save position and return concatenated string 400 | (prog1 401 | (babel:octets-to-string 402 | (apply #'concatenate 403 | (cons '(VECTOR 404 | (UNSIGNED-BYTE 405 | 8)) 406 | (reverse output)))) 407 | (setf (input-pos stream) (+ 1 co-end)) 408 | (setf output '())) 409 | 410 | ;; If not - try to catch next portion 411 | (multiple-value-bind (amount eof) 412 | (channel-read (channel stream) (input-buffer stream)) 413 | (cond 414 | ((not eof) 415 | (progn 416 | (setf (input-pos stream) 0) 417 | (setf (input-size stream) amount) 418 | (repeat-not-wait))) 419 | (t 420 | (if (not (null output)) 421 | ;; Return last cached data 422 | (let ((result 423 | (babel:octets-to-string 424 | (apply #'concatenate 425 | (cons '(VECTOR 426 | (UNSIGNED-BYTE 427 | 8)) 428 | (reverse output)))))) 429 | (setf (input-size stream) 0 430 | (input-pos stream) 0) 431 | (setf output '()) 432 | (values result t)) 433 | ;; Time to return nil 434 | (values nil t))))))))) 435 | (repeat-not-wait)))) 436 | 437 | (defmethod stream-finish-output* ((stream ssh-channel-stream-output) &key (dont-send-eof nil)) 438 | (with-slots (socket channel output-buffer output-pos output-size) stream 439 | (let ((retsize 0)) 440 | (do () ((= output-size output-pos)) 441 | (let ((amount (channel-write channel 442 | output-buffer 443 | :start output-pos 444 | :end output-size))) 445 | (incf output-pos amount) 446 | (incf retsize amount))) 447 | 448 | (setf output-pos 0 449 | output-size 0) 450 | 451 | (if dont-send-eof 452 | retsize 453 | (progn (channel-send-eof channel) 454 | (channel-flush channel) 455 | (channel-wait-eof channel) 456 | retsize))))) 457 | 458 | (defmethod stream-finish-output ((stream ssh-channel-stream)) 459 | 0) 460 | 461 | (defmethod stream-force-output ((stream ssh-channel-stream)) 462 | 0) 463 | 464 | (defmethod stream-finish-output ((stream ssh-channel-stream-output)) 465 | (stream-finish-output* stream)) 466 | 467 | (defmethod stream-force-output ((stream ssh-channel-stream-output)) 468 | (stream-finish-output* stream :dont-send-eof t)) 469 | 470 | (defmethod stream-write-byte ((stream ssh-channel-stream-output) byte) 471 | (with-slots (output-size output-buffer) stream 472 | (if (>= output-size (length output-buffer)) 473 | (stream-finish-output* stream :dont-send-eof t)) 474 | (when (< output-size (length output-buffer)) 475 | (prog1 476 | (setf (aref output-buffer output-size) byte) 477 | (incf output-size 1))))) 478 | 479 | (defmethod stream-write-char ((stream ssh-channel-stream-output) char) 480 | (stream-write-byte stream (char-code char))) 481 | 482 | (defmethod stream-write-sequence ((stream ssh-channel-stream-output) (sharable-sequence string) start end &key) 483 | ;; If string passed, then flush previous buffer if any 484 | ;; Then directly write this one 485 | (stream-finish-output* stream :dont-send-eof t) 486 | (channel-write-string (channel stream) 487 | sharable-sequence 488 | :start start 489 | :end end)) 490 | 491 | (defmethod stream-write-sequence ((stream ssh-channel-stream-output) sequence start end &key) 492 | (with-slots (output-pos output-size output-buffer) stream 493 | (let ((request-size (- end start)) 494 | (buffer-size (length output-buffer))) 495 | (labels ((push-to-stream () 496 | ;; If no room in internal buffer, then flush it 497 | (when (>= output-size buffer-size) 498 | (stream-finish-output* stream :dont-send-eof t)) 499 | ;; Get next portion of data 500 | (let ((portion (min request-size 501 | (- buffer-size output-size)))) 502 | ;; Save portion 503 | (replace output-buffer sequence 504 | :start1 output-size :end1 (+ output-size 505 | portion) 506 | :start2 start :end2 (+ start 507 | portion)) 508 | ;; Change stare 509 | (incf output-size portion) 510 | (incf start portion) 511 | (decf request-size portion)) 512 | 513 | ;; Repeat, if not all sequence sended 514 | (when (> request-size 0) 515 | (push-to-stream)))) 516 | 517 | ;; Start iterations 518 | (push-to-stream))))) 519 | 520 | (defmethod close ((stream ssh-channel-stream) &key abort) 521 | (let ((channel (channel stream))) 522 | (when (not (null-pointer-p channel)) 523 | (unwind-protect 524 | (progn 525 | (unless abort 526 | (stream-finish-output stream) 527 | (channel-wait-closed channel)) 528 | (channel-close channel) 529 | t) 530 | (channel-free channel))))) 531 | 532 | (defmethod execute ((ssh ssh-connection) (command string)) 533 | (with-slots (socket session) ssh 534 | (let ((new-channel 535 | (channel-open session))) 536 | (if (pointerp new-channel) 537 | (if (not (null-pointer-p new-channel)) 538 | (let ((retval (channel-exec new-channel command))) 539 | (if (eq retval :ERROR-NONE) 540 | (make-instance 'ssh-channel-exec 541 | :socket socket 542 | :channel new-channel) 543 | (throw-last-error session))) 544 | (throw-last-error session)) 545 | (throw-last-error session))))) 546 | 547 | (defmethod scp-input ((ssh ssh-connection) (path string)) 548 | (multiple-value-bind (new-channel stat) 549 | (channel-scp-recv (session ssh) path) 550 | (unless (null-pointer-p new-channel) 551 | (values 552 | (make-instance 'ssh-channel-recv 553 | :socket (socket ssh) 554 | :channel new-channel) 555 | stat)))) 556 | 557 | (defmethod scp-output ((ssh ssh-connection) (path string) size 558 | &key mode mtime atime) 559 | (let ((new-channel 560 | (channel-scp-send (session ssh) path size 561 | :mode mode 562 | :mtime mtime 563 | :atime atime))) 564 | (unless (null-pointer-p new-channel) 565 | (make-instance 'ssh-channel-send 566 | :socket (socket ssh) 567 | :channel new-channel)))) 568 | 569 | (defmacro with-execute ((stdio-stream ssh-connection command) 570 | &body body) 571 | `(let ((,stdio-stream (execute ,ssh-connection ,command))) 572 | (unwind-protect 573 | (let ((body-retval 574 | (progn ,@body))) 575 | (values-list 576 | (list body-retval 577 | (channel-exit-status (channel ,stdio-stream))))) 578 | (close ,stdio-stream)))) 579 | 580 | (defmacro with-execute* ((stdio-stream ssh-connection command) 581 | &body body) 582 | `(with-execute (,stdio-stream ,ssh-connection 583 | (concatenate 'string ,command " 2>&1")) 584 | (let ((*channel-read-zero-as-eof* t)) 585 | ,@body))) 586 | 587 | (defmacro with-scp-input ((istream ssh-connection path object-stat) 588 | &body body) 589 | `(multiple-value-bind (,istream ,object-stat) 590 | (scp-input ,ssh-connection ,path) 591 | (declare (ignore ,object-stat)) 592 | (unwind-protect 593 | (progn 594 | ,@body) 595 | (close ,istream)))) 596 | 597 | (defmacro with-scp-output ((ostream ssh-connection path size &key 598 | mtime atime mode) &body body) 599 | `(let ((,ostream (scp-output ,ssh-connection ,path ,size 600 | :mode ,mode :atime ,atime, :mtime ,mtime))) 601 | (unwind-protect 602 | (progn 603 | ,@body) 604 | (close ,ostream)))) 605 | -------------------------------------------------------------------------------- /libssh2/libssh2-cffi.lisp: -------------------------------------------------------------------------------- 1 | (in-package :libssh2) 2 | 3 | (defmacro result-or-error (&body body) 4 | `(let ((results (multiple-value-list (progn ,@body))) 5 | (throwable-errors *errors-list*)) 6 | (if (find (car results) 7 | throwable-errors) 8 | (error 'libssh2-invalid-error-code :code (car results)) 9 | (values-list results)))) 10 | 11 | (defun print-memory (addr size) 12 | (format t "~{~x ~}" 13 | (loop for i below size 14 | collect (mem-aref addr :unsigned-char i)))) 15 | 16 | (define-foreign-library libssh2 17 | (:darwin "libssh2.dylib") 18 | (:unix "libssh2.so.1") 19 | (:win32 "libssh2-1.dll") 20 | (t (:default "libssh2"))) 21 | 22 | (use-foreign-library libssh2) 23 | 24 | (defcfun ("libssh2_init" %library-init) +ERROR-CODE+) 25 | (defun library-init () 26 | (result-or-error 27 | (%library-init))) 28 | 29 | (defcfun ("libssh2_version" %library-version) :string 30 | (required :int)) 31 | 32 | (defcfun ("libssh2_exit" library-exit) :void) 33 | 34 | (defcfun ("libssh2_session_init_ex" session-init-ex) +session+ 35 | (alloc :pointer) (free :pointer) (realloc :pointer) (abstract :pointer)) 36 | (defcfun ("libssh2_session_free" %session-free) +ERROR-CODE+ 37 | (session +session+)) 38 | (defun session-free (session) 39 | (%session-free session)) 40 | 41 | (defcfun ("libssh2_session_last_error" %session-last-error) +ERROR-CODE+ 42 | (session +session+) 43 | (error-message :pointer) (error-message-buffer-size :pointer) 44 | (ownership :int)) 45 | 46 | (defun session-last-error (session) 47 | (with-foreign-objects ((fo-error-message-buffer-ptr :pointer 1) 48 | (fo-error-message-buffer-size :int 1)) 49 | (let ((retval (%session-last-error session 50 | fo-error-message-buffer-ptr 51 | fo-error-message-buffer-size 52 | 0))) 53 | (let ((error-message-ptr (mem-aref fo-error-message-buffer-ptr :pointer 0))) 54 | (values-list (list (convert-from-foreign error-message-ptr :string) 55 | retval)))))) 56 | 57 | 58 | (defcfun ("libssh2_session_last_errno" session-last-errno) +ERROR-CODE+ 59 | (session +session+)) 60 | 61 | (defcfun ("libssh2_trace" library-trace) :void 62 | (session +session+) (options +TRACE-OPTIONS+)) 63 | 64 | (defcfun ("libssh2_session_set_blocking" session-set-blocking) :void 65 | (session +session+) (blocking +BLOCKING+)) 66 | 67 | (defun session-init () 68 | (let ((session (session-init-ex (null-pointer) 69 | (null-pointer) 70 | (null-pointer) 71 | (null-pointer)))) 72 | (if (null-pointer-p session) 73 | (result-or-error :UNKNOWN) 74 | (progn 75 | (session-set-blocking session :NON-BLOCKING) 76 | session)))) 77 | 78 | (defcfun ("libssh2_session_disconnect_ex" %session-disconnect) +ERROR-CODE+ 79 | (session +session+) (reason +DISCONNECT-CODE+) (description :string) (lang :string)) 80 | 81 | (defun session-disconnect (session &key 82 | (reason :AUTH-CANCELLED-BY-USER) 83 | (description "") 84 | (lang "")) 85 | (with-foreign-strings ((fs-description description) 86 | (fs-lang lang)) 87 | (result-or-error 88 | (%session-disconnect session reason fs-description fs-lang)))) 89 | 90 | (defmacro with-session ( (session) &body body ) 91 | `(let ((,session (session-init))) 92 | (unwind-protect 93 | (progn 94 | ,@body) 95 | (session-free ,session)))) 96 | 97 | (if (foreign-symbol-pointer "libssh2_session_handshake") 98 | (defcfun ("libssh2_session_handshake" %session-handshake) +ERROR-CODE+ 99 | (session +session+) (socket :int)) 100 | (defcfun ("libssh2_session_startup" %session-handshake) +ERROR-CODE+ 101 | (session +session+) (socket :int))) 102 | 103 | (defun session-handshake (session socket) 104 | (result-or-error 105 | (%session-handshake session socket))) 106 | 107 | (defcfun ("libssh2_userauth_list" %session-auth-methods-list) :string 108 | (session +session+) (username :string) (username-length :unsigned-int)) 109 | 110 | (defun session-auth-methods-list (session username) 111 | (with-foreign-string ((fs-username fs-username-size) username) 112 | (let ((result (%session-auth-methods-list 113 | session fs-username (- fs-username-size 1)))) 114 | (if result 115 | (mapcar (lambda (item) (intern (string-upcase item) 'keyword)) 116 | (split-sequence:split-sequence 117 | #\, result)) 118 | (result-or-error 119 | (session-last-errno session)))))) 120 | 121 | (defcfun ("libssh2_agent_init" %agent-init) +ssh-agent+ 122 | (session +session+)) 123 | 124 | (defmacro with-agent ((agent session) &body body) 125 | `(let ((,agent (agent-init ,session))) 126 | (unwind-protect 127 | (progn ,@body) 128 | (unless (null-pointer-p ,agent) 129 | (agent-free ,agent))))) 130 | 131 | (defun agent-init (session) 132 | (let ((agent (%agent-init session))) 133 | (if (null-pointer-p agent) 134 | (result-or-error 135 | (session-last-errno session)) 136 | agent))) 137 | 138 | (defcfun ("libssh2_agent_free" agent-free) :void 139 | (agent +ssh-agent+)) 140 | 141 | (defcfun ("libssh2_agent_connect" %agent-connect) +ERROR-CODE+ 142 | (agent +ssh-agent+)) 143 | (defun agent-connect (agent) 144 | (result-or-error 145 | (%agent-connect agent))) 146 | 147 | (defcfun ("libssh2_agent_disconnect" %agent-disconnect) +ERROR-CODE+ 148 | (agent +ssh-agent+)) 149 | (defun agent-disconnect (agent) 150 | (result-or-error 151 | (%agent-disconnect agent))) 152 | 153 | (defcfun ("libssh2_agent_list_identities" %agent-list-identies) +ERROR-CODE+ 154 | (agent +ssh-agent+)) 155 | (defun agent-list-identies (agent) 156 | (result-or-error 157 | (%agent-list-identies agent))) 158 | 159 | (defcfun ("libssh2_agent_get_identity" %agent-get-identity) +IDENTITY-AMOUNT+ 160 | (agent +ssh-agent+) 161 | (store :pointer) (previous-public-key :pointer)) 162 | 163 | (defun agent-identities-iterator (agent) 164 | (when (eq (agent-list-identies agent) :ERROR-NONE) 165 | (let ((agent agent) 166 | (prev (null-pointer))) 167 | (lambda () 168 | (with-foreign-object (store :pointer) 169 | (unless (eq (%agent-get-identity agent store prev) 170 | :END) 171 | (setf prev 172 | (mem-aref store :pointer 0)))))))) 173 | 174 | (defmacro foreach-agent-identity ((identy agent) &body body) 175 | `(let ((agent ,agent) 176 | (list-identies (agent-list-indenties ,agent)) 177 | (prev (null-pointer))) 178 | (if (eq list-identies :ERROR-NONE) 179 | (with-foreign-object (store :pointer) 180 | (labels 181 | ((process-next-identity () 182 | (unless (eq (--agent-get-identity agent store prev) 183 | :END) 184 | (let ((,identy (setf prev 185 | (mem-aref store :pointer 0)))) 186 | ,@body 187 | (process-next-identity))))) 188 | (process-next-identity)))))) 189 | 190 | (defcfun ("libssh2_knownhost_init" %known-hosts-init) +known-hosts+ 191 | (session +session+)) 192 | (defun known-hosts-init (session) 193 | (let ((known-hosts (%known-hosts-init session))) 194 | (if (null-pointer-p known-hosts) 195 | (result-or-error 196 | (session-last-errno session)) 197 | known-hosts))) 198 | 199 | (defcfun ("libssh2_knownhost_free" known-hosts-free) :void 200 | (known-hosts +known-hosts+)) 201 | 202 | (defcfun ("libssh2_knownhost_readfile" %known-hosts-readfile) :int 203 | (known-hosts +known-hosts+) (filename :string) (type :int)) 204 | 205 | (defcfun ("libssh2_knownhost_writefile" %known-hosts-writefile) :int 206 | (known-hosts +known-hosts+) (filename :string) (type :int)) 207 | 208 | (defun known-hosts-readfile (hosts file) 209 | (with-foreign-string (foreign-file file) 210 | (let ((ret (%known-hosts-readfile hosts foreign-file 1))) 211 | (if (>= ret 0) 212 | (convert-from-foreign 0 '+ERROR-CODE+) 213 | (result-or-error 214 | (convert-from-foreign ret '+ERROR-CODE+)))))) 215 | 216 | (defun known-hosts-writefile (hosts file) 217 | (with-foreign-string (foreign-file file) 218 | (let ((ret (%known-hosts-writefile hosts foreign-file 1))) 219 | (if (>= ret 0) 220 | (convert-from-foreign 0 '+ERROR-CODE+) 221 | (result-or-error 222 | (convert-from-foreign ret '+ERROR-CODE+)))))) 223 | 224 | (defcfun ("libssh2_session_hostkey" %session-hostkey) +key+ 225 | (session +session+) (len :pointer) (type :pointer)) 226 | 227 | (defun session-hostkey (session) 228 | (with-foreign-objects ((len :unsigned-int 1) 229 | (type :int 1)) 230 | (let ((result (%session-hostkey session len type))) 231 | (make-key :data result 232 | :size (mem-aref len :long 0) 233 | :type (mem-aref type :int 0))))) 234 | 235 | (defcfun ("libssh2_hostkey_hash" session-hostkey-hash) +keyhash+ 236 | (session +session+) (hash-type +HASH-TYPE+)) 237 | 238 | (defun session-hostkey-fingerprint (session &optional (type :SHA1)) 239 | (let ((hash (session-hostkey-hash session type))) 240 | (format nil "~{~2,'0X~^:~}" 241 | (loop for i below (if (eq type :SHA1) 20 16) 242 | collect (mem-aref hash :unsigned-char i))))) 243 | 244 | (defcfun ("libssh2_knownhost_checkp" %known-hosts-checkp) +CHECK-VERDICT+ 245 | (known-hosts +known-hosts+) (hostname :string) (port :int) 246 | (key +key+) (key-data-size :unsigned-int) 247 | (type :int) (known-host :pointer)) 248 | 249 | (defcfun ("libssh2_knownhost_check" %known-hosts-check) +CHECK-VERDICT+ 250 | (known-hosts +known-hosts+) (hostname :string) 251 | (key +key+) (key-data-size :unsigned-int) 252 | (type :int) (known-host :pointer)) 253 | 254 | (defun known-hosts-check (known-hosts hostname key 255 | &key 256 | (port nil) 257 | (flags '(.type-plain. .raw.)) 258 | (known-host (null-pointer))) 259 | (let ((fp (key-data key))) 260 | (if (null-pointer-p fp) 261 | (result-or-error :UNKNOWN) 262 | (with-foreign-string (fs-hostname hostname) 263 | (with-foreign-object (hostinfo :pointer 1) 264 | (setf (mem-aref hostinfo :pointer 0) known-host) 265 | (if port 266 | (%known-hosts-checkp known-hosts fs-hostname port 267 | fp 268 | (key-size key) 269 | (foreign-bitfield-value '+known-hosts-flags+ flags) 270 | hostinfo) 271 | (%known-hosts-check known-hosts fs-hostname 272 | fp 273 | (key-size key) 274 | (foreign-bitfield-value '+known-hosts-flags+ flags) 275 | hostinfo))))))) 276 | 277 | (define-condition known-hosts-reading-error (ssh-generic-error) 278 | ((file :type string 279 | :initarg :file 280 | :accessor file))) 281 | 282 | (defmethod print-object :after ((khre known-hosts-reading-error) stream) 283 | (format stream "// ~a" (file khre))) 284 | 285 | (defmacro with-known-hosts ( ( known-hosts (session known-hosts-filename)) &body body ) 286 | `(let ((,known-hosts (known-hosts-init ,session)) 287 | (*errors-list* (remove :ERROR-FILE *default-errors-list*))) 288 | (unwind-protect 289 | (if (and (not (null-pointer-p ,known-hosts)) 290 | (eq (labels 291 | ((try-again () 292 | (let ((result (known-hosts-readfile ,known-hosts ,known-hosts-filename))) 293 | (if (eq result :ERROR-FILE) 294 | (restart-case 295 | (with-last-error (,session known-hosts-reading-error) 296 | :file ,known-hosts-filename) 297 | (try-create-file () 298 | (unless 299 | (eq (known-hosts-writefile ,known-hosts ,known-hosts-filename) 300 | :ERROR-NONE) 301 | (with-last-error (,session known-hosts-reading-error) 302 | :file ,known-hosts-filename)) 303 | (try-again)) 304 | (ignore () nil)) 305 | result)))) 306 | (try-again)) :ERROR-NONE)) 307 | (progn 308 | ,@body) 309 | (with-last-error (,session known-hosts-reading-error) 310 | :file ,known-hosts-filename)) 311 | (unless (null-pointer-p ,known-hosts) 312 | (known-hosts-free ,known-hosts))))) 313 | 314 | (defcfun ("libssh2_knownhost_addc" %known-hosts-addc) +ERROR-CODE+ 315 | (known-hosts +known-hosts+) 316 | (host :string) (salt :string) (key :pointer) (key-length :unsigned-int) 317 | (comment :string) (comment-length :unsigned-int) 318 | (typemask :int) (known-host +known-host+)) 319 | 320 | (defun known-hosts-add (known-hosts host-full-string key 321 | &key 322 | (comment "") 323 | (flags '(.type-plain. .raw. .ssh.)) 324 | (salt "") 325 | (store (null-pointer))) 326 | (if (and (not (null-pointer-p known-hosts)) 327 | (not (null-pointer-p (key-data key))) 328 | (stringp host-full-string)) 329 | (with-foreign-strings ((fs-host-full-string host-full-string) 330 | (fs-salt salt) 331 | ((fs-comment fs-comment-size) comment)) 332 | (result-or-error 333 | (%known-hosts-addc known-hosts 334 | fs-host-full-string fs-salt 335 | (key-data key) (key-size key) 336 | fs-comment (- fs-comment-size 1) 337 | (foreign-bitfield-value '+known-hosts-flags+ flags) 338 | store))))) 339 | 340 | (defcfun ("libssh2_agent_userauth" %agent-userauth) +ERROR-CODE+ 341 | (agent +ssh-agent+) (username :string) (identity :pointer)) 342 | 343 | (defun user-auth-agent (agent username identity) 344 | (with-foreign-string (fs-username username) 345 | (result-or-error 346 | (%agent-userauth agent fs-username identity)))) 347 | 348 | (defcfun ("libssh2_userauth_password_ex" %user-auth-password) +ERROR-CODE+ 349 | (session +session+) 350 | (username :string) (username-length :unsigned-int) 351 | (password :string) (password-length :unsigned-int) 352 | (password-change :pointer)) 353 | 354 | (defun user-auth-password (session username password &optional (callback (null-pointer))) 355 | (with-foreign-strings (((fs-username fs-username-size) username) 356 | ((fs-password fs-password-size) password)) 357 | (result-or-error 358 | (%user-auth-password session 359 | fs-username (- fs-username-size 1) 360 | fs-password (- fs-password-size 1) 361 | callback)))) 362 | 363 | (defcfun ("libssh2_userauth_keyboard_interactive_ex" %user-auth-interactive) +ERROR-CODE+ 364 | (session +session+) 365 | (username :string) (username-length :unsigned-int) 366 | (callback :pointer)) 367 | 368 | (defun user-auth-interactive (session username callback) 369 | (with-foreign-string ((fs-username fs-username-size) username) 370 | (%user-auth-interactive session 371 | fs-username 372 | (- fs-username-size 1) 373 | callback))) 374 | 375 | (defvar *keyboard-interactive-password* "") 376 | (defcallback trivial-keyboard-interactive-emulation :void 377 | ((login :pointer) (login-length :unsigned-int) 378 | (instruction :string) (instruction-length :unsigned-int) 379 | (num-prompts :int) 380 | (prompts (:pointer +kbd-prompt+)) 381 | (responses (:pointer +kbd-response+)) 382 | (abstract (:pointer :pointer))) 383 | ;; Just don't care about input. Only send password 384 | ;; Please, write you'r own callback, if you care 385 | (declare 386 | (ignore login) (ignore login-length) 387 | (ignore instruction) (ignore instruction-length) 388 | (ignore prompts) (ignore abstract)) 389 | (loop for i below num-prompts 390 | do 391 | (with-foreign-slots ((text length) 392 | (mem-aref responses '+kbd-response+ i) 393 | +kbd-response+) 394 | (setf text (foreign-string-alloc *keyboard-interactive-password*)) 395 | (setf length (foreign-funcall "strlen" :pointer text :unsigned-int))))) 396 | 397 | (defun user-auth-interactive-trivial (session username password) 398 | (let ((*keyboard-interactive-password* password)) 399 | (user-auth-interactive session username 400 | (callback trivial-keyboard-interactive-emulation)))) 401 | 402 | (defcfun ("libssh2_userauth_publickey_fromfile_ex" %user-auth-publickey) +ERROR-CODE+ 403 | (session +session+) 404 | (username :string) (username-len :unsigned-int) 405 | (public-key :string) 406 | (private-key :string) (password :string)) 407 | 408 | (defun user-auth-publickey (session username public-key private-key password) 409 | (with-foreign-strings (((fs-username fs-username-size) username) 410 | (fs-public-key public-key) 411 | (fs-private-key private-key) 412 | (fs-password password)) 413 | (result-or-error 414 | (%user-auth-publickey session fs-username (- fs-username-size 1) 415 | fs-public-key fs-private-key fs-password)))) 416 | 417 | (defcfun ("libssh2_channel_open_ex" %channel-open-ex) +channel+ 418 | (session +session+) (channel-type :string) (channel-type-length :unsigned-int) 419 | (window-size :unsigned-int) (packet-size :unsigned-int) 420 | (message :string) (message-length :unsigned-int)) 421 | 422 | (defun channel-open (session &key (channel-type "session") 423 | (window-size 262144) 424 | (packet-size 32768) 425 | (message "")) 426 | (with-foreign-strings (((fs-channel-type fs-channel-type-size) channel-type) 427 | ((fs-message fs-message-size) message)) 428 | (let* ((pass-message (if (string= message "") 429 | (null-pointer) 430 | fs-message)) 431 | (pass-message-size (if (string= message "") 432 | 0 433 | (- fs-message-size 1))) 434 | (new-channel 435 | (%channel-open-ex session 436 | fs-channel-type (- fs-channel-type-size 1) 437 | window-size packet-size 438 | pass-message 439 | pass-message-size))) 440 | (if (null-pointer-p new-channel) 441 | (result-or-error 442 | (session-last-errno session)) 443 | new-channel)))) 444 | 445 | (defcfun ("libssh2_channel_close" %channel-close) +ERROR-CODE+ 446 | (channel +channel+)) 447 | (defun channel-close (channel) 448 | (result-or-error 449 | (%channel-close channel))) 450 | 451 | (defcfun ("libssh2_channel_free" %channel-free) +ERROR-CODE+ 452 | (channel +channel+)) 453 | (defun channel-free (channel) 454 | (result-or-error 455 | (%channel-free channel))) 456 | 457 | (defcfun ("libssh2_channel_wait_closed" %channel-wait-closed) +ERROR-CODE+ 458 | (channel +channel+)) 459 | (defun channel-wait-closed (channel) 460 | (result-or-error 461 | (%channel-wait-closed channel))) 462 | 463 | (defcfun ("libssh2_channel_wait_eof" %channel-wait-eof) +ERROR-CODE+ 464 | (channel +channel+)) 465 | (defun channel-wait-eof (channel) 466 | (result-or-error 467 | (%channel-wait-eof channel))) 468 | 469 | (defcfun ("libssh2_channel_process_startup" %channel-process-startup) +ERROR-CODE+ 470 | (channel +channel+) 471 | (request :string) (request-length :unsigned-int) 472 | (message :string) (message-length :unsigned-int)) 473 | 474 | (defcfun ("libssh2_channel_setenv_ex" %channel-setenv-ex) +ERROR-CODE+ 475 | (channel +channel+) 476 | (varname :string) (varname-len :int) 477 | (value :string) (value-len :int)) 478 | 479 | (defun channel-setenv (channel name value) 480 | (with-foreign-strings (((fs-name fs-name-size) name) 481 | ((fs-value fs-value-size) value)) 482 | (result-or-error 483 | (%channel-setenv-ex channel 484 | fs-name (- fs-name-size 1) 485 | fs-value (- fs-value-size 1))))) 486 | 487 | (defun channel-process-start (channel request message) 488 | (with-foreign-strings (((fs-request fs-request-size) request) 489 | ((fs-message fs-message-size) message)) 490 | (result-or-error 491 | (%channel-process-startup channel 492 | fs-request (- fs-request-size 1) 493 | fs-message (- fs-message-size 1))))) 494 | 495 | (defun channel-exec (channel cmd) 496 | (channel-process-start channel "exec" cmd)) 497 | 498 | (defun channel-shell (channel cmd) 499 | (channel-process-start channel "shell" cmd)) 500 | 501 | (defun channel-subsystem (channel cmd) 502 | (channel-process-start channel "subsystem" cmd)) 503 | 504 | (defcfun ("libssh2_channel_read_ex" %channel-read-ex) :int 505 | (channel +CHANNEL+) (stream +STREAM-ID+) 506 | (buffer :pointer) (buffer-length :unsigned-int)) 507 | 508 | (defcfun ("libssh2_channel_flush_ex" %channel-flush-ex) :int 509 | (channel +CHANNEL+) (stream +STREAM-ID+)) 510 | 511 | (defun channel-flush (channel) 512 | (let ((ret (%channel-flush-ex channel :ALL))) 513 | (if (> ret 0) 514 | :ERROR-NONE 515 | (result-or-error 516 | (convert-from-foreign ret '+ERROR-CODE+))))) 517 | 518 | (defvar *channel-read-type* :STDOUT) 519 | (defvar *channel-read-zero-as-eof* nil) 520 | (defun channel-read (channel output-buffer &key (start 0) (end nil) (type *channel-read-type*)) 521 | (with-pointer-to-vector-data (buffer output-buffer) 522 | (let ((ret (%channel-read-ex channel type 523 | (inc-pointer buffer start) 524 | (if end 525 | (- (min end (length output-buffer)) 526 | start) 527 | (- (length output-buffer) 528 | start))))) 529 | (if (>= ret 0) 530 | (values 531 | ret 532 | (cond 533 | ((and (= ret 0) *channel-read-zero-as-eof*) t) 534 | ((= ret 0) (channel-eofp channel)) 535 | (t nil))) 536 | (result-or-error 537 | (convert-from-foreign ret '+ERROR-CODE+)))))) 538 | 539 | (defcfun ("libssh2_channel_write_ex" %channel-write-ex) :int 540 | (channel +CHANNEL+) (stream +STREAM-ID+) 541 | (buffer :pointer) (buffer-length :unsigned-int)) 542 | 543 | (defmacro channel-write-with-conv (name conv) 544 | `(defun ,name (channel data &key (start 0) (end nil) (type *channel-read-type*)) 545 | (,conv (buffer data) 546 | (let ((ret (%channel-write-ex channel type 547 | (inc-pointer buffer start) 548 | (if end 549 | (- (min end (length data)) 550 | start) 551 | (- (length data) 552 | start))))) 553 | (if (>= ret 0) 554 | ret 555 | (result-or-error 556 | (convert-from-foreign ret '+ERROR-CODE+))))))) 557 | 558 | (channel-write-with-conv channel-write with-pointer-to-vector-data) 559 | (channel-write-with-conv channel-write-string with-foreign-string) 560 | 561 | (defcfun ("libssh2_channel_send_eof" %channel-send-eof) +ERROR-CODE+ 562 | (channel +channel+)) 563 | (defun channel-send-eof (channel) 564 | (result-or-error 565 | (%channel-send-eof channel))) 566 | 567 | (defcfun ("libssh2_channel_eof" %channel-eofp) +CHANNEL-EOF+ 568 | (channel +channel+)) 569 | (defun channel-eofp (channel) 570 | (eq (%channel-eofp channel) :EOF)) 571 | 572 | (defcfun ("libssh2_channel_get_exit_status" channel-exit-status) :int 573 | (channel +channel+)) 574 | 575 | ;; (defcfun ("libssh2_channel_get_exit_signal" --channel-exit-signal) +ERROR-CODE+ 576 | ;; (channel +channel+) 577 | 578 | (defcfun ("libssh2_scp_recv" %scp-recv) +channel+ 579 | (session +session+) (path :string) (stat +stat+)) 580 | 581 | (defun channel-scp-recv (session path) 582 | (with-foreign-string (fs-path path) 583 | (with-foreign-object (stat '+stat+ 1) 584 | (let ((result (%scp-recv session path stat))) 585 | (if (null-pointer-p result) 586 | (result-or-error 587 | (session-last-errno session)) 588 | (progn 589 | (channel-send-eof result) 590 | (values result 591 | (with-foreign-slots ((mode mtime atime) stat +stat+) 592 | (list :mode mode 593 | :mtime mtime 594 | :atime atime))))))))) 595 | 596 | (defcfun ("libssh2_scp_send_ex" %scp-send-ex) +channel+ 597 | (session +session+) (path :string) (mode :int) (size :unsigned-int) 598 | (mtime :long) (atime :long)) 599 | 600 | (defun get-universal-unix-time () 601 | (- (get-universal-time) 602 | (encode-universal-time 0 0 0 1 1 1970 0))) 603 | 604 | (defun channel-scp-send (session path size 605 | &key mode mtime atime) 606 | (unless mode (setq mode #b110100000)) 607 | (unless mtime (setq mtime (get-universal-unix-time))) 608 | (unless atime (setq atime mtime)) 609 | (with-foreign-string (fs-path path) 610 | (let ((result (%scp-send-ex session fs-path 611 | mode size mtime 612 | atime))) 613 | (if (null-pointer-p result) 614 | (result-or-error 615 | (session-last-errno session)) 616 | result)))) 617 | --------------------------------------------------------------------------------