From 78eea2456275c46c03f6f1a8c96a7de67cd6ab7a Mon Sep 17 00:00:00 2001 From: dlichteblau Date: Sat, 7 Jul 2007 15:25:09 +0000 Subject: [PATCH] clisp patch by Pixel // pinterface --- LICENSE | 1 + cl+ssl.asd | 4 ++++ ffi-buffer-all.lisp | 12 ++++++++++++ ffi-buffer-clisp.lisp | 29 +++++++++++++++++++++++++++++ ffi-buffer.lisp | 22 ++++++++++++++++++++++ index.html | 6 ++++++ streams.lisp | 41 ++++++++++++++++++++--------------------- 7 files changed, 94 insertions(+), 21 deletions(-) create mode 100644 ffi-buffer-all.lisp create mode 100644 ffi-buffer-clisp.lisp create mode 100644 ffi-buffer.lisp diff --git a/LICENSE b/LICENSE index 632d884..9a536ca 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,7 @@ Copyright (C) 2001, 2003 Eric Marsden Copyright (C) ???? Jochen Schmidt Copyright (C) 2005 David Lichteblau +Copyright (C) 2007 Pixel // pinterface * License first changed by Eric Marsden, Jochen Schmidt, and David Lichteblau from plain LGPL to Lisp-LGPL in December 2005. diff --git a/cl+ssl.asd b/cl+ssl.asd index c7754c4..54ce8cf 100644 --- a/cl+ssl.asd +++ b/cl+ssl.asd @@ -2,6 +2,7 @@ ;;; ;;; Copyright (C) 2001, 2003 Eric Marsden ;;; Copyright (C) 2005 David Lichteblau +;;; Copyright (C) 2007 Pixel // pinterface ;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt." ;;; ;;; See LICENSE for details. @@ -19,5 +20,8 @@ (:file "reload") (:file "conditions") (:file "ffi") + (:file "ffi-buffer-all") + #-clisp (:file "ffi-buffer") + #+clisp (:file "ffi-buffer-clisp") (:file "streams") (:file "bio"))) diff --git a/ffi-buffer-all.lisp b/ffi-buffer-all.lisp new file mode 100644 index 0000000..0257db0 --- /dev/null +++ b/ffi-buffer-all.lisp @@ -0,0 +1,12 @@ +(in-package :cl+ssl) + +(defconstant +initial-buffer-size+ 2048) + +(declaim + (inline + make-buffer + buffer-length + buffer-elt + set-buffer-elt + v/b-replace + b/v-replace)) diff --git a/ffi-buffer-clisp.lisp b/ffi-buffer-clisp.lisp new file mode 100644 index 0000000..b715c3b --- /dev/null +++ b/ffi-buffer-clisp.lisp @@ -0,0 +1,29 @@ +(in-package :cl+ssl) + +(defun make-buffer (size) + (cffi-sys:%foreign-alloc size)) + +(defun buffer-length (buf) + (declare (ignore buf)) + +initial-buffer-size+) + +(defun buffer-elt (buf index) + (ffi:memory-as buf 'ffi:uint8 index)) +(defun set-buffer-elt (buf index val) + (setf (ffi:memory-as buf 'ffi:uint8 index) val)) +(defsetf buffer-elt set-buffer-elt) + +(defun v/b-replace (vec buf &key (start1 0) end1 (start2 0) (end2 +initial-buffer-size+)) + (replace + vec + (ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end2 start2))) start2) + :start1 start1 + :end1 end1)) +(defun b/v-replace (buf vec &key (start1 0) (end1 +initial-buffer-size+) (start2 0) end2) + (setf + (ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end1 start1))) start1) + (subseq vec start2 end2))) + +(defmacro with-pointer-to-vector-data ((ptr buf) &body body) + `(let ((,ptr ,buf)) + ,@body)) diff --git a/ffi-buffer.lisp b/ffi-buffer.lisp new file mode 100644 index 0000000..b023e59 --- /dev/null +++ b/ffi-buffer.lisp @@ -0,0 +1,22 @@ +(in-package :cl+ssl) + +(defun make-buffer (size) + (cffi-sys::make-shareable-byte-vector size)) + +(defun buffer-length (buf) + (length buf)) + +(defun buffer-elt (buf index) + (elt buf index)) +(defun set-buffer-elt (buf index val) + (setf (elt buf index) val)) +(defsetf buffer-elt set-buffer-elt) + +(defun v/b-replace (vec buf &key (start1 0) end1 (start2 0) end2) + (replace vec buf :start1 start1 :end1 end1 :start2 start2 :end2 end2)) +(defun b/v-replace (buf vec &key (start1 0) end1 (start2 0) end2) + (replace buf vec :start1 start1 :end1 end1 :start2 start2 :end2 end2)) + +(defmacro with-pointer-to-vector-data ((ptr buf) &body body) + `(cffi-sys::with-pointer-to-vector-data (,ptr ,buf) + ,@body)) diff --git a/index.html b/index.html index 230d506..2b26e43 100644 --- a/index.html +++ b/index.html @@ -16,6 +16,12 @@

News

+

+ 2007-07-07: Improved clisp support, thanks + to Pixel + // pinterface. +

2007-01-16: CL+SSL is now available under an MIT-style license.

diff --git a/streams.lisp b/streams.lisp index f000ec8..ec0cabe 100644 --- a/streams.lisp +++ b/streams.lisp @@ -1,5 +1,6 @@ ;;; Copyright (C) 2001, 2003 Eric Marsden ;;; Copyright (C) 2005 David Lichteblau +;;; Copyright (C) 2007 Pixel // pinterface ;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt." ;;; ;;; See LICENSE for details. @@ -9,8 +10,6 @@ (in-package :cl+ssl) -(defconstant +initial-buffer-size+ 2048) - (defclass ssl-stream (fundamental-binary-input-stream fundamental-binary-output-stream @@ -22,13 +21,13 @@ :initform nil :accessor ssl-stream-handle) (output-buffer - :initform (cffi-sys::make-shareable-byte-vector +initial-buffer-size+) + :initform (make-buffer +initial-buffer-size+) :accessor ssl-stream-output-buffer) (output-pointer :initform 0 :accessor ssl-stream-output-pointer) (input-buffer - :initform (cffi-sys::make-shareable-byte-vector +initial-buffer-size+) + :initform (make-buffer +initial-buffer-size+) :accessor ssl-stream-input-buffer) (peeked-byte :initform nil @@ -70,7 +69,7 @@ (or (ssl-stream-peeked-byte stream) (let ((buf (ssl-stream-input-buffer stream))) (handler-case - (cffi-sys::with-pointer-to-vector-data (ptr buf) + (with-pointer-to-vector-data (ptr buf) (ensure-ssl-funcall (ssl-stream-socket stream) (ssl-stream-handle stream) #'ssl-read @@ -78,7 +77,7 @@ (ssl-stream-handle stream) ptr 1) - (elt buf 0)) + (buffer-elt buf 0)) (ssl-error-zero-return () ;SSL_read returns 0 on end-of-file :eof))))) @@ -90,11 +89,11 @@ (incf start)) (let ((buf (ssl-stream-input-buffer stream))) (loop - for length = (min (- end start) (length buf)) + for length = (min (- end start) (buffer-length buf)) while (plusp length) do (handler-case - (cffi-sys::with-pointer-to-vector-data (ptr buf) + (with-pointer-to-vector-data (ptr buf) (ensure-ssl-funcall (ssl-stream-socket stream) (ssl-stream-handle stream) #'ssl-read @@ -102,7 +101,7 @@ (ssl-stream-handle stream) ptr length) - (replace thing buf :start1 start :end1 (+ start length)) + (v/b-replace thing buf :start1 start :end1 (+ start length)) (incf start length)) (ssl-error-zero-return () ;SSL_read returns 0 on end-of-file (return)))) @@ -110,28 +109,28 @@ (defmethod stream-write-byte ((stream ssl-stream) b) (let ((buf (ssl-stream-output-buffer stream))) - (when (eql (length buf) (ssl-stream-output-pointer stream)) + (when (eql (buffer-length buf) (ssl-stream-output-pointer stream)) (force-output stream)) - (setf (elt buf (ssl-stream-output-pointer stream)) b) + (setf (buffer-elt buf (ssl-stream-output-pointer stream)) b) (incf (ssl-stream-output-pointer stream))) b) (defmethod stream-write-sequence ((stream ssl-stream) thing start end &key) (check-type thing (simple-array (unsigned-byte 8) (*))) (let ((buf (ssl-stream-output-buffer stream))) - (when (> (+ (- end start) (ssl-stream-output-pointer stream)) (length buf)) + (when (> (+ (- end start) (ssl-stream-output-pointer stream)) (buffer-length buf)) ;; not enough space left? flush buffer. (force-output stream) ;; still doesn't fit? - (while (> (- end start) (length buf)) - (replace buf thing :start2 start) - (incf start (length buf)) - (setf (ssl-stream-output-pointer stream) (length buf)) + (while (> (- end start) (buffer-length buf)) + (b/v-replace buf thing :start2 start) + (incf start (buffer-length buf)) + (setf (ssl-stream-output-pointer stream) (buffer-length buf)) (force-output stream))) - (replace buf thing - :start1 (ssl-stream-output-pointer stream) - :start2 start - :end2 end) + (b/v-replace buf thing + :start1 (ssl-stream-output-pointer stream) + :start2 start + :end2 end) (incf (ssl-stream-output-pointer stream) (- end start))) thing) @@ -144,7 +143,7 @@ (handle (ssl-stream-handle stream)) (socket (ssl-stream-socket stream))) (when (plusp fill-ptr) - (cffi-sys::with-pointer-to-vector-data (ptr buf) + (with-pointer-to-vector-data (ptr buf) (ensure-ssl-funcall socket handle #'ssl-write 0.5 handle ptr fill-ptr)) (setf (ssl-stream-output-pointer stream) 0))))