diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 45f08a1247..c8063b8820 100755 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -65,10 +65,6 @@ M: unix handle-length ( handle -- n/f ) fd>> \ stat [ fstat -1 = not ] keep swap [ st_size>> ] [ drop f ] if ; -SYMBOL: +retry+ ! just try the operation again without blocking -SYMBOL: +input+ -SYMBOL: +output+ - ERROR: io-timeout ; M: io-timeout summary drop "I/O operation timed out" ; @@ -87,10 +83,6 @@ M: io-timeout summary drop "I/O operation timed out" ; ! Some general stuff CONSTANT: file-mode 0o0666 - -! Returns an event to wait for which will ensure completion of -! this request -GENERIC: refill ( port handle -- event/f ) M: fd refill fd>> over buffer>> [ buffer-end ] [ buffer-capacity ] bi read @@ -110,8 +102,6 @@ M: unix (wait-to-read) ( port -- ) [ dupd wait-for-port (wait-to-read) ] [ 2drop ] if ; ! Writers -GENERIC: drain ( port handle -- event/f ) - M: fd drain fd>> over buffer>> [ buffer@ ] [ buffer-length ] bi write { diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index 7f222b732c..bf805d0a22 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -170,8 +170,6 @@ M: windows handle-length ( handle -- n/f ) [ buffer>> dup buffer-length 0 DWORD ] dip make-overlapped ] 2bi ; -GENERIC: drain ( port handle -- ) - : setup-write ( -- hFile lpBuffer nNumberOfBytesToWrite lpNumberOfBytesWritten lpOverlapped ) { [ hFile>> ] @@ -183,11 +181,9 @@ GENERIC: drain ( port handle -- ) : finish-write ( n port -- ) [ update-file-ptr ] [ buffer>> buffer-consume ] 2bi ; -M: object drain ( port handle -- ) +M: object drain ( port handle -- event/f ) [ make-FileArgs dup setup-write WriteFile ] - [ drop [ wait-for-file ] [ finish-write ] bi ] 2bi ; - -GENERIC: refill ( port handle -- ) + [ drop [ wait-for-file ] [ finish-write ] bi ] 2bi f ; : setup-read ( -- hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRead lpOverlapped ) { @@ -200,15 +196,15 @@ GENERIC: refill ( port handle -- ) : finish-read ( n port -- ) [ update-file-ptr ] [ buffer>> n>buffer ] 2bi ; -M: object refill ( port handle -- ) +M: object refill ( port handle -- event/f ) [ make-FileArgs dup setup-read ReadFile ] - [ drop [ wait-for-file ] [ finish-read ] bi ] 2bi ; + [ drop [ wait-for-file ] [ finish-read ] bi ] 2bi f ; -M: windows (wait-to-write) - [ dup handle>> drain ] with-destructors ; +M: windows (wait-to-write) ( port -- ) + [ dup handle>> drain ] with-destructors drop ; M: windows (wait-to-read) ( port -- ) - [ dup handle>> refill ] with-destructors ; + [ dup handle>> refill ] with-destructors drop ; : console-app? ( -- ? ) GetConsoleWindow >boolean ; diff --git a/basis/io/sockets/secure/windows/windows.factor b/basis/io/sockets/secure/windows/windows.factor index 7d98fd114f..c252e14211 100644 --- a/basis/io/sockets/secure/windows/windows.factor +++ b/basis/io/sockets/secure/windows/windows.factor @@ -3,11 +3,14 @@ USING: alien alien.c-types alien.data combinators fry - io io.sockets.private io.sockets.secure io.sockets.secure.openssl io.sockets.windows + io.buffers + io.files + io.ports + io.sockets.private io.sockets.secure io.sockets.secure.openssl io.timeouts kernel - openssl openssl.libcrypto openssl.libssl - windows.winsock ; + namespaces + openssl openssl.libcrypto openssl.libssl ; IN: io.sockets.secure.windows ! Most of this vocab is duplicated code from io.sockets.secure.unix so @@ -15,6 +18,57 @@ IN: io.sockets.secure.windows M: openssl ssl-supported? t ; M: openssl ssl-certificate-verification-supported? f ; +: check-response ( port r -- port r n ) + over handle>> handle>> over SSL_get_error ; inline + +: check-read-response ( port r -- event ) + check-response + { + { SSL_ERROR_NONE [ swap buffer>> n>buffer f ] } + { SSL_ERROR_ZERO_RETURN [ 2drop f ] } + { SSL_ERROR_WANT_READ [ 2drop "input" ] } + { SSL_ERROR_WANT_WRITE [ 2drop "output" ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ; + +: maybe-handshake ( ssl-handle -- ) + dup connected>> [ drop ] [ + t >>connected + [ do-ssl-accept ] with-timeout + ] if ; + +M: ssl-handle refill + dup maybe-handshake + handle>> ! ssl + over buffer>> + [ buffer-end ] ! buf + [ buffer-capacity ] bi ! len + SSL_read + check-read-response ; + +: check-write-response ( port r -- event ) + check-response + { + { SSL_ERROR_NONE [ swap buffer>> buffer-consume f ] } + { SSL_ERROR_WANT_READ [ 2drop "input!" ] } + { SSL_ERROR_WANT_WRITE [ 2drop "output!" ] } + { SSL_ERROR_SYSCALL [ syscall-error ] } + { SSL_ERROR_SSL [ (ssl-error) ] } + } case ; + +M: ssl-handle drain + dup maybe-handshake + handle>> ! ssl + over buffer>> + [ buffer@ ] ! buf + [ buffer-length ] bi ! len + SSL_write + check-write-response ; + +M: ssl-handle timeout + drop secure-socket-timeout get ; + : ( winsock -- ssl ) [ handle>> alien-address BIO_NOCLOSE BIO_new_socket ] keep [ handle>> swap dup SSL_set_bio ] keep ; @@ -23,15 +77,9 @@ M: secure ((client)) ( addrspec -- handle ) addrspec>> ((client)) ; M: secure (get-local-address) ( handle remote -- sockaddr ) - [ file>> handle>> ] [ addrspec>> empty-sockaddr/size int ] bi* - [ getsockname socket-error ] 2keep drop ; + [ file>> ] [ addrspec>> ] bi* (get-local-address) ; -: establish-ssl-connection ( client-out remote -- ) - make-sockaddr/size - swap >>port - dup port>> handle>> file>> handle>> >>s dup - s>> get-ConnectEx-ptr >>ptr dup - call-ConnectEx wait-for-socket drop ; +M: secure parse-sockaddr addrspec>> parse-sockaddr ; ! The error codes needs to be handled properly. : check-connect-response ( ssl-handle r -- event ) @@ -77,4 +125,7 @@ M: secure (get-local-address) ( handle remote -- sockaddr ) ] [ drop t >>connected drop ] 2bi ; M: secure establish-connection ( client-out remote -- ) - addrspec>> [ establish-ssl-connection ] [ secure-connection ] 2bi ; + [ + [ handle>> file>> ] [ addrspec>> ] bi* establish-connection + ] + [ secure-connection ] 2bi ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index a5e005745a..6d01c3427f 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -5,6 +5,15 @@ io.encodings.utf8 io.files.private io.pathnames kernel kernel.private namespaces sequences splitting system ; IN: io.files +SYMBOL: +retry+ ! just try the operation again without blocking +SYMBOL: +input+ +SYMBOL: +output+ + +! Returns an event to wait for which will ensure completion of +! this request +GENERIC: drain ( port handle -- event/f ) +GENERIC: refill ( port handle -- event/f ) + MIXIN: file-reader MIXIN: file-writer