From imattsson at common-lisp.net Thu Aug 27 18:33:47 2009 From: imattsson at common-lisp.net (imattsson) Date: Thu, 27 Aug 2009 14:33:47 -0400 Subject: [noctool-cvs] CVS Message-ID: 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)) From imattsson at common-lisp.net Fri Aug 28 05:56:48 2009 From: imattsson at common-lisp.net (imattsson) Date: Fri, 28 Aug 2009 01:56:48 -0400 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv7926 Modified Files: noctool.asd Log Message: IM Added the "ssh-package" and "ssh-cffi" files to the system definition. Either comments them out or install libssh2 on the build/monitor host to make things happy. --- /project/noctool/cvsroot/source/noctool.asd 2009/04/28 17:53:07 1.8 +++ /project/noctool/cvsroot/source/noctool.asd 2009/08/28 05:56:47 1.9 @@ -4,8 +4,10 @@ :author "Ingvar Mattsson / Jim Prewett" :license "GPL" :version "0.1" - :depends-on (:usocket :cl-ppcre :ironclad :image :sb-posix :cl+ssl) + :depends-on (:usocket :cl-ppcre :ironclad :image :sb-posix :cl+ssl :cffi) :components ((:file "packages") + (:file "ssh-package") + (:file "ssh-cffi" :depends-on ("ssh-package")) (:file "scheduler" :depends-on ("packages")) (:file "network-globals" :depends-on ("packages")) (:file "globals" :depends-on ("packages"))