Verified Commit f25876f8 authored by Camil Staps's avatar Camil Staps 🚀

SSL proof of concept

parent 25c0dbbd
definition module Crypto.SSL
from StdInt import bitor
:: SSLOption :== Int
SSL_VERIFY_NONE :== 0x00
SSL_VERIFY_PEER :== 0x01
SSL_VERIFY_FAIL_IF_NO_PEER_CERT :== 0x02
SSL_VERIFY_CLIENT_ONCE :== 0x04
SSL_OP_MICROSOFT_SESS_ID_BUG :== 0x00000001
SSL_OP_NETSCAPE_CHALLENGE_BUG :== 0x00000002
SSL_OP_LEGACY_SERVER_CONNECT :== 0x00000004
SSL_OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG :== 0x00000008
SSL_OP_TLSEXT_PADDING :== 0x00000010
SSL_OP_MICROSOFT_BIG_SSLV3_BUFFER :== 0x00000020
SSL_OP_SAFARI_ECDHE_ECDSA_BUG :== 0x00000040
SSL_OP_SSLEAY_080_CLIENT_DH_BUG :== 0x00000080
SSL_OP_TLS_D5_BUG :== 0x00000100
SSL_OP_TLS_BLOCK_PADDING_BUG :== 0x00000200
SSL_OP_MSIE_SSLV2_RSA_PADDING :== 0x0
SSL_OP_SSLREF2_REUSE_CERT_TYPE_BUG :== 0x0
SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS :== 0x00000800
SSL_OP_ALL :== 0x80000BFF
SSL_OP_NO_QUERY_MTU :== 0x00001000
SSL_OP_COOKIE_EXCHANGE :== 0x00002000
SSL_OP_NO_TICKET :== 0x00004000
SSL_OP_CISCO_ANYCONNECT :== 0x00008000
SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION :== 0x00010000
SSL_OP_NO_COMPRESSION :== 0x00020000
SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION :== 0x00040000
SSL_OP_SINGLE_ECDH_USE :== 0x00080000
SSL_OP_SINGLE_DH_USE :== 0x00100000
SSL_OP_EPHEMERAL_RSA :== 0x0
SSL_OP_CIPHER_SERVER_PREFERENCE :== 0x00400000
SSL_OP_TLS_ROLLBACK_BUG :== 0x00800000
SSL_OP_NO_SSLv2 :== 0x01000000
SSL_OP_NO_SSLv3 :== 0x02000000
SSL_OP_NO_TLSv1 :== 0x04000000
SSL_OP_NO_TLSv1_2 :== 0x08000000
SSL_OP_NO_TLSv1_1 :== 0x10000000
SSL_OP_PKCS1_CHECK_1 :== 0x0
SSL_OP_PKCS1_CHECK_2 :== 0x0
SSL_OP_NETSCAPE_CA_DN_BUG :== 0x20000000
SSL_OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG :== 0x40000000
SSL_OP_CRYPTOPRO_TLSEXT_BUG :== 0x80000000
SSL_CTRL_NEED_TMP_RSA :== 1
SSL_CTRL_SET_TMP_RSA :== 2
SSL_CTRL_SET_TMP_DH :== 3
SSL_CTRL_SET_TMP_ECDH :== 4
SSL_CTRL_SET_TMP_RSA_CB :== 5
SSL_CTRL_SET_TMP_DH_CB :== 6
SSL_CTRL_SET_TMP_ECDH_CB :== 7
SSL_CTRL_GET_SESSION_REUSED :== 8
SSL_CTRL_GET_CLIENT_CERT_REQUEST :== 9
SSL_CTRL_GET_NUM_RENEGOTIATIONS :== 10
SSL_CTRL_CLEAR_NUM_RENEGOTIATIONS :== 11
SSL_CTRL_GET_TOTAL_RENEGOTIATIONS :== 12
SSL_CTRL_GET_FLAGS :== 13
SSL_CTRL_EXTRA_CHAIN_CERT :== 14
SSL_CTRL_SET_MSG_CALLBACK :== 15
SSL_CTRL_SET_MSG_CALLBACK_ARG :== 16
SSL_CTRL_SET_MTU :== 17
SSL_CTRL_SESS_NUMBER :== 20
SSL_CTRL_SESS_CONNECT :== 21
SSL_CTRL_SESS_CONNECT_GOOD :== 22
SSL_CTRL_SESS_CONNECT_RENEGOTIATE :== 23
SSL_CTRL_SESS_ACCEPT :== 24
SSL_CTRL_SESS_ACCEPT_GOOD :== 25
SSL_CTRL_SESS_ACCEPT_RENEGOTIATE :== 26
SSL_CTRL_SESS_HIT :== 27
SSL_CTRL_SESS_CB_HIT :== 28
SSL_CTRL_SESS_MISSES :== 29
SSL_CTRL_SESS_TIMEOUTS :== 30
SSL_CTRL_SESS_CACHE_FULL :== 31
SSL_CTRL_OPTIONS :== 32
SSL_CTRL_MODE :== 33
SSL_CTRL_GET_READ_AHEAD :== 40
SSL_CTRL_SET_READ_AHEAD :== 41
SSL_CTRL_SET_SESS_CACHE_SIZE :== 42
SSL_CTRL_GET_SESS_CACHE_SIZE :== 43
SSL_CTRL_SET_SESS_CACHE_MODE :== 44
SSL_CTRL_GET_SESS_CACHE_MODE :== 45
SSL_CTRL_GET_MAX_CERT_LIST :== 50
SSL_CTRL_SET_MAX_CERT_LIST :== 51
SSL_CTRL_SET_MAX_SEND_FRAGMENT :== 52
SSL_CTRL_SET_TLSEXT_SERVERNAME_CB :== 53
SSL_CTRL_SET_TLSEXT_SERVERNAME_ARG :== 54
SSL_CTRL_SET_TLSEXT_HOSTNAME :== 55
SSL_CTRL_SET_TLSEXT_DEBUG_CB :== 56
SSL_CTRL_SET_TLSEXT_DEBUG_ARG :== 57
SSL_CTRL_GET_TLSEXT_TICKET_KEYS :== 58
SSL_CTRL_SET_TLSEXT_TICKET_KEYS :== 59
SSL_CTRL_SET_TLSEXT_OPAQUE_PRF_INPUT :== 60
SSL_CTRL_SET_TLSEXT_OPAQUE_PRF_INPUT_CB :== 61
SSL_CTRL_SET_TLSEXT_OPAQUE_PRF_INPUT_CB_ARG :== 62
SSL_CTRL_SET_TLSEXT_STATUS_REQ_CB :== 63
SSL_CTRL_SET_TLSEXT_STATUS_REQ_CB_ARG :== 64
SSL_CTRL_SET_TLSEXT_STATUS_REQ_TYPE :== 65
SSL_CTRL_GET_TLSEXT_STATUS_REQ_EXTS :== 66
SSL_CTRL_SET_TLSEXT_STATUS_REQ_EXTS :== 67
SSL_CTRL_GET_TLSEXT_STATUS_REQ_IDS :== 68
SSL_CTRL_SET_TLSEXT_STATUS_REQ_IDS :== 69
SSL_CTRL_GET_TLSEXT_STATUS_REQ_OCSP_RESP :== 70
SSL_CTRL_SET_TLSEXT_STATUS_REQ_OCSP_RESP :== 71
SSL_CTRL_SET_TLSEXT_TICKET_KEY_CB :== 72
SSL_CTRL_SET_TLS_EXT_SRP_USERNAME_CB :== 75
SSL_CTRL_SET_SRP_VERIFY_PARAM_CB :== 76
SSL_CTRL_SET_SRP_GIVE_CLIENT_PWD_CB :== 77
SSL_CTRL_SET_SRP_ARG :== 78
SSL_CTRL_SET_TLS_EXT_SRP_USERNAME :== 79
SSL_CTRL_SET_TLS_EXT_SRP_STRENGTH :== 80
SSL_CTRL_SET_TLS_EXT_SRP_PASSWORD :== 81
SSL_CTRL_TLS_EXT_SEND_HEARTBEAT :== 85
SSL_CTRL_GET_TLS_EXT_HEARTBEAT_PENDING :== 86
SSL_CTRL_SET_TLS_EXT_HEARTBEAT_NO_REQUESTS :== 87
DTLS_CTRL_GET_TIMEOUT :== 73
DTLS_CTRL_HANDLE_TIMEOUT :== 74
DTLS_CTRL_LISTEN :== 75
SSL_CTRL_GET_RI_SUPPORT :== 76
SSL_CTRL_CLEAR_OPTIONS :== 77
SSL_CTRL_CLEAR_MODE :== 78
SSL_CTRL_GET_EXTRA_CHAIN_CERTS :== 82
SSL_CTRL_CLEAR_EXTRA_CHAIN_CERTS :== 83
SSL_CTRL_CHECK_PROTO_VERSION :== 119
BIO_C_SET_CONNECT :== 100
BIO_C_DO_STATE_MACHINE :== 101
BIO_C_SET_NBIO :== 102
BIO_C_SET_PROXY_PARAM :== 103
BIO_C_SET_FD :== 104
BIO_C_GET_FD :== 105
BIO_C_SET_FILE_PTR :== 106
BIO_C_GET_FILE_PTR :== 107
BIO_C_SET_FILENAME :== 108
BIO_C_SET_SSL :== 109
BIO_C_GET_SSL :== 110
BIO_C_SET_MD :== 111
BIO_C_GET_MD :== 112
BIO_C_GET_CIPHER_STATUS :== 113
BIO_C_SET_BUF_MEM :== 114
BIO_C_GET_BUF_MEM_PTR :== 115
BIO_C_GET_BUFF_NUM_LINES :== 116
BIO_C_SET_BUFF_SIZE :== 117
BIO_C_SET_ACCEPT :== 118
BIO_C_SSL_MODE :== 119
BIO_C_GET_MD_CTX :== 120
BIO_C_GET_PROXY_PARAM :== 121
BIO_C_SET_BUFF_READ_DATA :== 122
BIO_C_GET_CONNECT :== 123
BIO_C_GET_ACCEPT :== 124
BIO_C_SET_SSL_RENEGOTIATE_BYTES :== 125
BIO_C_GET_SSL_NUM_RENEGOTIATES :== 126
BIO_C_SET_SSL_RENEGOTIATE_TIMEOUT :== 127
BIO_C_FILE_SEEK :== 128
BIO_C_GET_CIPHER_CTX :== 129
BIO_C_SET_BUF_MEM_EOF_RETURN :== 130
BIO_C_SET_BIND_MODE :== 131
BIO_C_GET_BIND_MODE :== 132
BIO_C_FILE_TELL :== 133
BIO_C_GET_SOCKS :== 134
BIO_C_SET_SOCKS :== 135
BIO_C_SET_WRITE_BUF_SIZE :== 136
BIO_C_GET_WRITE_BUF_SIZE :== 137
BIO_C_MAKE_BIO_PAIR :== 138
BIO_C_DESTROY_BIO_PAIR :== 139
BIO_C_GET_WRITE_GUARANTEE :== 140
BIO_C_GET_READ_REQUEST :== 141
BIO_C_SHUTDOWN_WR :== 142
BIO_C_NREAD0 :== 143
BIO_C_NREAD :== 144
BIO_C_NWRITE0 :== 145
BIO_C_NWRITE :== 146
BIO_C_RESET_READ_REQUEST :== 147
BIO_C_SET_MD_CTX :== 148
BIO_C_SET_PREFIX :== 149
BIO_C_GET_PREFIX :== 150
BIO_C_SET_SUFFIX :== 151
BIO_C_GET_SUFFIX :== 152
BIO_C_SET_EX_ARG :== 153
BIO_C_GET_EX_ARG :== 154
BIO_FLAGS_READ :== 0x01
BIO_FLAGS_WRITE :== 0x02
BIO_FLAGS_IO_SPECIAL :== 0x04
BIO_FLAGS_SHOULD_RETRY :== 0x08
BIO_FLAGS_UPLINK :== 0
BIO_FLAGS_RWS :== BIO_FLAGS_READ bitor BIO_FLAGS_WRITE bitor BIO_FLAGS_IO_SPECIAL
implementation module Crypto.SSL
// Compile with -l -lcrypto -l -lssl
// https://wiki.openssl.org/index.php/SSL/TLS_Client
import StdBool
import StdInt
import StdList
import StdString
import StdTuple
from Data.Func import $
import Internet.HTTP
import System._Pointer
import System.FilePath
:: SSLMethod :== Pointer
:: SSLCTX :== Pointer
:: BIO :== Pointer
Start w = initialise w
import StdDebug
HOST :== "www.random.org"
PORT :== 443
initialise :: *World -> *(String, *World)
initialise w
#! w = setup w
#! (meth,w) = SSLv23_method 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
| res <> 1 = ("LV Res was not 1", 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
| res <> 1 = ("CH Res was not 1", 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 <> 1 = ("CL Res was not 1", 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 <> 1 = ("DC was not 1", 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
= (resp, w)
where
setup :: !*World -> *World
setup w = code {
ccall SSL_library_init ":V:A"
ccall SSL_load_error_strings ":V:A"
pushI 0
ccall OPENSSL_config "p:V:A"
}
req = { newHTTPRequest
& req_path = "/cgi-bin/randbyte?nbytes=32&format=h"
, server_name = HOST
, server_port = PORT
}
SSLv23_method :: !*World -> *(!SSLMethod, !*World)
SSLv23_method w = code {
ccall SSLv23_method ":p:A"
}
SSL_CTX_new :: !SSLMethod !*World -> *(!SSLCTX, !*World)
SSL_CTX_new m w = code {
ccall SSL_CTX_new "p:p:A"
}
SSL_CTX_set_verify :: !SSLCTX !Int !*World -> *World
SSL_CTX_set_verify ctx mode w = set_verify ctx mode 0 w
where
set_verify :: !SSLCTX !Int !Pointer !*World -> *World
set_verify ctx mode callback w = code {
ccall SSL_CTX_set_verify "pII:V:A"
}
SSL_CTX_set_verify_depth :: !SSLCTX !Int !*World -> *World
SSL_CTX_set_verify_depth ctx depth w = code {
ccall SSL_CTX_set_verify_depth "pI:V:A"
}
SSL_CTX_load_verify_locations_file :: !SSLCTX !FilePath !*World -> *(!Int, !*World)
SSL_CTX_load_verify_locations_file ctx file w
= load_verify_locations ctx (packString file) 0 w
where
load_verify_locations :: !SSLCTX !String !Pointer !*World -> *(!Int, !*World)
load_verify_locations ctx file dir w = code {
ccall SSL_CTX_load_verify_locations "psp:I:A"
}
SSL_CTX_set_options :: !SSLCTX [SSLOption] *World -> *World
SSL_CTX_set_options ctx opts w = snd $ SSL_CTX_ctrl ctx SSL_CTRL_OPTIONS (foldr (bitor) 0 opts) 0 w
SSL_CTX_ctrl :: !SSLCTX !Int !Int !Pointer !*World -> *(!Int, !*World)
SSL_CTX_ctrl ctx cmd larg parg w = code {
ccall SSL_CTX_ctrl "pIIp:I:A"
}
SSL_set_cipher_list :: !Pointer !String !*World -> *(!Int, !*World)
SSL_set_cipher_list ssl list w = set_cipher_list ssl (packString list) w
where
set_cipher_list :: !Pointer !String !*World -> *(!Int, !*World)
set_cipher_list ssl list w = code {
ccall SSL_set_cipher_list "ps:I:A"
}
SSL_set_tlsext_host_name :: !Pointer !String !*World -> *(!Int, !*World)
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
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
where
call :: !Pointer !Int !Int !String !*World -> *(!Int, !*World)
call ssl cmd larg parg w = code {
ccall SSL_ctrl "pIIs:I:A"
}
BIO_new_ssl_connect :: !SSLCTX !*World -> *(!BIO, *World)
BIO_new_ssl_connect ctx w = code {
ccall BIO_new_ssl_connect "p:p:A"
}
BIO_set_conn_hostname :: !BIO !String !Int !*World -> *(!Int, !*World)
BIO_set_conn_hostname bio host port w
= BIO_ctrl_string bio BIO_C_SET_CONNECT 0 (host +++ ":" +++ toString port) w
BIO_get_ssl :: !BIO !*World -> *(!Pointer, !*World)
BIO_get_ssl bio w = ctrl bio BIO_C_GET_SSL 0 w
where
ctrl :: !BIO !Int !Int !*World -> *(!Pointer, !*World)
ctrl bio cmd arg w = code {
ccall BIO_ctrl "pII:VI:A"
}
BIO_do_connect :== BIO_do_handshake
BIO_do_handshake :: !BIO !*World -> *(!Int, !*World)
BIO_do_handshake bio w = BIO_ctrl_ptr bio BIO_C_DO_STATE_MACHINE 0 0 w
BIO_ctrl_ptr :: !BIO !Int !Int !Pointer !*World -> *(!Int, !*World)
BIO_ctrl_ptr bio cmd larg parg w = code {
ccall BIO_ctrl "pIIp:I:A"
}
BIO_ctrl_string :: !BIO !Int !Int !String !*World -> *(!Int, !*World)
BIO_ctrl_string bio cmd larg parg w = call bio cmd larg (packString parg) w
where
call :: !BIO !Int !Int !String !*World -> *(!Int, !*World)
call bio cmd larg parg w = code {
ccall BIO_ctrl "pIIs:I:A"
}
BIO_puts :: !BIO !String !*World -> *World
BIO_puts bio s w = puts bio (packString s) w
where
puts :: !BIO !String !*World -> *World
puts bio s w = code {
ccall BIO_puts "ps:V:A"
}
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)
BIO_read :: !BIO !Pointer !Int !*World -> *(!Int, !*World)
BIO_read bio p n w = code {
ccall BIO_read "ppI:I:A"
}
BIO_test_flags :: !BIO !Int !*World -> *(!Bool, !*World)
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"
}
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