[cl-plus-ssl-cvs] CVS cl+ssl
dlichteblau
dlichteblau at common-lisp.net
Sat Jul 7 15:25:09 UTC 2007
Update of /project/cl-plus-ssl/cvsroot/cl+ssl
In directory clnet:/tmp/cvs-serv3482
Modified Files:
LICENSE cl+ssl.asd index.html streams.lisp
Added Files:
ffi-buffer-all.lisp ffi-buffer-clisp.lisp ffi-buffer.lisp
Log Message:
clisp patch by Pixel // pinterface
--- /project/cl-plus-ssl/cvsroot/cl+ssl/LICENSE 2007/01/16 19:49:03 1.3
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/LICENSE 2007/07/07 15:25:09 1.4
@@ -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.
--- /project/cl-plus-ssl/cvsroot/cl+ssl/cl+ssl.asd 2006/11/18 09:52:21 1.4
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/cl+ssl.asd 2007/07/07 15:25:09 1.5
@@ -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")))
--- /project/cl-plus-ssl/cvsroot/cl+ssl/index.html 2007/01/16 19:49:03 1.8
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/index.html 2007/07/07 15:25:09 1.9
@@ -17,6 +17,12 @@
<h3>News</h3>
<p>
+ 2007-07-07: Improved clisp support, thanks
+ to <a
+ href="http://web.kepibu.org/code/lisp/cl+ssl/#faster-clisp">Pixel
+ // pinterface</a>.
+ </p>
+ <p>
2007-01-16: CL+SSL is now available under an MIT-style license.
</p>
--- /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp 2006/11/18 09:52:21 1.5
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp 2007/07/07 15:25:09 1.6
@@ -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))))
--- /project/cl-plus-ssl/cvsroot/cl+ssl/ffi-buffer-all.lisp 2007/07/07 15:25:09 NONE
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/ffi-buffer-all.lisp 2007/07/07 15:25:09 1.1
(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))
--- /project/cl-plus-ssl/cvsroot/cl+ssl/ffi-buffer-clisp.lisp 2007/07/07 15:25:09 NONE
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/ffi-buffer-clisp.lisp 2007/07/07 15:25:09 1.1
(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))
, at body))
--- /project/cl-plus-ssl/cvsroot/cl+ssl/ffi-buffer.lisp 2007/07/07 15:25:09 NONE
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/ffi-buffer.lisp 2007/07/07 15:25:09 1.1
(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)
, at body))
More information about the cl-plus-ssl-cvs
mailing list