diff --git a/scsh/network.scm b/scsh/network.scm index de2b931..25e30e0 100644 --- a/scsh/network.scm +++ b/scsh/network.scm @@ -55,9 +55,10 @@ (dynamic-wind (lambda () #f) (lambda () (connect-socket sock addr) (set! connected #t)) - (lambda () - (if (not connected) - (close-socket sock)))) + (lambda () #f + ;(if (not connected) + ; (close-socket sock)) + )) (if connected sock #f)))) @@ -228,14 +229,25 @@ (else (let loop () ((structure-ref interrupts disable-interrupts!)) - (if (%connect (socket->fdes sock) - (socket:family sock) - (socket-address:address name)) - ((structure-ref interrupts enable-interrupts!)) - (begin (wait-for-channel - (fdport-data:channel - (fdport-data (socket:inport sock)))) - (loop)))))))))) + (let ((res (%connect (socket->fdes sock) + (socket:family sock) + (socket-address:address name)))) + (cond ((eq? res #t) + ((structure-ref interrupts enable-interrupts!))) + (else (wait-for-channel + (fdport-data:channel + (fdport-data (socket:inport sock)))) + (if (eq? res 0) + (handle-EINPROGRESS sock) + (loop)))))))))))) + +;;; If connect returned EINPROGRESS, we can check it's success after +;;; the next success with getsockopt + +(define (handle-EINPROGRESS sock) + (let ((val (socket-option sock level/socket socket/error))) + (if (not (zero? val)) + (errno-error val "scheme_connnect")))) (define-stubless-foreign %connect (sockfd family name) "scheme_connect") diff --git a/scsh/network1.c b/scsh/network1.c index 3b1051d..4fa0d81 100644 --- a/scsh/network1.c +++ b/scsh/network1.c @@ -115,11 +115,13 @@ s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name if (errno != EWOULDBLOCK && errno != EINTR && errno != EALREADY && errno != EINPROGRESS && errno != EAGAIN) s48_raise_os_error(errno); - + if (! (s48_add_pending_fd(sockfd, 0))) s48_raise_out_of_memory_error(); - return S48_FALSE; + if (errno == EINPROGRESS) + return s48_enter_fixnum (0); + else return S48_FALSE; } default: