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.