ssl.bac
'------------------------------------------------------------------------------------------------------------
'
' This is an SSL/TLS decoder using the Public Domain TLSE library. PvE - MIT License 2018.
'
' Web address TLSE: https://github.com/eduardsui/tlse -> files needed are libtomcrypt.c, tlse.c, tlse.h and root.pem
'
'------------------------------------------------------------------------------------------------------------
'
' SSL_CONNECT("website:port")
' ==> Connect to a server and port, returns a session handle
'
' SSL_GET$(handle, path$)
' ==> Perform a GET of the path in the connection identified by handle.
'
' SSL_CMD$(handle, command$)
' ==> Perform a command in the connection identified by handle. If command$ is empty then simply flush the SSL buffer.
'
' SSL_CLOSE(handle)
' ==> Close the connection identified by handle
'
' SSL_LOAD_ROOT_PEM(handle, file$)
' ==> Load a .pem file containing latest root digital signatures for CA's - https://curl.haxx.se/ca/cacert.pem
'
' SSL_CERTIFICATE$(handle)
' ==> Obtain the certificate text from the connection identified by handle
'
' SSL_VALIDATION$(handle)
' ==> Get the certificate status from the connection identified by handle
'
' SSL_CIPHER$(handle)
' ==> Get the encryption cipher used in the connection identified by handle
'
' SSL_TIMEOUT
' ==> Global SSL variable to define timeout in connection. Default: 1000 milliseconds (1 sec)
'
' SSL_APPEND_MARK$
' ==> Global variable to define if some characters always should be added to request sent (like CRNL). Default: not set
'
' SSL_ENDING_MARK$
' ==> Global variable to determine end of received input in the SSL communication. Default: not set
'
'------------------------------------------------------------------------------------------------------------
' Undefine some conflicting BaCon names
USEH
#undef ROR
#undef ROL
#undef FF0
#undef FF1
#undef MIN
#undef MAX
#undef RND
ENDUSEH
' Include source files
PRAGMA INCLUDE tlse-master/tlse.h
PRAGMA INCLUDE tlse-master/tlse.c
PRAGMA OPTIONS -DTLS_AMALGAMATION
' Using RAM disk as a string
OPTION MEMSTREAM TRUE
' Make some functions know to BaCon
PROTO tls_sni_set, SSL_set_fd, SSL_connect, SSL_write, SSL_read, SSL_shutdown, SSL_CTX_free, SSL_CTX_set_verify, SSL_CTX_root_ca
PROTO SSL_CTX_use_certificate_file, tls_certificate_to_string
CONST SSL_Buffer_Size = 32768
DECLARE SSL_netw ASSOC int
DECLARE SSL_web$ ASSOC STRING
DECLARE SSL_cerr ASSOC int
DECLARE SSL_str$ ASSOC STRING
DECLARE SSL_current
CONST SSL_Root_Pem$ = DIRNAME$(ME$) & "/tlse-master/root.pem"
' Global variable to define if some characters always should be added to request sent (like CRNL)
DECLARE SSL_APPEND_MARK$
' Global variable to define timeout of response in network connection
DECLARE SSL_TIMEOUT = 1000
' Global variable to determine end of received input.
DECLARE SSL_ENDING_MARK$
'------------------------------------------------------------------------------------------------------------
FUNCTION SSL_verify(struct TLSContext *context, struct TLSCertificate **certificate_chain, int length)
LOCAL i, err
LOCAL certificate TYPE struct TLSCertificate*
LOCAL sni TYPE const char*
LOCAL buf[65535] TYPE unsigned char
SSL_cerr(STR$(SSL_current)) = 0
' Capture the certificate
IF certificate_chain THEN
FOR i = 0 TO length-1
certificate = certificate_chain[i]
SSL_str$(STR$(SSL_current)) = SSL_str$(STR$(SSL_current)) & tls_certificate_to_string(certificate, buf, 65535)
NEXT
ENDIF
' Check validity date
IF certificate_chain THEN
FOR i = 0 TO length-1
certificate = certificate_chain[i]
err = tls_certificate_is_valid(certificate)
IF err THEN
SSL_cerr(STR$(SSL_current)) = 1
RETURN no_error
ENDIF
NEXT
ENDIF
' Check if chain is valid
err = tls_certificate_chain_is_valid(certificate_chain, length)
IF err THEN
SSL_cerr(STR$(SSL_current)) = 2
RETURN no_error
ENDIF
' Domain name check
sni = tls_sni(context)
IF length > 0 AND sni <> NULL THEN
err = tls_certificate_valid_subject(certificate_chain[0], sni)
IF err THEN
SSL_cerr(STR$(SSL_current)) = 3
RETURN no_error
ENDIF
ENDIF
' Perform validation agains ROOT CA
err = tls_certificate_chain_is_valid_root(context, certificate_chain, length)
IF err THEN
SSL_cerr(STR$(SSL_current)) = 4
RETURN no_error
ENDIF
RETURN no_error
ENDFUNCTION
'------------------------------------------------------------------------------------------------------------
FUNCTION SSL_CIPHER$(session)
LOCAL result$
PRINT tls_cipher_name((SSL*)session) FORMAT "%s" TO result$
RETURN result$
ENDFUNCTION
'------------------------------------------------------------------------------------------------------------
FUNCTION SSL_CERTIFICATE$(session)
RETURN SSL_str$(STR$(session))
ENDFUNCTION
'------------------------------------------------------------------------------------------------------------
FUNCTION SSL_VALIDATION$(session)
LOCAL stat$
SELECT SSL_cerr(STR$(session))
CASE 0
stat$ = "Ok"
CASE 1
stat$ = "Certificate is expired or not yet valid"
CASE 2
stat$ = "Certificate is expired or not yet valid"
CASE 3
stat$ = "Certificate does not match domain name"
CASE 4
stat$ = "Certificate contains invalid signature"
ENDSELECT
RETURN stat$
ENDFUNCTION
'------------------------------------------------------------------------------------------------------------
SUB SSL_LOAD_ROOT_PEM(session, file$)
IF NOT(FILEEXISTS(file$)) THEN
PRINT "File '", file$, "' does not exist! Exiting..."
END 1
ENDIF
SSL_CTX_use_certificate_file((SSL*)session, file$, 0)
END SUB
'------------------------------------------------------------------------------------------------------------
FUNCTION SSL_CONNECT(STRING website$)
LOCAL session
LOCAL mynet TYPE int
' Create SSL context object
session = SSL_CTX_new(SSLv3_client_method())
SSL_current = session
SSL_CTX_root_ca((SSL*)session, SSL_Root_Pem$)
SSL_CTX_set_verify((SSL*)session, SSL_VERIFY_PEER, (tls_validation_function)SSL_verify)
' Set SNI
tls_sni_set((SSL*)session, TOKEN$(website$, 1, ":"))
' Connect to website creating a socket
OPEN website$ FOR NETWORK AS mynet
SSL_netw(STR$(session)) = mynet
SSL_web$(STR$(session)) = website$
' Perform the SSL handshake using the socket
SSL_set_fd((SSL*)session, mynet)
IF SSL_connect((SSL*)session) <> 1 THEN
EPRINT "Handshake error!"
END 1
ENDIF
RETURN session
ENDFUNCTION
'------------------------------------------------------------------------------------------------------------
FUNCTION SSL_GET$(session, path$)
LOCAL mem
LOCAL buf$, total$, req$
LOCAL mynet TYPE int
mynet = SSL_netw(STR$(session))
' Request to send to remote webserver (CONST is a macro def)
req$ = "GET " & path$ & " HTTP/1.1\r\nHost: " & SSL_web$(STR$(session)) & "\r\nConnection: close\r\n\r\n"
IF SSL_write((SSL*)session, req$, LEN(req$)) < 0 THEN
EPRINT "SSL Write error!"
END 1
ENDIF
' Setup buffer for the data coming back
mem = MEMORY(SSL_Buffer_Size)
OPEN mem FOR MEMORY AS buf$
' Send the GET request to the remote server
WHILE WAIT(mynet, SSL_TIMEOUT)
' Fetch the response into the buffer
IF SSL_read((SSL*)session, buf$, SSL_Buffer_Size) > 0 THEN
total$ = total$ & buf$
POKE mem, 0 SIZE SSL_Buffer_Size
ELSE
BREAK
ENDIF
WEND
' Close handle and free memory
CLOSE MEMORY buf$
FREE mem
RETURN total$
ENDFUNCTION
'------------------------------------------------------------------------------------------------------------
FUNCTION SSL_CMD$(session, req$)
LOCAL mem
LOCAL buf$, total$
LOCAL mynet TYPE int
mynet = SSL_netw(STR$(session))
' If there is a command write it to the SSL tunnel
IF LEN(req$) THEN
' Add CRNL if required
IF LEN(SSL_APPEND_MARK$) THEN req$ = req$ & SSL_APPEND_MARK$
IF SSL_write((SSL*)session, req$, LEN(req$)) < 0 THEN
EPRINT "SSL Write error!"
END 1
ENDIF
ENDIF
' Setup buffer for the data coming back
mem = MEMORY(SSL_Buffer_Size)
OPEN mem FOR MEMORY AS buf$
' Send the GET request to the remote server
WHILE WAIT(mynet, SSL_TIMEOUT)
' Fetch the response into the buffer
IF SSL_read((SSL*)session, buf$, SSL_Buffer_Size) > 0 THEN
' Construct reply
total$ = total$ & buf$
' If there is an endmark, check if reached, if so, bail out
IF LEN(SSL_ENDING_MARK$) THEN
IF REGEX(total$, SSL_ENDING_MARK$ & "$") THEN BREAK
ENDIF
' Cleanup buffer
POKE mem, 0 SIZE SSL_Buffer_Size
ELSE
BREAK
ENDIF
WEND
' Close handle and free memory
CLOSE MEMORY buf$
FREE mem
RETURN total$
END FUNCTION
'------------------------------------------------------------------------------------------------------------
SUB SSL_CLOSE(session)
LOCAL mynet TYPE int
SSL_shutdown((SSL*)session)
mynet = SSL_netw(STR$(session))
CLOSE NETWORK mynet
' Bring down TLS
SSL_CTX_free((SSL*)session)
ENDSUB
'------------------------------------------------------------------------------------------------------------
Generated by GNU Enscript 1.6.5.90.