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
@@ -553,18 +562,29 @@
 (define ssl-set-connect-state! (foreign-lambda void "SSL_set_connect_state" c-pointer))
 
 ;; 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))))
+(define (ssl-connect hostname #!optional port (ctx 'sslv2-or-v3) (sni-name hostname))
+  (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 ()
+        (when sni-name
+          (ssl-set-tlsext-hostname! ssl sni-name))
+        (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
@@ -779,8 +799,8 @@
     (ssl-set-verify! ctx verify?)
     ctx))
 
-(define (ssl-connect* #!rest args #!key hostname port)
-  (ssl-connect hostname port (apply ssl-make-client-context* args)))
+(define (ssl-connect* #!rest args #!key hostname port (sni-name hostname))
+  (ssl-connect hostname port (apply ssl-make-client-context* args) sni-name))
 
 (define (ssl-listen* #!key hostname (port 0) (backlog 4) (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? #f))
   (unless (or certificate-authorities certificate-authority-directory)
@@ -795,7 +815,7 @@
     (ssl-set-verify! ear verify?)
     ear))
 
-(define (ssl-start* server? tcp-in tcp-out #!key (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? (not server?)))
+(define (ssl-start* server? tcp-in tcp-out #!key (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? (not server?)) sni-name)
   (unless (or certificate-authorities certificate-authority-directory)
     (set! certificate-authority-directory (ssl-default-certificate-authority-directory)))
   ;; ssl-wrap-client-context only serves a technical purpose here,
@@ -813,7 +833,10 @@
            (ssl (ssl-new (ssl-unwrap-client-context ctx))))
       (if server?
         (ssl-set-accept-state! ssl)
-        (ssl-set-connect-state! ssl))
+        (begin
+          (when sni-name
+            (ssl-set-tlsext-hostname! ssl sni-name))
+          (ssl-set-connect-state! ssl)))
       (ssl-make-i/o-ports ctx fd ssl tcp-in tcp-out))))
 
 )