Paste: libtls wip
Author: | erg |
Mode: | factor |
Date: | Thu, 25 Feb 2016 21:36:36 |
Plain Text |
USING: accessors destructors io.sockets io.sockets.private
io.sockets.secure kernel libtls.ffi math namespaces io.backend.unix ;
IN: io.sockets.tls
TUPLE: secure-context < disposable config handle ;
HOOK: <secure-context> secure-socket-backend
ERROR: libtls-failed n ;
ERROR: libtls-ptr-failed ;
: libtls-error<>0 [ libtls-failed ] unless-zero ;
: libtls-error-on-f [ libtls-ptr-failed ] unless* ;
: tls-init tls_init libtls-error<>0 ;
SINGLETON: libtls
libtls secure-socket-backend set-global
tls-init
: tls-config-new tls_config_new libtls-error-on-f ;
: tls-client tls_client libtls-error-on-f ;
: tls-server tls_server libtls-error-on-f ;
: tls-configure
tls_configure libtls-error<>0 ;
: tls-close tls_close libtls-error<>0 ;
: tls>boolean 1 = ;
: tls-peer-cert-provided
tls_peer_cert_provided tls>boolean ;
: tls-peer-cert-contains-name
tls_peer_cert_contains_name tls>boolean ;
: with-secure-context
[
[ <secure-context> ] [ [ secure-context set ] prepose ] bi*
with-disposal
] with-scope ; inline
M: secure-inet (client)
[
B
[ resolve-host (client) [ |dispose ] dip ] keep
addrspec>> host>> pick handle>> 2drop
] with-destructors ;
TUPLE: tls-client-socket < disposable fd client ;
M: tls-client-socket dispose*
client>> tls-close ;
: <tls-client-socket>
tls-client-socket new
swap >>client
swap >>fd ; inline
M: secure ((client)) addrspec>> ((client)) tls-client <tls-client-socket> ;
M: secure establish-connection
addrspec>> establish-connection ;
M: tls-client-socket handle-fd fd>> fd>> ;
M: secure (get-local-address) addrspec>> (get-local-address) ;
M: secure parse-sockaddr addrspec>> parse-sockaddr <secure> ;
M: tls-client-socket drain
B
over [ fd>> fd>> ] [ check-buffered-port buffer>> ] bi*
[ buffer@ ] [ buffer-length ] bi tls_write
dup 0 >=
[ over buffer-consume buffer-empty? f +output+ ? ] [
errno {
{ EINTR [ 2drop +retry+ ] }
{ EAGAIN [ 2drop +output+ ] }
[ (throw-errno) ]
} case
] if ;
New Annotation