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.db4
Björn Lindqvist
Doug Coleman
parent
8c5ceb8b0c
commit
5f38df7741
|
|
@ -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" ;
|
||||
|
|
@ -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
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
GENERIC: refill ( port handle -- )
|
||||
[ drop [ wait-for-file ] [ finish-write ] bi ] 2bi f ;
|
||||
|
||||
: 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)
|
||||
[ 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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
: <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*
|
||||
[ getsockname socket-error ] 2keep drop ;
|
||||
[ file>> ] [ addrspec>> ] bi* (get-local-address) ;
|
||||
|
||||
: establish-ssl-connection ( client-out remote -- )
|
||||
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 ;
|
||||
M: secure parse-sockaddr addrspec>> parse-sockaddr <secure> ;
|
||||
|
||||
! 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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue