Verified Commit 0ced92f3 authored by Camil Staps's avatar Camil Staps 🚀

wip

parent f25876f8
......@@ -3,6 +3,7 @@ implementation module Crypto.SSL
// Compile with -l -lcrypto -l -lssl
// https://wiki.openssl.org/index.php/SSL/TLS_Client
import code from "ssl_help."
import StdBool
import StdInt
import StdList
......@@ -18,54 +19,92 @@ import System.FilePath
:: SSLCTX :== Pointer
:: BIO :== Pointer
Start w = initialise w
Start w = initialise HOST PORT w
where
HOST = "www.random.org"
PORT = 443
import StdDebug
HOST :== "www.random.org"
PORT :== 443
initialise :: *World -> *(String, *World)
initialise w
#! w = setup w
#! (meth,w) = SSLv23_method w
initialise :: !String !Int !*World -> *(!String, !*World)
initialise host port w
# w = trace_i 0 host w
# w = setup w
# w = trace_i 1 host w
# (meth,w) = SSLv23_method w
# w = trace_i 2 host w
| meth == 0 = ("Method was 0", w)
#! (ctx,w) = SSL_CTX_new meth w
| meth == 0 = ("CTX was 0", w)
#! w = SSL_CTX_set_verify ctx SSL_VERIFY_PEER w
#! w = SSL_CTX_set_verify_depth ctx 4 w
#! w = SSL_CTX_set_options ctx [SSL_OP_NO_SSLv2, SSL_OP_NO_SSLv3, SSL_OP_NO_COMPRESSION] w
#! (res,w) = SSL_CTX_load_verify_locations_file ctx "/etc/ssl/certs/ca-certificates.crt" w
# w = trace_i 3 host w
# (ctx,w) = SSL_CTX_new meth w
# w = trace_i 4 host w
| ctx == 0 = ("CTX was 0", w)
# w = SSL_CTX_set_verify ctx SSL_VERIFY_PEER w
# w = trace_i 5 host w
# w = SSL_CTX_set_verify_depth ctx 4 w
# w = trace_i 6 host w
# w = SSL_CTX_set_options ctx [SSL_OP_NO_SSLv2, SSL_OP_NO_SSLv3, SSL_OP_NO_COMPRESSION] w
# w = trace_i 7 host w
# (res,w) = SSL_CTX_load_verify_locations_file ctx "/etc/ssl/certs/ca-certificates.crt" w
| res <> 1 = ("LV Res was not 1", w)
#! (web,w) = BIO_new_ssl_connect ctx w
# (web,w) = BIO_new_ssl_connect ctx w
| web == 0 = ("BIO was 0", w)
#! (res,w) = BIO_set_conn_hostname web HOST PORT w
# w = trace_i 8 host w
# (res,w) = BIO_set_conn_hostname web host port w
# w = trace_i 9 host w
| res <> 1 = ("CH Res was not 1", w)
#! (ssl,w) = BIO_get_ssl web w
# (ssl,w) = BIO_get_ssl web w
| ssl == 0 = ("SSL was 0", w)
#! (res,w) = SSL_set_cipher_list ssl "HIGH:!aNULL:!kRSA:!PSK:!SRP:!MD5:!RC4" w
# (res,w) = SSL_set_cipher_list ssl "HIGH:!aNULL:!kRSA:!PSK:!SRP:!MD5:!RC4" w
| res <> 1 = ("CL Res was not 1", w)
#! (res,w) = SSL_set_tlsext_host_name ssl HOST w
# (res,w) = SSL_set_tlsext_host_name ssl host w
| res <> 1 = ("TH Res was not 1", w)
#! (res,w) = BIO_do_connect web w
# (res,w) = BIO_do_connect web w
| res <> 1 = ("DC was not 1", w)
#! (res,w) = BIO_do_handshake web w
# (res,w) = BIO_do_handshake web w
| res <> 1 = ("DH was not 1", w)
#! w = BIO_puts web (toString req) w
#! (resp,w) = BIO_read_all web w
# w = BIO_puts web (toString req) w
# (resp,w) = BIO_read_all web w
= (resp, w)
where
setup :: !*World -> *World
setup w = code {
ccall SSL_library_init ":V:A"
setup w
# w = trace_i 100 host w
# (_,w) = SSL_library_init w
# w = trace_i 101 host w
# w = SSL_load_error_strings w
# w = trace_i 102 host w
# w = OPENSSL_config 0 w
# w = trace_i 103 host w
= w
/*= code {
ccall SSL_library_init ":I:A"
ccall SSL_load_error_strings ":V:A"
pop_b 1
pushI 0
ccall OPENSSL_config "p:V:A"
}*/
trace_i :: !Int !a !.b -> .b | toString a
trace_i i n w = trace_n (toString i +++ "\t" +++ toString n) w
SSL_library_init :: !*World -> *(!Int, !*World)
SSL_library_init w = code {
ccall SSL_library_init ":I:A"
}
SSL_load_error_strings :: !*World -> *World
SSL_load_error_strings w = code {
ccall SSL_load_error_strings_dummy ":V:A"
}
OPENSSL_config :: !Pointer !*World -> *World
OPENSSL_config p w = code {
ccall OPENSSL_config_dummy "p:V:A"
}
req = { newHTTPRequest
& req_path = "/cgi-bin/randbyte?nbytes=32&format=h"
, server_name = HOST
, server_port = PORT
, server_name = host
, server_port = port
}
SSLv23_method :: !*World -> *(!SSLMethod, !*World)
......@@ -79,11 +118,11 @@ SSL_CTX_new m w = code {
}
SSL_CTX_set_verify :: !SSLCTX !Int !*World -> *World
SSL_CTX_set_verify ctx mode w = set_verify ctx mode 0 w
SSL_CTX_set_verify ctx mode w = set_verify ctx mode w
where
set_verify :: !SSLCTX !Int !Pointer !*World -> *World
set_verify ctx mode callback w = code {
ccall SSL_CTX_set_verify "pII:V:A"
set_verify :: !SSLCTX !Int /*!Pointer*/ !*World -> *World
set_verify ctx mode /*callback*/ w = code {
ccall SSL_CTX_set_verify_help "pI:V:A"
}
SSL_CTX_set_verify_depth :: !SSLCTX !Int !*World -> *World
......@@ -121,12 +160,13 @@ SSL_set_tlsext_host_name ssl host w
= SSL_ctrl_string ssl SSL_CTRL_SET_TLSEXT_HOSTNAME TLSEXT_NAMETYPE_host_name host w
where TLSEXT_NAMETYPE_host_name = 0
import StdString, StdArray
SSL_ctrl_string :: !Pointer !Int !Int !String !*World -> *(!Int, !*World)
SSL_ctrl_string ssl cmd larg parg w = call ssl cmd larg (packString parg) w
SSL_ctrl_string ssl cmd larg parg w = call ssl cmd (size parg) /*larg*/ (packString parg) w
where
call :: !Pointer !Int !Int !String !*World -> *(!Int, !*World)
call ssl cmd larg parg w = code {
ccall SSL_ctrl "pIIs:I:A"
ccall SSL_ctrl_help "pIIs:I:A"
}
BIO_new_ssl_connect :: !SSLCTX !*World -> *(!BIO, *World)
......@@ -171,24 +211,19 @@ where
ccall BIO_puts "ps:V:A"
}
// A static buffer, because BIO_read_all has an int argument after the char ptr
read_buffer =: malloc READ_SIZE
READ_SIZE = 1536
BIO_read_all :: !BIO !*World -> *(!String, !*World)
BIO_read_all bio w
#! (p,w) = malloc READ_SIZE w
#! (s,w) = read_all bio p w
// TODO should free
= (s,w)
where
READ_SIZE = 1536
read_all :: !BIO !Pointer !*World -> *(!String, !*World)
read_all bio p w
#! (n,w) = BIO_read bio p READ_SIZE w
#! (r,w) = BIO_test_flags bio BIO_FLAGS_SHOULD_RETRY w
#! (s,w) = (derefString p,w)
#! s = s % (0, n-1)
| n <= 0 && not r = (s, w)
#! (s2,w) = read_all bio p w
= (s +++ s2, w)
#! (n,w) = BIO_read bio read_buffer READ_SIZE w
#! (r,w) = BIO_test_flags bio BIO_FLAGS_SHOULD_RETRY w
#! (s,w) = (derefString read_buffer,w)
#! s = s % (0, n-1)
| n <= 0 && not r = (s, w)
#! (s2,w) = BIO_read_all bio w
= (s +++ s2, w)
BIO_read :: !BIO !Pointer !Int !*World -> *(!Int, !*World)
BIO_read bio p n w = code {
......@@ -200,7 +235,7 @@ BIO_test_flags bio f w = code {
ccall BIO_test_flags "pI:I:A"
}
malloc :: !Int !*World -> *(!Pointer, !*World)
malloc n w = code {
ccall malloc "I:p:A"
malloc :: !Int -> Pointer
malloc n = code {
ccall malloc "I:p"
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment