[hunchentoot-devel] Fwd: (forw) Re: [cl-plus-ssl-devel] ssl crashing in hunchentoot. A solution?

[Hans Hübner]

Here is another patch from David, can someone please test on SBCL multithreaded?

Thanks!
Hans


---------- Forwarded message ----------
From: David Lichteblau <david at lichteblau.com>
Date: Fri, Apr 1, 2011 at 4:28 PM
Subject: Re: (forw) Re: [cl-plus-ssl-devel] ssl crashing in
hunchentoot. A solution?
To: Hans H?bner <hans at huebner.org>


Quoting Hans H?bner (hans at huebner.org):
> Zugegeben, ich habe nur CCL getestet, für SBCL hilft es wohl nicht :/

Ein letzter blinder Versuch (alternativ muesste ich doch selbst testen):

>From 207a12ea7053643ef53683907e6d894d8ecb5ecd Mon Sep 17 00:00:00 2001
From: David Lichteblau <david at lichteblau.com>
Date: Fri, 1 Apr 2011 16:26:19 +0200
Subject: [PATCH 2/2] Fix thread id computation

---
 ffi.lisp |   11 +++++++----
 1 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/ffi.lisp b/ffi.lisp
index d773bef..3049c7f 100644
--- a/ffi.lisp
+++ b/ffi.lisp
@@ -392,11 +392,17 @@ will use this value.")
       (bt:release-recursive-lock lock))))

 (defvar *threads* (trivial-garbage:make-weak-hash-table :weakness :key))
+(defvar *thread-counter* 0)
+(defparameter *initialization-lock*
+    (bordeaux-threads:make-recursive-lock "SSL initialization"))

 (cffi:defcallback threadid-callback :unsigned-long ()
  (let ((self (bt:current-thread)))
    (or (gethash self *threads*)
-       (setf (gethash self *threads*) (hash-table-count *threads*)))))
+       (setf (gethash self *threads*)
+             (bordeaux-threads:with-recursive-lock-held
+                 (*initialization-lock*)
+               (incf *thread-counter*))))))

 (defun initialize (&key (method 'ssl-v23-method) rand-seed)
  (setf *locks* (loop
@@ -415,9 +421,6 @@ will use this value.")
  (ssl-ctx-set-default-passwd-cb *ssl-global-context*
                                 (cffi:callback pem-password-callback)))

-(defparameter *initialization-lock*
-    (bordeaux-threads:make-recursive-lock "SSL initialization"))
-
 (defun ensure-initialized (&key (method 'ssl-v23-method) (rand-seed nil))
  "In most cases you do *not* need to call this function, because it
 is called automatically by all other functions. The only reason to
--
1.7.0