tomek
/
cl-plus-ssl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

clisp patch by Pixel // pinterface

master
dlichteblau 2007-07-07 15:25:09 +00:00
parent 9dacb12767
commit 78eea24562
7 changed files with 94 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
LICENSE
View File

@ -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.

4
cl+ssl.asd
View File

@ -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")))

12
ffi-buffer-all.lisp Normal file
View File

@ -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))

29
ffi-buffer-clisp.lisp Normal file
View File

@ -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))

22
ffi-buffer.lisp Normal file
View File

@ -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))

6
index.html
View File

@ -16,6 +16,12 @@
</ul>
<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>

41
streams.lisp
View File

@ -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))))