SNI support for OpenSSL egg added by murphy_tcc on Sun Aug 20 18:59:53 2017

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