[Guile-commits] 10/10: Non-blocking accept/connect Scheme support

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 6788faba7a36bf767fda0376025f5847222ef761
Author: Andy Wingo <address@hidden>
Date:   Thu Jun 2 23:02:21 2016 +0200

    Non-blocking accept/connect Scheme support
    
    * module/ice-9/sports.scm (accept, connect): New Scheme functions.
---
 module/ice-9/suspendable-ports.scm |   23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/suspendable-ports.scm 
b/module/ice-9/suspendable-ports.scm
index 6d3d405..bc84a4a 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -671,10 +671,31 @@
     (when (and (eqv? char #\newline) (port-line-buffered? port))
       (flush-output port))))
 
+(define accept
+  (let ((%accept (@ (guile) accept)))
+    (lambda (port)
+      (let lp ()
+        (or (%accept port)
+            (begin
+              (wait-for-readable port)
+              (lp)))))))
+
+(define connect
+  (let ((%connect (@ (guile) connect)))
+    (lambda (port sockaddr . args)
+      (unless (apply %connect port sockaddr args)
+        ;; Clownshoes semantics; see connect(2).
+        (wait-for-writable port)
+        (let ((err (getsockopt port SOL_SOCKET SO_ERROR)))
+          (unless (zero? err)
+            (scm-error 'system-error "connect" "~A"
+                       (list (strerror err)) #f)))))))
+
 (define saved-port-bindings #f)
 (define port-bindings
   '(((guile)
-     read-char peek-char force-output close-port)
+     read-char peek-char force-output close-port
+     accept connect)
     ((ice-9 binary-ports)
      get-u8 lookahead-u8 get-bytevector-n
      put-u8 put-bytevector)