io.sockets.secure.windows: reading and writing from ssl sockets

Unified the drain and refill generics and put their definition in
io.files. They are now used by both the windows and unix ssl backend
for io. Windows ssl kind of works now, but the error cases are not
implemented correctly.

basis/io/backend/unix/unix.factor

@@ -65,10 +65,6 @@ M: unix handle-length ( handle -- n/f )
     fd>> \ stat <struct> [ 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" ;
@@ -88,10 +84,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
     {

basis/io/files/windows/windows.factor

@@ -170,8 +170,6 @@ M: windows handle-length ( handle -- n/f )
         [ buffer>> dup buffer-length 0 DWORD <ref> ] dip make-overlapped
     ] 2bi <FileArgs> ;
 
-GENERIC: drain ( port handle -- )
-
 : setup-write ( <FileArgs> -- 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 ;
+    [ drop [ wait-for-file ] [ finish-write ] bi ] 2bi f ;
-
-GENERIC: refill ( port handle -- )
 
 : setup-read ( <FileArgs> -- 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)
+M: windows (wait-to-write) ( port -- )
-    [ dup handle>> drain ] with-destructors ;
+    [ 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 ;
 

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
+    namespaces
-    windows.winsock ;
+    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 ;
+
 : <ssl-socket> ( winsock -- ssl )
     [ handle>> alien-address BIO_NOCLOSE BIO_new_socket ] keep <ssl-handle>
     [ handle>> swap dup SSL_set_bio ] keep ;
@@ -23,15 +77,9 @@ M: secure ((client)) ( addrspec -- handle )
     addrspec>> ((client)) <ssl-socket> ;
 
 M: secure (get-local-address) ( handle remote -- sockaddr )
-    [ file>> handle>> ] [ addrspec>> empty-sockaddr/size int <ref> ] bi*
+    [ file>> ] [ addrspec>> ] bi* (get-local-address) ;
-    [ getsockname socket-error ] 2keep drop ;
 
-: establish-ssl-connection ( client-out remote -- )
+M: secure parse-sockaddr addrspec>> parse-sockaddr <secure> ;
-    make-sockaddr/size <ConnectEx-args>
-    swap >>port
-    dup port>> handle>> file>> handle>> >>s dup
-    s>> get-ConnectEx-ptr >>ptr dup
-    call-ConnectEx wait-for-socket drop ;
 
 ! 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>> <output-port> ] [ addrspec>> ] bi* establish-connection
+    ]
+    [ secure-connection ] 2bi ;

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