Paste: libtls wip

! Copyright (C) 2016 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors destructors io.sockets io.sockets.private
io.sockets.secure kernel libtls.ffi math namespaces io.backend.unix ;
IN: io.sockets.tls

! "https://wrong.host.badssl.com" http-get
! "https://factorcode.org" http-get


TUPLE: secure-context < disposable config handle ;

HOOK: <secure-context> secure-socket-backend ( config -- context )


ERROR: libtls-failed n ;
ERROR: libtls-ptr-failed ;
: libtls-error<>0 ( n -- ) [ libtls-failed ] unless-zero ;
: libtls-error-on-f ( ptr/f -- ptr ) [ libtls-ptr-failed ] unless* ;

: tls-init ( -- ) tls_init libtls-error<>0 ;

SINGLETON: libtls
libtls secure-socket-backend set-global
tls-init

: tls-config-new ( -- obj ) tls_config_new libtls-error-on-f ;
: tls-client ( -- obj ) tls_client libtls-error-on-f ;
: tls-server ( -- obj ) tls_server libtls-error-on-f ;
: tls-configure ( tls_ctx tls_config -- )
    tls_configure libtls-error<>0 ;

: tls-close ( tls_ctx -- ) tls_close libtls-error<>0 ;

: tls>boolean ( n -- ? ) 1 = ;

: tls-peer-cert-provided ( tls_ctx -- ? )
    tls_peer_cert_provided tls>boolean ;

: tls-peer-cert-contains-name ( tls_ctx string -- ? )
    tls_peer_cert_contains_name tls>boolean ;

: with-secure-context ( config quot -- )
    [
        [ <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> ( fd client -- obj )
    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 ;
    ! [ establish-connection ] [ secure-connection ] 2bi ;
    
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 ;