Debugging SSL
parent
03cefc141e
commit
e5f05c25e6
|
@ -9,10 +9,6 @@ io.encodings.ascii io.buffers io.sockets io.sockets.secure
|
|||
unix system ;
|
||||
IN: io.unix.sockets.secure
|
||||
|
||||
! todo: SSL_pending, rehandshake
|
||||
! check-certificate at some point
|
||||
! test on windows
|
||||
|
||||
M: ssl-handle handle-fd file>> handle-fd ;
|
||||
|
||||
: syscall-error ( r -- * )
|
||||
|
@ -78,6 +74,8 @@ M: ssl ((client)) ( addrspec -- handle )
|
|||
|
||||
M: ssl parse-sockaddr addrspec>> parse-sockaddr <ssl> ;
|
||||
|
||||
M: ssl (get-local-address) addrspec>> (get-local-address) ;
|
||||
|
||||
: check-connect-response ( port r -- event )
|
||||
check-response
|
||||
{
|
||||
|
@ -88,15 +86,15 @@ M: ssl parse-sockaddr addrspec>> parse-sockaddr <ssl> ;
|
|||
{ SSL_ERROR_SSL [ (ssl-error) ] }
|
||||
} case ;
|
||||
|
||||
: do-ssl-connect ( port ssl-handle -- )
|
||||
2dup SSL_connect check-connect-response dup
|
||||
[ >r over r> wait-for-port do-ssl-connect ] [ 3drop ] if ;
|
||||
: do-ssl-connect ( port -- )
|
||||
dup dup handle>> handle>> SSL_connect
|
||||
check-connect-response dup
|
||||
[ dupd wait-for-port do-ssl-connect ] [ 2drop ] if ;
|
||||
|
||||
M: ssl establish-connection ( client-out remote -- )
|
||||
addrspec>>
|
||||
[ establish-connection ]
|
||||
[ drop dup handle>> do-ssl-connect ]
|
||||
[ drop t >>connected drop ]
|
||||
[ addrspec>> establish-connection ]
|
||||
[ drop do-ssl-connect ]
|
||||
[ drop handle>> t >>connected drop ]
|
||||
2tri ;
|
||||
|
||||
M: ssl (server) addrspec>> (server) ;
|
||||
|
@ -122,16 +120,29 @@ M: ssl (accept)
|
|||
] with-destructors ;
|
||||
|
||||
: check-shutdown-response ( handle r -- event )
|
||||
>r handle>> r> SSL_get_error
|
||||
#! SSL_shutdown always returns 0 due to openssl bugs?
|
||||
{
|
||||
{ SSL_ERROR_WANT_READ [ +input+ ] }
|
||||
{ SSL_ERROR_WANT_WRITE [ +output+ ] }
|
||||
{ SSL_ERROR_SYSCALL [ -1 syscall-error ] }
|
||||
{ SSL_ERROR_SSL [ (ssl-error) ] }
|
||||
{ 1 [ drop f ] }
|
||||
{ 0 [
|
||||
dup SSL_want {
|
||||
{ SSL_NOTHING [ dup SSL_shutdown check-shutdown-response ] }
|
||||
{ SSL_READING [ drop +input+ ] }
|
||||
{ SSL_WRITING [ drop +output+ ] }
|
||||
} case
|
||||
] }
|
||||
{ -1 [
|
||||
-1 SSL_get_error
|
||||
{
|
||||
{ SSL_ERROR_WANT_READ [ +input+ ] }
|
||||
{ SSL_ERROR_WANT_WRITE [ +output+ ] }
|
||||
{ SSL_ERROR_SYSCALL [ -1 syscall-error ] }
|
||||
{ SSL_ERROR_SSL [ (ssl-error) ] }
|
||||
} case
|
||||
] }
|
||||
} case ;
|
||||
|
||||
M: unix ssl-shutdown
|
||||
dup connected>> [
|
||||
dup dup handle>> SSL_shutdown check-shutdown-response
|
||||
dup handle>> dup SSL_shutdown check-shutdown-response
|
||||
dup [ dupd wait-for-fd ssl-shutdown ] [ 2drop ] if
|
||||
] [ drop ] if ;
|
||||
|
|
|
@ -122,6 +122,13 @@ FUNCTION: int SSL_shutdown ( ssl-pointer ssl ) ;
|
|||
|
||||
FUNCTION: void SSL_free ( ssl-pointer ssl ) ;
|
||||
|
||||
FUNCTION: int SSL_want ( ssl-pointer ssl ) ;
|
||||
|
||||
: SSL_NOTHING 1 ; inline
|
||||
: SSL_WRITING 2 ; inline
|
||||
: SSL_READING 3 ; inline
|
||||
: SSL_X509_LOOKUP 4 ; inline
|
||||
|
||||
FUNCTION: long SSL_get_verify_result ( SSL* ssl ) ;
|
||||
|
||||
FUNCTION: X509* SSL_get_peer_certificate ( SSL* s ) ;
|
||||
|
|
Loading…
Reference in New Issue