diff --git a/unmaintained/openssl/authors.txt b/extra/openssl/authors.txt similarity index 100% rename from unmaintained/openssl/authors.txt rename to extra/openssl/authors.txt diff --git a/unmaintained/openssl/libcrypto/libcrypto.factor b/extra/openssl/libcrypto/libcrypto.factor similarity index 73% rename from unmaintained/openssl/libcrypto/libcrypto.factor rename to extra/openssl/libcrypto/libcrypto.factor index 312c7b04b3..20b606db66 100755 --- a/unmaintained/openssl/libcrypto/libcrypto.factor +++ b/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 ! =============================================== diff --git a/unmaintained/openssl/libssl/libssl.factor b/extra/openssl/libssl/libssl.factor similarity index 67% rename from unmaintained/openssl/libssl/libssl.factor rename to extra/openssl/libssl/libssl.factor index 0f2e7b3184..d1c53c4b23 100755 --- a/unmaintained/openssl/libssl/libssl.factor +++ b/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 -! use the EVP digest routines in libcrypto.factor +TYPEDEF: void* X509_NAME* -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 diff --git a/unmaintained/openssl/openssl-docs.factor b/extra/openssl/openssl-docs.factor similarity index 100% rename from unmaintained/openssl/openssl-docs.factor rename to extra/openssl/openssl-docs.factor diff --git a/extra/openssl/openssl-tests.factor b/extra/openssl/openssl-tests.factor new file mode 100755 index 0000000000..d06340d518 --- /dev/null +++ b/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 [ + [ ] [ + + "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 + + [ + + "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 diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor new file mode 100755 index 0000000000..196ac58695 --- /dev/null +++ b/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 ( 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 ; + +: ( 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 + [ 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 diff --git a/unmaintained/openssl/summary.txt b/extra/openssl/summary.txt similarity index 100% rename from unmaintained/openssl/summary.txt rename to extra/openssl/summary.txt diff --git a/unmaintained/openssl/tags.txt b/extra/openssl/tags.txt similarity index 100% rename from unmaintained/openssl/tags.txt rename to extra/openssl/tags.txt diff --git a/unmaintained/openssl/test/dh1024.pem b/extra/openssl/test/dh1024.pem similarity index 100% rename from unmaintained/openssl/test/dh1024.pem rename to extra/openssl/test/dh1024.pem diff --git a/unmaintained/openssl/test/errors.txt b/extra/openssl/test/errors.txt similarity index 100% rename from unmaintained/openssl/test/errors.txt rename to extra/openssl/test/errors.txt diff --git a/unmaintained/openssl/test/root.pem b/extra/openssl/test/root.pem similarity index 100% rename from unmaintained/openssl/test/root.pem rename to extra/openssl/test/root.pem diff --git a/unmaintained/openssl/test/server.pem b/extra/openssl/test/server.pem similarity index 100% rename from unmaintained/openssl/test/server.pem rename to extra/openssl/test/server.pem diff --git a/extra/openssl/unix/unix.factor b/extra/openssl/unix/unix.factor new file mode 100644 index 0000000000..d84a46e085 --- /dev/null +++ b/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 + + diff --git a/unmaintained/openssl/openssl-tests.factor b/unmaintained/openssl/openssl-tests.factor deleted file mode 100755 index 2b840bdb9c..0000000000 --- a/unmaintained/openssl/openssl-tests.factor +++ /dev/null @@ -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 ) -! >alist [ nip ] assoc-filter >hashtable keys ; -! -! ! 1234 server-socket sock set -! "127.0.0.1" 1234 SOCK_STREAM server-fd sock set -! -! FD_SETSIZE 8 * fdset set -! -! FD_SETSIZE 8 * 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 diff --git a/unmaintained/openssl/openssl.factor b/unmaintained/openssl/openssl.factor deleted file mode 100755 index 9b23774598..0000000000 --- a/unmaintained/openssl/openssl.factor +++ /dev/null @@ -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" [ MD5 ] keep nip ; - -: >sha1 ( str -- byte-array ) - dup length 20 "uchar" [ SHA1 ] keep nip ; -