Working on OpenSSL

extra/openssl/libcrypto/libcrypto.factor

@@ -88,6 +88,8 @@ FUNCTION: int BIO_puts ( void* bp, char* buf ) ;
 
 FUNCTION: ulong ERR_get_error (  ) ;
 
+FUNCTION: void ERR_clear_error ( ) ;
+
 FUNCTION: char* ERR_error_string ( ulong e, void* buf ) ;
 
 FUNCTION: void* BIO_f_buffer (  ) ;
@@ -96,6 +98,17 @@ FUNCTION: void* BIO_f_buffer (  ) ;
 ! evp.h
 ! ===============================================
 
+: EVP_MAX_MD_SIZE 64 ;
+
+C-STRUCT: EVP_MD_CTX
+    { "EVP_MD*" "digest" }
+    { "ENGINE*" "engine" }
+    { "ulong" "flags" }
+    { "void*" "md_data" } ;
+
+TYPEDEF: void* EVP_MD*
+TYPEDEF: void* ENGINE*
+
 ! Initialize ciphers and digest tables
 FUNCTION: void OpenSSL_add_all_ciphers (  ) ;
 
@@ -104,19 +117,35 @@ FUNCTION: void OpenSSL_add_all_digests (  ) ;
 ! Clean them up before exiting
 FUNCTION: void EVP_cleanup (  ) ;
 
-FUNCTION: void* EVP_get_digestbyname ( char* name ) ;
+FUNCTION: EVP_MD* EVP_get_digestbyname ( char* name ) ;
 
-FUNCTION: void EVP_MD_CTX_init ( void* ctx ) ;
+FUNCTION: void EVP_MD_CTX_init ( EVP_MD* ctx ) ;
+
+FUNCTION: int EVP_MD_CTX_cleanup ( EVP_MD_CTX* ctx ) ;
+
+FUNCTION: EVP_MD_CTX* EVP_MD_CTX_create ( ) ;
+
+FUNCTION: void EVP_MD_CTX_destroy ( EVP_MD_CTX* ctx ) ;
+
+FUNCTION: int EVP_MD_CTX_copy_ex ( EVP_MD_CTX* out, EVP_MD_CTX* in ) ;  
+
+FUNCTION: int EVP_DigestInit_ex ( EVP_MD_CTX* ctx, EVP_MD* type, ENGINE* impl ) ;
+
+FUNCTION: int EVP_DigestUpdate ( EVP_MD_CTX* ctx, void* d, uint cnt ) ;
+
+FUNCTION: int EVP_DigestFinal_ex ( EVP_MD_CTX* ctx, void* md, uint* s ) ;
+
+FUNCTION: int EVP_Digest ( void* data, uint count, void* md, uint* size, EVP_MD* type, ENGINE* impl ) ;
+
+FUNCTION: int EVP_MD_CTX_copy ( EVP_MD_CTX* out, EVP_MD_CTX* in ) ;  
+
+FUNCTION: int EVP_DigestInit ( EVP_MD_CTX* ctx, EVP_MD* type ) ;
+
+FUNCTION: int EVP_DigestFinal ( EVP_MD_CTX* ctx, void* md, uint* s ) ;
 
 FUNCTION: void* PEM_read_bio_DHparams ( void* bp, void* x, void* cb,
                                         void* u ) ;
 
-! ===============================================
-! md5.h
-! ===============================================
-
-FUNCTION: uchar* MD5 ( uchar* d, ulong n, uchar* md ) ;
-
 ! ===============================================
 ! rsa.h
 ! ===============================================

extra/openssl/libssl/libssl.factor

@@ -97,6 +97,7 @@ FUNCTION: ssl-ctx SSL_CTX_new ( ssl-method method ) ;
 ! Load the certificates and private keys into the SSL_CTX
 FUNCTION: int SSL_CTX_use_certificate_chain_file ( ssl-ctx ctx,
                                                    char* file ) ; ! PEM type
+
 FUNCTION: ssl-pointer SSL_new ( ssl-ctx ctx ) ;
 
 FUNCTION: int SSL_set_fd ( ssl-pointer ssl, int fd ) ;
@@ -121,6 +122,10 @@ FUNCTION: void SSL_shutdown ( ssl-pointer ssl ) ;
 
 FUNCTION: void SSL_free ( ssl-pointer ssl ) ;
 
+FUNCTION: long SSL_get_verify_result ( SSL* ssl ) ;
+
+FUNCTION: X509* SSL_get_peer_certificate ( SSL* s ) ;
+
 FUNCTION: void SSL_CTX_free ( ssl-ctx ctx ) ;
 
 FUNCTION: void RAND_seed ( void* buf, int num ) ;
@@ -165,10 +170,64 @@ FUNCTION: void SSL_CTX_set_tmp_rsa_callback ( ssl-ctx ctx, void* rsa ) ;
 FUNCTION: void* BIO_f_ssl (  ) ;
 
 ! ===============================================
-! sha.h
+! x509.h
 ! ===============================================
 
-! For a high level interface to message digests
+TYPEDEF: void* X509_NAME*
-! use the EVP digest routines in libcrypto.factor
 
-FUNCTION: uchar* SHA1 ( uchar* d, ulong n, uchar* md ) ;
+TYPEDEF: void* X509*
+
+FUNCTION: int X509_NAME_get_text_by_NID ( X509_NAME* name, int nid, void* buf, int len ) ;
+FUNCTION: X509_NAME* X509_get_subject_name ( X509* a ) ;
+
+! ===============================================
+! x509_vfy.h
+! ===============================================
+
+: X509_V_OK 0 ; inline
+: X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT 2 ; inline
+: X509_V_ERR_UNABLE_TO_GET_CRL 3 ; inline
+: X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE 4 ; inline
+: X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE 5 ; inline
+: X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY 6 ; inline
+: X509_V_ERR_CERT_SIGNATURE_FAILURE 7 ; inline
+: X509_V_ERR_CRL_SIGNATURE_FAILURE 8 ; inline
+: X509_V_ERR_CERT_NOT_YET_VALID 9 ; inline
+: X509_V_ERR_CERT_HAS_EXPIRED 10 ; inline
+: X509_V_ERR_CRL_NOT_YET_VALID 11 ; inline
+: X509_V_ERR_CRL_HAS_EXPIRED 12 ; inline
+: X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD 13 ; inline
+: X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD 14 ; inline
+: X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD 15 ; inline
+: X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD 16 ; inline
+: X509_V_ERR_OUT_OF_MEM 17 ; inline
+: X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT 18 ; inline
+: X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN 19 ; inline
+: X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY 20 ; inline
+: X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE 21 ; inline
+: X509_V_ERR_CERT_CHAIN_TOO_LONG 22 ; inline
+: X509_V_ERR_CERT_REVOKED 23 ; inline
+: X509_V_ERR_INVALID_CA 24 ; inline
+: X509_V_ERR_PATH_LENGTH_EXCEEDED 25 ; inline
+: X509_V_ERR_INVALID_PURPOSE 26 ; inline
+: X509_V_ERR_CERT_UNTRUSTED 27 ; inline
+: X509_V_ERR_CERT_REJECTED 28 ; inline
+: X509_V_ERR_SUBJECT_ISSUER_MISMATCH 29 ; inline
+: X509_V_ERR_AKID_SKID_MISMATCH 30 ; inline
+: X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH 31 ; inline
+: X509_V_ERR_KEYUSAGE_NO_CERTSIGN 32 ; inline
+: X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER 33 ; inline
+: X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION 34 ; inline
+: X509_V_ERR_KEYUSAGE_NO_CRL_SIGN 35 ; inline
+: X509_V_ERR_UNHANDLED_CRITICAL_CRL_EXTENSION 36 ; inline
+: X509_V_ERR_INVALID_NON_CA 37 ; inline
+: X509_V_ERR_PROXY_PATH_LENGTH_EXCEEDED 38 ; inline
+: X509_V_ERR_KEYUSAGE_NO_DIGITAL_SIGNATURE 39 ; inline
+: X509_V_ERR_PROXY_CERTIFICATES_NOT_ALLOWED 40 ; inline
+: X509_V_ERR_APPLICATION_VERIFICATION 50 ; inline
+
+! ===============================================
+! obj_mac.h
+! ===============================================
+
+: NID_commonName 13 ; inline

extra/openssl/openssl-tests.factor

@@ -0,0 +1,20 @@
+USING: io.sockets.secure io.encodings.ascii alien.strings
+openssl namespaces accessors tools.test continuations kernel ;
+
+openssl ssl-backend [
+    [ ] [
+        <ssl-config>
+            "resource:extra/openssl/test/server.pem" >>key-file
+            "resource:extra/openssl/test/root.pem" >>ca-file
+            "password" ascii string>alien >>password
+        [ ] with-ssl-context
+    ] unit-test
+
+    [
+        <ssl-config>
+            "resource:extra/openssl/test/server.pem" >>key-file
+            "resource:extra/openssl/test/root.pem" >>ca-file
+            "wrong password" ascii string>alien >>password
+        [ ] with-ssl-context
+    ] must-fail
+] with-variable

extra/openssl/openssl.factor

@@ -0,0 +1,151 @@
+! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays kernel debugger sequences namespaces math
+math.order combinators init alien alien.c-types alien.strings libc
+continuations destructors
+locals unicode.case
+openssl.libcrypto openssl.libssl
+io.nonblocking io.files io.encodings.ascii io.sockets.secure ;
+IN: openssl
+
+! This code is based on http://www.rtfm.com/openssl-examples/
+
+SINGLETON: openssl
+
+GENERIC: ssl-method ( symbol -- method )
+
+M: SSLv2  ssl-method drop SSLv2_client_method ;
+M: SSLv23 ssl-method drop SSLv23_method ;
+M: SSLv3  ssl-method drop SSLv3_method ;
+M: TLSv1  ssl-method drop TLSv1_method ;
+
+: (ssl-error) ( num -- * )
+    ERR_get_error ERR_clear_error f ERR_error_string throw ;
+
+: ssl-error ( obj -- )
+    { f 0 } member? [ (ssl-error) ] when ;
+
+: init-ssl ( -- )
+    SSL_library_init ssl-error
+    SSL_load_error_strings
+    OpenSSL_add_all_digests
+    OpenSSL_add_all_ciphers ;
+
+SYMBOL: ssl-initiazed?
+
+: maybe-init-ssl ( -- )
+    ssl-initiazed? get-global [
+        init-ssl
+        t ssl-initiazed? set-global
+    ] unless ;
+
+[ f ssl-initiazed? set-global ] "openssl" add-init-hook
+
+TUPLE: openssl-context < ssl-context aliens ;
+
+: load-certificate-chain ( ctx -- )
+    dup config>> key-file>> [
+        [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
+        SSL_CTX_use_certificate_chain_file
+        ssl-error
+    ] [ drop ] if ;
+
+: password-callback ( -- alien )
+    "int" { "void*" "int" "bool" "void*" } "cdecl"
+    [| buf size rwflag password! |
+        password [ B{ 0 } password! ] unless
+
+        [let | len [ password strlen ] |
+            buf password len 1+ size min memcpy
+            len
+        ]
+    ] alien-callback ;
+
+: default-pasword ( ctx -- alien )
+    [ config>> password>> malloc-byte-array ] [ aliens>> ] bi
+    [ push ] [ drop ] 2bi ;
+
+: set-default-password ( ctx -- )
+    [ handle>> password-callback SSL_CTX_set_default_passwd_cb ]
+    [
+        [ handle>> ] [ default-pasword ] bi
+        SSL_CTX_set_default_passwd_cb_userdata
+    ] bi ;
+
+: use-private-key-file ( ctx -- )
+    dup config>> key-file>> [
+        [ handle>> ] [ config>> key-file>> (normalize-path) ] bi
+        SSL_FILETYPE_PEM SSL_CTX_use_PrivateKey_file
+        ssl-error
+    ] [ drop ] if ;
+
+: load-verify-locations ( ctx -- )
+    dup config>> [ ca-file>> ] [ ca-path>> ] bi or [
+        [ handle>> ]
+        [
+            config>>
+            [ ca-file>> dup [ (normalize-path) ] when ]
+            [ ca-path>> dup [ (normalize-path) ] when ] bi
+        ] bi
+        SSL_CTX_load_verify_locations ssl-error
+    ] [ drop ] if ;
+
+: set-verify-depth ( ctx -- )
+    handle>> 1 SSL_CTX_set_verify_depth ;
+
+M: openssl <ssl-context> ( config -- context )
+    maybe-init-ssl
+    [
+        dup method>> ssl-method SSL_CTX_new
+        dup ssl-error V{ } clone openssl-context boa
+        dup add-error-destructor
+        {
+            [ load-certificate-chain ]
+            [ set-default-password ]
+            [ use-private-key-file ]
+            [ load-verify-locations ]
+            [ set-verify-depth ]
+            [ ]
+        } cleave
+    ] with-destructors ;
+
+M: openssl-context dispose
+    dup aliens>> [ free ] each f >>aliens
+    dup handle>> [ SSL_CTX_free ] when* f >>handle
+    drop ;
+
+TUPLE: ssl file handle ;
+
+: <ssl> ( file -- ssl )
+    ssl-context get handle>> SSL_new dup ssl-error ssl boa ;
+
+M: ssl init-handle drop ;
+
+M: ssl close-handle
+    [ file>> close-handle ] [ handle>> SSL_free ] bi ;
+
+ERROR: certificate-verify-error result ;
+
+: check-verify-result ( ssl-handle -- )
+    SSL_get_verify_result dup X509_V_OK =
+    [ certificate-verify-error ] [ drop ] if ;
+
+: common-name ( certificate -- host )
+    X509_get_subject_name
+    NID_commonName 256 <byte-array>
+    [ 256 X509_NAME_get_text_by_NID ] keep
+    swap -1 = [ drop f ] [ ascii alien>string ] if ;
+
+ERROR: common-name-verify-error expected got ;
+
+: check-common-name ( host ssl-handle -- )
+    SSL_get_peer_certificate common-name 2dup [ >lower ] bi@ =
+    [ 2drop ] [ common-name-verify-error ] if ;
+
+: check-certificate ( host ssl -- )
+    handle>>
+    [ nip check-verify-result ]
+    [ check-common-name ]
+    2bi ;
+
+openssl ssl-backend set-global

extra/openssl/unix/unix.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays kernel debugger sequences namespaces math
+math.order combinators init alien alien.c-types alien.strings libc
+continuations destructors
+locals unicode.case
+openssl.libcrypto openssl.libssl
+io.files io.encodings.ascii io.sockets.secure ;
+IN: openssl.unix
+
+

unmaintained/openssl/openssl-tests.factor

@@ -1,146 +0,0 @@
-USING: alien alien.c-types alien.strings assocs bit-arrays
-hashtables io io.files io.encodings.ascii io.sockets kernel
-mirrors openssl.libcrypto openssl.libssl namespaces math
-math.parser openssl prettyprint sequences tools.test ;
-
-! =========================================================
-! Some crypto functions (still to be turned into words)
-! =========================================================
-
-[
-    B{ 201 238 222 100 92 200 182 188 138 255 129 163 115 88 240 136 }
-]
-[ "Hello world from the openssl binding" >md5 ] unit-test
-
-! Not found on netbsd, windows -- why?
-! [
-    ! B{ 63 113 237 255 181 5 152 241 136 181 43 95 160 105 44 87 49
-    ! 82 115 0 }
-! ]
-! [ "Hello world from the openssl binding" >sha1 ] unit-test
-
-! =========================================================
-! Initialize context
-! =========================================================
-
-[ ] [ init load-error-strings ] unit-test
-
-[ ] [ ssl-v23 new-ctx ] unit-test
-
-[ ] [ get-ctx "resource:extra/openssl/test/server.pem" use-cert-chain ] unit-test
-
-! TODO: debug 'Memory protection fault at address 6c'
-! get-ctx 1024 "char" malloc-array 1024 0 f password-cb set-default-passwd
-
-[ ] [ get-ctx "password" ascii string>alien set-default-passwd-userdata ] unit-test
-
-! Enter PEM pass phrase: password
-[ ] [ get-ctx "resource:extra/openssl/test/server.pem"
-SSL_FILETYPE_PEM use-private-key ] unit-test
-
-[ ] [ get-ctx "resource:extra/openssl/test/root.pem" f
-verify-load-locations ] unit-test
-
-[ ] [ get-ctx 1 set-verify-depth ] unit-test
-
-! =========================================================
-! Load Diffie-Hellman parameters
-! =========================================================
-
-[ ] [ "resource:extra/openssl/test/dh1024.pem" "r" bio-new-file ] unit-test
-
-[ ] [ get-bio f f f read-pem-dh-params ] unit-test
-
-[ ] [ get-bio bio-free ] unit-test
-
-! TODO: debug SSL_CTX_set_tmp_dh 'No such symbol'
-[ ] [ get-ctx get-dh set-tmp-dh-callback ] unit-test
-
-! Workaround (this function should never be called directly)
-! [ ] [ get-ctx SSL_CTRL_SET_TMP_DH 0 get-dh set-ctx-ctrl ] unit-test
-
-! =========================================================
-! Generate ephemeral RSA key
-! =========================================================
-
-[ ] [ 512 RSA_F4 f f generate-rsa-key ] unit-test
-
-! TODO: debug SSL_CTX_set_tmp_rsa 'No such symbol'
-! get-ctx get-rsa set-tmp-rsa-callback
-
-! Workaround (this function should never be called directly)
-[ ] [ get-ctx SSL_CTRL_SET_TMP_RSA 0 get-rsa set-ctx-ctrl ] unit-test
-
-[ ] [ get-rsa free-rsa ] unit-test
-
-! =========================================================
-! Listen and accept on socket
-! =========================================================
-
-! SYMBOL: sock
-! SYMBOL: fdset
-! SYMBOL: acset
-! SYMBOL: sbio
-! SYMBOL: ssl
-! 
-! : is-set ( seq -- newseq )
-!     <enum> >alist [ nip ] assoc-filter >hashtable keys ;
-! 
-! ! 1234 server-socket sock set
-! "127.0.0.1" 1234 <inet4> SOCK_STREAM server-fd sock set
-! 
-! FD_SETSIZE 8 * <bit-array> fdset set
-! 
-! FD_SETSIZE 8 * <bit-array> t 8 rot [ set-nth ] keep fdset set
-! 
-! fdset get is-set .
-
-! : loop ( -- )
-!     sock get f f accept
-!     dup -1 = [ drop ] [
-!         dup number>string print flush
-!         ! BIO_NOCLOSE bio-new-socket sbio set
-!         [ get-ctx new-ssl ssl set ] keep
-!         ssl get swap set-ssl-fd
-!         ! ssl get sbio get dup set-ssl-bio
-!         ! ssl get ssl-accept
-!         ! dup 0 <= [ 
-!         !     ssl get swap ssl-get-error 
-!         ! ] [ drop ] if
-!     ] if
-!     loop ;
-
-! { } acset set
-! 
-! : loop ( -- )
-!     ! FD_SETSIZE fdset get f f f select . flush
-!     FD_SETSIZE fdset get f f 10000 make-timeval select 
-!     0 <= [ acset get [ close ] each "timeout" print ] [
-!         fdset get is-set sock get swap member? [ 
-!              sock get f f accept dup . flush 
-!              acset get swap add acset set
-!     ] [ ] if
-!         loop
-!     ] if ;
-! 
-! loop
-! 
-! sock get close
-
-! =========================================================
-! Dump errors to file
-! =========================================================
-
-[ ] [ "resource:extra/openssl/test/errors.txt" "w" bio-new-file ] unit-test
-
-[ 6 ] [ get-bio "Hello\n" bio-print ] unit-test
-
-[ ] [ get-bio bio-free ] unit-test
-
-! =========================================================
-! Clean-up
-! =========================================================
-
-! sock get close
-
-get-ctx destroy-ctx

unmaintained/openssl/openssl.factor

@@ -1,154 +0,0 @@
-! Copyright (C) 2007 Elie CHAFTARI
-! See http://factorcode.org/license.txt for BSD license.
-!
-! Tested with OpenSSL 0.9.8a_0 on Mac OS X 10.4.9 PowerPC
-
-USING: alien alien.c-types alien.strings assocs kernel libc
-namespaces openssl.libcrypto openssl.libssl sequences
-io.encodings.ascii ;
-
-IN: openssl
-
-SYMBOL: bio
-SYMBOL: ssl-bio
-
-SYMBOL: ctx
-SYMBOL: dh
-SYMBOL: rsa
-
-! =========================================================
-! Callback routines
-! =========================================================
-
-: password-cb ( -- alien )
-    "int" { "char*" "int" "int" "void*" } "cdecl"
-    [ 3drop "password" ascii string>alien 1023 memcpy
-    "password" length ] alien-callback ;
-
-! =========================================================
-! Error-handling routines
-! =========================================================
-
-: get-error ( -- num )
-    ERR_get_error ;
-
-: error-string ( num -- str )
-    f ERR_error_string ;
-
-: check-result ( result -- )
-    1 = [  ] [
-        get-error error-string throw
-    ] if ;
-
-: ssl-get-error ( ssl ret -- )
-    SSL_get_error error-messages at throw ;
-
-! Write errors to a file
-: bio-new-file ( path mode -- )
-    BIO_new_file bio set ;
-
-: bio-print ( bio str -- n )
-    BIO_printf ;
-
-: bio-free ( bio -- )
-    BIO_free check-result ;
-
-! =========================================================
-! Initialization routines
-! =========================================================
-
-: init ( -- )
-    SSL_library_init drop ; ! always returns 1
-
-: load-error-strings ( -- )
-    SSL_load_error_strings ;
-
-: ssl-v23 ( -- method )
-    SSLv23_method ;
-
-: new-ctx ( method -- )
-    SSL_CTX_new ctx set ;
-
-: use-cert-chain ( ctx file -- )
-    SSL_CTX_use_certificate_chain_file check-result ;
-
-: set-default-passwd ( ctx cb -- )
-    SSL_CTX_set_default_passwd_cb ;
-
-: set-default-passwd-userdata ( ctx passwd -- )
-    SSL_CTX_set_default_passwd_cb_userdata ;
-
-: use-private-key ( ctx file type -- )
-    SSL_CTX_use_PrivateKey_file check-result ;
-
-: verify-load-locations ( ctx file path -- )
-    SSL_CTX_load_verify_locations check-result ;
-
-: set-verify-depth ( ctx depth -- )
-    SSL_CTX_set_verify_depth ;
-
-: read-pem-dh-params ( bio x cb u -- )
-    PEM_read_bio_DHparams dh set ;
-
-: set-tmp-dh-callback ( ctx dh -- )
-    SSL_CTX_set_tmp_dh_callback ;
-
-: set-ctx-ctrl ( ctx cmd larg parg -- )
-    SSL_CTX_ctrl check-result ;
-
-: generate-rsa-key ( n e cb cbarg -- )
-    RSA_generate_key rsa set ;
-
-: set-tmp-rsa-callback ( ctx rsa -- )
-    SSL_CTX_set_tmp_rsa_callback ;
-
-: free-rsa ( rsa -- )
-    RSA_free ;
-
-: bio-new-socket ( fd flag -- sbio )
-    BIO_new_socket ;
-
-: new-ssl ( ctx -- ssl )
-    SSL_new ;
-
-: set-ssl-bio ( ssl bio bio -- )
-    SSL_set_bio ;
-
-: set-ssl-fd ( ssl fd -- )
-    SSL_set_fd check-result ;
-
-: ssl-accept ( ssl -- result )
-    SSL_accept ;
-
-! =========================================================
-! Clean-up and termination routines
-! =========================================================
-
-: destroy-ctx ( ctx -- )
-    SSL_CTX_free ;
-
-! =========================================================
-! Public routines
-! =========================================================
-
-: get-bio ( -- bio )
-    bio get ;
-
-: get-ssl-bio ( -- bio )
-    ssl-bio get ;
-
-: get-ctx ( -- ctx )
-    ctx get ;
-
-: get-dh ( -- dh )
-    dh get ;
-
-: get-rsa ( -- rsa )
-    rsa get ;
-
-: >md5 ( str -- byte-array )
-    dup length 16 "uchar" <c-array> [ MD5 ] keep nip ;
-
-: >sha1 ( str -- byte-array )
-    dup length 20 "uchar" <c-array> [ SHA1 ] keep nip ;
-