[noctool-cvs] CVS
imattsson
imattsson at common-lisp.net
Thu Aug 27 18:33:47 UTC 2009
Update of /project/noctool/cvsroot
In directory cl-net:/tmp/cvs-serv20288
Added Files:
ssh-cffi.lisp ssh-package.lisp
Log Message:
IM
Added two files to provide a binding to libssh2, to avoid execing.
--- /project/noctool/cvsroot/ssh-cffi.lisp 2009/08/27 18:33:47 NONE
+++ /project/noctool/cvsroot/ssh-cffi.lisp 2009/08/27 18:33:47 1.1
(in-package :noctool-ssh)
(defvar *null* (null-pointer))
(define-foreign-library libssh2
(:unix "/usr/lib/libssh2.so")
(t "libssh2.so"))
(use-foreign-library libssh2)
;; Definitions
(defcenum libssh2-hash
(:LIBSSH2_HOSTKEY_HASH_MD5 1)
(:LIBSSH2_HOSTKEY_HASH_SHA1 2))
(defconstant +CHANNEL-WINDOW-DEFAULT+ 65536)
(defconstant +CHANNEL-PACKET-DEFAULT+ 32768)
(defconstant +TERM-WIDTH+ 80)
(defconstant +TERM-HEIGHT+ 24)
(defconstant +TERM-WIDTH-PX+ 0)
(defconstant +TERM-HEIGHT-PX+ 0)
(defconstant +EXTENDED-DATA-STDERR+ 1)
(defconstant +CHANNEL-FLUSH-EXTENDED-DATA+ -1)
(defconstant +CHANNEL-FLUSH-ALL+ -2)
(defconstant +SSH-DISCONNECT-HOST-NOT-ALLOWED-TO-CONNECT+ 1)
(defconstant +SSH-DISCONNECT-PROTOCOL-ERROR+ 2)
(defconstant +SSH-DISCONNECT-KEY-EXCHANGE-FAILED+ 3)
(defconstant +SSH-DISCONNECT-RESERVED+ 4)
(defconstant +SSH-DISCONNECT-MAC-ERROR+ 5)
(defconstant +SSH-DISCONNECT-COMPRESSION-ERROR+ 6)
(defconstant +SSH-DISCONNECT-SERVICE-NOT-AVAILABLE+ 7)
(defconstant +SSH-DISCONNECT-PROTOCOL-VERSION-NOT-SUPPORTED+ 8)
(defconstant +SSH-DISCONNECT-HOST-KEY-NOT-VERIFIABLE+ 9)
(defconstant +SSH-DISCONNECT-CONNECTION-LOST+ 10)
(defconstant +SSH-DISCONNECT-BY-APPLICATION+ 11)
(defconstant +SSH-DISCONNECT-TOO-MANY-CONNECTIONS+ 12)
(defconstant +SSH-DISCONNECT-AUTH-CANCELLED-BY-USER+ 13)
(defconstant +SSH-DISCONNECT-NO-MORE-AUTH-METHODS-AVAILABLE+ 14)
(defconstant +SSH-DISCONNECT-ILLEGAL-USER-NAME+ 15)
(defclass internal-ssh-wrapper ()
((socket :reader socket :initarg :socket)
(session :reader session :initarg :session)
(channel :accessor channel :initarg :channel :initform nil)
)
)
;; External functions
(defcfun "libssh2_session_init_ex" :pointer (allocator :pointer) (freeer :pointer) (reallocator :pointer) (abstract :pointer))
(defcfun "libssh2_session_startup" :int
(session :pointer) (socket :int))
(defcfun "libssh2_userauth_list" :string
(session :pointer) (username :string) (length :int))
(defcfun "libssh2_hostkey_hash" :string
(session :pointer) (hash :int))
(defcfun "libssh2_userauth_password_ex" :int
(session :pointer) (username :string) (ulen :int)
(passwd :string) (plen :int) (changefun :pointer))
(defcfun "libssh2_userauth_publickey_fromfile_ex" :int
(session :pointer) (username :string) (ulen :int)
(publickey :string) (privatekey :string) (passphrase :string))
(defcfun "libssh2_channel_open_ex" :pointer
(session :pointer) (channeltype :string) (ctlen :int)
(winsize :int) (packetsize :int) (message :string) (mlen :int))
(defcfun "libssh2_channel_request_pty_ex" :int
(channel :pointer) (terminal :string) (tlen :int) (modes :string) (mlen :int)
(width :int) (height :int) (widthpx :int) (heightpx :int))
(defcfun "libssh2_channel_setenv_ex" :int
(channel :pointer) (varname :string) (carlen :int)
(value :string) (vallen :int))
(defcfun "libssh2_channel_process_startup" :int
(channel :pointer) (request :string) (reqlen :int)
(message :string) (msglen :int))
(defcfun "libssh2_channel_read_ex" :int
(channel :pointer) (streamid :int) (buffer (:pointer :char)) (buflen :int))
(defcfun "libssh2_channel_write_ex" :int
(channel :pointer) (streamid :int) (buffer :string) (buflen :int))
(defcfun "libssh2_channel_set_blocking" :void
(channel :pointer) (blocking :int))
(defcfun "libssh2_channel_flush_ex" :int
(channel :pointer) (streamid :int))
(defcfun "libssh2_channel_close" :int (channel :pointer))
(defcfun "libssh2_channel_free" :int (channel :pointer))
(defcfun "libssh2_session_disconnect_ex" :int
(sesison :pointer) (reason :int) (description :string) (lang :string))
(defcfun "libssh2_session_free" :int (session ':pointer))
;;; Utility functions
(defun socket-fd (socket)
#+sbcl
(sb-bsd-sockets:socket-file-descriptor (usocket:socket socket))
#-(or sbcl)
(error "Not implemented"))
(defun split (str &key (seps '(#\,)))
(let ((end-pos (loop for pos = 0 then (1+ next)
for next = (position-if (lambda (c)
(member c seps :test #'char=))
str :start pos)
while next
collect next)))
(let ((starts (cons 0 (mapcar #'1+ end-pos)))
(end-pos (append end-pos '(nil))))
(loop for start in starts
for end in end-pos
collect (subseq str start end)))))
(defun pubkey (name)
(format nil "~a.pub" name))
;;; Wrappers
(defun libssh2-session-init ()
(libssh2-session-init-ex *null* *null* *null* *null*))
(defun libssh2-channel-open-session (session)
(libssh2-channel-open-ex session "session" (length "session")
+channel-window-default+ +channel-packet-default+
*null* 0))
(defun libssh2-channel-request-pty (channel terminal)
(libssh2-channel-request-pty-ex
channel terminal (length terminal)
*null* 0 +term-width+ +term-height+ +term-width-px+ +term-height-px+))
(defun ssh-connect (host username &key password keyfile passphrase (port 22))
(unless username
(error "Need a username"))
(unless (or password keyfile)
(error "Need at least one of keyfile or password"))
(let ((socket (usocket:socket-connect host port))
(session (libssh2-session-init)))
(let ((fd (socket-fd socket))
(rv (make-instance 'internal-ssh-wrapper :socket socket :session session)))
(libssh2-session-startup session fd)
(let ((methods (split (libssh2-userauth-list
session username (length username)))))
(when (and password (member "password" methods :test #'string=))
(when (zerop (libssh2-userauth-password-ex
session username (length username)
password (length password) *null*))
(return-from ssh-connect rv)))
(when (and passphrase keyfile (member "publickey" methods :test #'string=))
(let ((pubfile (pubkey keyfile)))
(when (zerop (libssh2-userauth-fromfile-ex
session username (length username)
pubfile keyfile passphrase))
(return-from ssh-connect rv))))))))
(defun make-channel (session &key command envpairs (term "vanilla") (message ""))
(let ((channel (libssh2-channel-open-session (session session))))
(when channel
(loop for (var val) in envpairs
do (libssh2-channel-setenv-ex channel
var (length var) val (length val)))
(when (zerop (libssh2-channel-request-pty channel term))
(let ((cmd (if command "exec" "shell"))
(msg (or command *null*))
(msglen (if command (length command) 0)))
(libssh2-channel-process-startup channel cmd (length cmd) msg msglen)))
(libssh2-channel-set-blocking channel 0)
(setf (channel session) channel))))
(defun ssh-read (session &key (stream :stdout) (buflen 200))
(when (null (channel session))
(error "Not connected!"))
(let ((sid (ecase stream
(:stdout 0)
(:stderr +extended-data-stderr+)))
(channel (channel session))
(buf (foreign-alloc :char :initial-element 0 :count (1+ buflen))))
(unwind-protect
(with-output-to-string (rv)
(loop for cnt = (libssh2-channel-read-ex channel sid buf buflen)
until (<= cnt 0)
do (write-string (foreign-string-to-lisp buf cnt nil) rv)
))
(foreign-free buf))))
(defun ssh-write (session string &key (stream :stdout))
(when (null (channel session))
(error "Not connected!"))
(let ((sid (ecase stream
(:stdout 0)
(:stderr +extended-data-stderr+)))
(channel (channel session)))
(libssh2-channel-write-ex channel sid string (length string))))
(defun ssh-close-channel (session)
(when (channel session)
(libssh2-close-channel (channel session))
(libssh2-free-channel (channel session))
(setf (channel session) nil)))
(defun ssh-close (session)
(ssh-close-channel session)
(libssh2-session-disconnect-ex (session session) +ssh-disconnect-by-application+ "Normal shutdown" "")
(libssh2-session-free (session session)))
--- /project/noctool/cvsroot/ssh-package.lisp 2009/08/27 18:33:47 NONE
+++ /project/noctool/cvsroot/ssh-package.lisp 2009/08/27 18:33:47 1.1
(in-package :cl-user)
(defpackage #:noctool-ssh
(:use #:cl #:cffi)
(:export #:ssh-connect #:ssh-read #:ssh-write))
More information about the noctool-cvs
mailing list