suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remove cancel box, no longer needed with ffi/unsafe/alloc

Browse Source 
Also, found the source of mem corruption: the finalizer's cancel box
(from create-ssl) was shadowed by a new box put in mzssl struct.
This commit is contained in:
Ryan Culpepper 2012-11-21 10:53:24 -05:00
parent 44177ca406
commit 07c6e89899
1 changed files with 5 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/openssl/mzssl.rkt
View File

@ -327,7 +327,6 @@
flushing? must-write must-read flushing? must-write must-read
refcount refcount
close-original? shutdown-on-close? close-original? shutdown-on-close?
finalizer-cancel
error) error)
#:mutable) #:mutable)
@ -645,9 +644,7 @@
;; Lock must be held ;; Lock must be held
(set-mzssl-refcount! mzssl (sub1 (mzssl-refcount mzssl))) (set-mzssl-refcount! mzssl (sub1 (mzssl-refcount mzssl)))
(when (zero? (mzssl-refcount mzssl)) (when (zero? (mzssl-refcount mzssl))
(atomically (SSL_free (mzssl-ssl mzssl))
(set-box! (mzssl-finalizer-cancel mzssl) #f)
(SSL_free (mzssl-ssl mzssl)))
(when (mzssl-close-original? mzssl) (when (mzssl-close-original? mzssl)
(close-input-port (mzssl-i mzssl)) (close-input-port (mzssl-i mzssl))
(close-output-port (mzssl-o mzssl))))) (close-output-port (mzssl-o mzssl)))))
@ -1094,8 +1091,7 @@
(lambda () (when free-bio? (lambda () (when free-bio?
(BIO_free r-bio) (BIO_free r-bio)
(BIO_free w-bio))) (BIO_free w-bio)))
(let ([ssl (SSL_new ctx)] (let ([ssl (SSL_new ctx)])
[cancel (box #t)])
(check-valid ssl who "ssl setup") (check-valid ssl who "ssl setup")
;; ssl has a ref count on ctx, so release: ;; ssl has a ref count on ctx, so release:
(when (symbol? context-or-encrypt-method) (when (symbol? context-or-encrypt-method)
@ -1106,8 +1102,7 @@
(SSL_set_bio ssl r-bio w-bio) (SSL_set_bio ssl r-bio w-bio)
;; ssl has r-bio & w-bio (no ref count?), so drop it: ;; ssl has r-bio & w-bio (no ref count?), so drop it:
(set! free-bio? #f) (set! free-bio? #f)
;; Return SSL and the cancel box: (values ssl r-bio w-bio connect?)))))))))
(values ssl cancel r-bio w-bio connect?)))))))))
(define (wrap-ports who i o context-or-encrypt-method connect/accept (define (wrap-ports who i o context-or-encrypt-method connect/accept
close? shutdown-on-close? error/ssl close? shutdown-on-close? error/ssl
@ -1119,7 +1114,7 @@
(unless (or (string? hostname) (eq? hostname #f)) (unless (or (string? hostname) (eq? hostname #f))
(raise-argument-error who "(or/c string? #f)" hostname)) (raise-argument-error who "(or/c string? #f)" hostname))
;; Create the SSL connection: ;; Create the SSL connection:
(let-values ([(ssl cancel r-bio w-bio connect?) (let-values ([(ssl r-bio w-bio connect?)
(create-ssl who context-or-encrypt-method connect/accept error/ssl)] (create-ssl who context-or-encrypt-method connect/accept error/ssl)]
[(verify-hostname?) [(verify-hostname?)
(cond [(ssl-context? context-or-encrypt-method) (cond [(ssl-context? context-or-encrypt-method)
@ -1127,14 +1122,12 @@
[else #f])]) [else #f])])
;; connect/accept: ;; connect/accept:
(let-values ([(buffer) (make-bytes BUFFER-SIZE)] (let-values ([(buffer) (make-bytes BUFFER-SIZE)]
[(pipe-r pipe-w) (make-pipe)] [(pipe-r pipe-w) (make-pipe)])
[(cancel) (box #t)])
(let ([mzssl (make-mzssl ssl i o r-bio w-bio pipe-r pipe-w (let ([mzssl (make-mzssl ssl i o r-bio w-bio pipe-r pipe-w
buffer (make-semaphore 1) buffer (make-semaphore 1)
#f #f #f #f
#f #f #f 2 #f #f #f 2
close? shutdown-on-close? close? shutdown-on-close?
cancel
error/ssl)]) error/ssl)])
(let loop () (let loop ()
(let-values ([(status err estr) (save-errors (if connect? (let-values ([(status err estr) (save-errors (if connect?