Index: openssl.scm
===================================================================
--- openssl.scm	(revision 18697)
+++ openssl.scm	(working copy)
@@ -8,6 +8,8 @@
    ssl-client-context?
    ssl-listen
    ssl-close
+   ssl-port?
+   ssl-addresses
    ssl-listener?
    ssl-listener?
    ssl-listener-port
@@ -271,7 +273,28 @@
     ssl buffer offset size)
    #t))
 
-(define (ssl-make-i/o-ports ctx fd ssl)
+(define (ssl-port? obj)
+  (and (port? obj) (eq? (##sys#slot obj 10) 'ssl-socket)))
+
+(define (ensure-ssl-port obj loc)
+  (or (ssl-port? obj)
+      (abort
+       (make-property-condition
+        'exn
+        'location loc
+        'message "expected an ssl port, got"
+        'arguments (list obj))
+       (make-property-condition
+        'type))))
+
+(define (ssl-port->tcp-fd p loc)
+  (ensure-ssl-port p loc)
+  (##sys#slot p 11))
+
+(define (ssl-addresses p)
+  (tcp-addresses (ssl-port->tcp-fd p 'ssl-addresses)))
+
+(define (ssl-make-i/o-ports ctx fd ssl tcp-in tcp-out)
   ;; note that the ctx parameter is never used but it is passed in order
   ;; to be present in the closure data of the various port functions
   ;; so it isn't garbage collected before the ports are all gone
@@ -381,10 +404,10 @@
 	      (shutdown)))))
       (##sys#setslot in 3 "(ssl)")
       (##sys#setslot out 3 "(ssl)")
-      (##sys#setslot in 7 'socket)
-      (##sys#setslot out 7 'socket)
-      (##sys#setslot (##sys#port-data in) 0 fd)
-      (##sys#setslot (##sys#port-data out) 0 fd)
+      (##sys#setslot in 10 'ssl-socket)  ; first "reserved" slot
+      (##sys#setslot out 10 'ssl-socket) ; Slot 7 should probably stay 'custom
+      (##sys#setslot in 11 tcp-in)       ; second "reserved" slot
+      (##sys#setslot out 11 tcp-out)
       (values in out))))
 
 (define (ssl-unwrap-context obj)
@@ -416,36 +439,36 @@
 
 ;; connect to SSL server
 (define (ssl-connect hostname #!optional port (ctx 'sslv2-or-v3))
-  (let* ((fd
-	  (call-with-values (cut tcp-connect hostname port)
-	    net-unwrap-tcp-ports))
-	 (ctx
-	  (if (ssl-client-context? ctx)
-	      (ssl-unwrap-client-context ctx)
-	      (ssl-ctx-new ctx #f)))
-	 (ssl
-	  (ssl-new ctx)))
-    (let ((success? #f))
-      (dynamic-wind
-	  void
-	  (lambda ()
-	    (ssl-set-fd! ssl fd)
-	    (let loop ()
-	      (case (ssl-connect-ssl ssl)
-		((want-read)
-		 (##sys#thread-block-for-i/o! ##sys#current-thread fd #t)
-		 (thread-yield!)
-		 (loop))
-		((want-write)
-		 (##sys#thread-block-for-i/o! ##sys#current-thread fd #f)
-		 (thread-yield!)
-		 (loop))))
-	    (set! success? #t))
-	  (lambda ()
-	    (unless success?
-	      (ssl-free ssl)
-	      (net-close-socket fd)))))
-    (ssl-make-i/o-ports ctx fd ssl)))
+  (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)))
+      (let ((success? #f))
+        (dynamic-wind
+            void
+            (lambda ()
+              (ssl-set-fd! ssl fd)
+              (let loop ()
+                (case (ssl-connect-ssl ssl)
+                  ((want-read)
+                   (##sys#thread-block-for-i/o! ##sys#current-thread fd #t)
+                   (thread-yield!)
+                   (loop))
+                  ((want-write)
+                   (##sys#thread-block-for-i/o! ##sys#current-thread fd #f)
+                   (thread-yield!)
+                   (loop))))
+              (set! success? #t))
+            (lambda ()
+              (unless success?
+                (ssl-free ssl)
+                (net-close-socket fd)))))
+      (ssl-make-i/o-ports ctx fd ssl tcp-in tcp-out))))
 
 ;; create listener/SSL server context
 (define-record-type ssl-listener
@@ -479,32 +502,32 @@
 
 ;; accept a connection from an SSL listener
 (define (ssl-accept listener)
-  (let* ((fd
-	  (call-with-values (cut tcp-accept (ssl-unwrap-listener listener))
-	    net-unwrap-tcp-ports))
-	 (ssl
-	  (ssl-new (ssl-unwrap-listener-context listener))))
-    (let ((success? #f))
-      (dynamic-wind
-	  void
-	  (lambda ()
-	    (ssl-set-fd! ssl fd)
-	    (let loop ()
-	      (case (ssl-accept-ssl ssl)
-		((want-read)
-		 (##sys#thread-block-for-i/o! ##sys#current-thread fd #t)
-		 (thread-yield!)
-		 (loop))
-		((want-write)
-		 (##sys#thread-block-for-i/o! ##sys#current-thread fd #f)
-		 (thread-yield!)
-		 (loop))))
-	    (set! success? #t))
-	  (lambda ()
-	    (unless success?
-	      (ssl-free ssl)
-	      (net-close-socket fd)))))
-    (ssl-make-i/o-ports (ssl-unwrap-listener-context listener) fd ssl)))
+  (receive (tcp-in tcp-out)
+    (tcp-accept (ssl-unwrap-listener listener))
+   (let* ((fd (net-unwrap-tcp-ports tcp-in tcp-out))
+          (ctx (ssl-unwrap-listener-context listener))
+          (ssl (ssl-new ctx)))
+     (let ((success? #f))
+       (dynamic-wind
+           void
+           (lambda ()
+             (ssl-set-fd! ssl fd)
+             (let loop ()
+               (case (ssl-accept-ssl ssl)
+                 ((want-read)
+                  (##sys#thread-block-for-i/o! ##sys#current-thread fd #t)
+                  (thread-yield!)
+                  (loop))
+                 ((want-write)
+                  (##sys#thread-block-for-i/o! ##sys#current-thread fd #f)
+                  (thread-yield!)
+                  (loop))))
+             (set! success? #t))
+           (lambda ()
+             (unless success?
+               (ssl-free ssl)
+               (net-close-socket fd)))))
+     (ssl-make-i/o-ports ctx fd ssl tcp-in tcp-out))))
 
 ;; load identifying certificate chain into SSL context
 (define (ssl-load-certificate-chain! obj pathname)