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

[Daniel Brunner]

I hope that I applied the patch properly. But the problem still exists
on SBCL 1.0.46 on Linux8664.

Kind regards, Daniel.

Am 01.04.2011 16:30, schrieb 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
> 
> _______________________________________________
> tbnl-devel site list
> tbnl-devel at common-lisp.net
> http://common-lisp.net/mailman/listinfo/tbnl-devel
>