Index: openssl.scm =================================================================== --- openssl.scm (revision 33673) +++ openssl.scm (working copy) @@ -244,6 +244,15 @@ #f))))) (apply ssl-abort loc sym args))))) +(define (ssl-set-tlsext-hostname! ssl hostname) + (ssl-clear-error) + (ssl-result-or-abort + 'ssl-set-tlsext-hostname! ssl + ((foreign-lambda int "SSL_set_tlsext_host_name" c-pointer c-string) + ssl hostname) #f + hostname) + (void)) + (define (ssl-set-fd! ssl fd) (ssl-clear-error) (ssl-result-or-abort @@ -554,17 +563,27 @@ ;; connect to SSL server (define (ssl-connect hostname #!optional port (ctx 'sslv2-or-v3)) - (receive (tcp-in tcp-out) - (tcp-connect hostname port) - (let* ((fd (net-unwrap-tcp-ports tcp-in tcp-out)) - (ctx - (if (ssl-client-context? ctx) - (ssl-unwrap-client-context ctx) - (ssl-ctx-new ctx #f))) - (ssl - (ssl-new ctx))) - (ssl-set-connect-state! ssl) - (ssl-make-i/o-ports ctx fd ssl tcp-in tcp-out)))) + (let* ((ctx + (if (ssl-client-context? ctx) + (ssl-unwrap-client-context ctx) + (ssl-ctx-new ctx #f))) + (ssl (ssl-new ctx)) + (success? #f)) + (dynamic-wind + void + (lambda () + (ssl-set-tlsext-hostname! ssl hostname) + (ssl-set-connect-state! ssl) + (receive (tcp-in tcp-out) + (tcp-connect hostname port) + (receive (ssl-in ssl-out) + (ssl-make-i/o-ports ctx (net-unwrap-tcp-ports tcp-in tcp-out) ssl tcp-in tcp-out) + (set! success? #t) + (values ssl-in ssl-out)))) + (lambda () + (unless success? + (ssl-free ssl) + (set! ssl #f)))))) ;; create listener/SSL server context (define-record-type ssl-listener