;; If you hacking on this you best read the spec ;; https://datatracker.ietf.org/doc/html/rfc5246 (define versions '((tls-1.0 . #u8(3 1)) (tls-1.2 . #u8(3 3)))) (define cipher-suites ;; First is the default '((TLS_RSA_WITH_AES_256_CBC_SHA . #u8(0 #x35)))) (define (make-tls-record version content-type fragment-bytes) (let ((length-bytes (bytevector 0 0))) (bytevector-uint-set! length-bytes 0 (bytevector-length fragment-bytes) 'big 2) (bytevector-append (bytevector (cdr (assoc content-type content-types))) (cdr (assoc version versions)) length-bytes fragment-bytes))) (define (make-client-hello version random-bytes session-id cipher-suites) ;; https://datatracker.ietf.org/doc/html/rfc5246#section-7.4.1.2 (let* ((cipher-suites-length-bytes (integer->bytevector (bytevector-length cipher-suites) 'big 2)) (content-bytes (bytevector-append (cdr (assoc version versions)) random-bytes session-id cipher-suites-length-bytes cipher-suites (bytevector 1 0) (bytevector 0 0))) (content-length-bytes (let ((bytes (bytevector 0 0 0))) (bytevector-uint-set! bytes 0 (bytevector-length content-bytes) 'big 3) bytes))) ;; https://tls12.xargs.org/#client-hello ;; Interestingly the version is 3.1 (TLS 1.0) instead of the expected "3,3" ;; (TLS 1.2). Looking through the golang crypto/tls library we find the following comment: ;; // Some TLS servers fail if the record version is ;; // greater than TLS 1.0 for the initial ClientHello. (make-tls-record 'tls-1.0 'handshake (bytevector-append (bytevector (cdr (assoc 'client_hello handshake-types))) content-length-bytes content-bytes)))) (define (read-tls-record receiver) (let* ((type-byte (receiver 1)) (type (cdr (assoc (bytevector-u8-ref type-byte 0) types-content))) (version (receiver 2)) (len-bytes (receiver 2)) (len (bytevector-uint-ref len-bytes 0 'big 2)) (bytes (receiver len))) (display "HERE: type-byte ") (write type-byte) (newline) (display "HERE: type ") (write type) (newline) (display "HERE: version ") (write version) (newline) (display "HERE: len-bytes ") (write len-bytes) (newline) (display "HERE: len ") (write len) (newline) ;(display "HERE: bytes ") ;(write bytes) ;(newline) (cond ;; https://datatracker.ietf.org/doc/html/rfc5246#section-7.2 ((equal? type 'alert) (if (= (bytevector-u8-ref bytes 0) 2) ;; Fatal (error "TLS Alert: " (cdr (assoc (bytevector-u8-ref bytes 1) types-alert))) (warn (cdr (assoc (bytevector-u8-ref bytes 1) types-alert))))) ((equal? type 'handshake) (let ((type (cdr (assoc (bytevector-u8-ref bytes 0) types-handshake)))) (cond ;; https://datatracker.ietf.org/doc/html/rfc5246#section-7.4.1.3 ((equal? type 'server_hello) (let ((session-id-length (bytevector-u8-ref bytes 38))) `(server_hello (type . ,(bytevector-copy bytes 0 1)) (size . ,(bytevector-uint-ref bytes 1 'big 3)) (version . ,(bytevector-copy bytes 4 6)) (server-random . ,(bytevector-copy bytes 6 38)) (session-id-length ,session-id-length) (session-id . ,(if (= session-id-length 0) (bytevector) (bytevector-copy bytes 39 (+ 39 session-id-length)))) (cipher-suite . ,(bytevector-copy bytes (+ 39 session-id-length) (+ 39 session-id-length 2))) (compression . ,(bytevector-copy bytes (+ 39 session-id-length 2) (+ 39 session-id-length 3)))))) ;; https://datatracker.ietf.org/doc/html/rfc5246#section-7.4.2 ;; https://tls12.xargs.org/certificate.html#server-certificate-detail/annotated ((equal? type 'certificate) (let* ((one 1) (ASN.1-length1 (bytevector-u8-ref bytes 11)) (ASN.1-length2 (bytevector-u8-ref bytes (+ 14 ASN.1-length1))) (certificate-length (bytevector-uint-ref bytes 7 'big 3)) ) `(certificate (handshake-message-len . ,(bytevector-copy bytes 1 4)) (handshake-message-len . ,(bytevector-uint-ref bytes 1 'big 3)) (certificates-len . ,(bytevector-copy bytes 4 7)) (certificates-len . ,(bytevector-uint-ref bytes 4 'big 3)) (certificate-len . ,(bytevector-copy bytes 7 10)) (certificate-len . ,(bytevector-uint-ref bytes 7 'big 3)) (certificate ,(read-certificates bytes 10)) #;(test ,(bytevector-copy bytes 10 64 )) ;(certificate-length . ,(bytevector-copy bytes 7 10)) ;(certificate-length . ,(bytevector-uint-ref bytes 7 'big 3)) ;(certificates-sequence-tag . ,(bytevector-u8-ref bytes 10)) ;(certificates-sequence-len . ,(bytevector-uint-ref bytes 11 'big 3)) ;(certificates ,(read-certificates bytes 10 (bytevector-length bytes) '())) #;(test ,(bytevector-copy bytes (+ 10 2 130 2 21) (+ 10 2 130 2 21 512) )) ;(ASN.1-tag1 . ,(bytevector-u8-ref bytes 10)) ;(ASN.1-length1 . ,(bytevector-u8-ref bytes 11)) ;(ASN.1-length . ,(bytevector-uint-ref bytes 11 'big 3)) ;(ASN.1-length2 . ,ASN.1-length2) ;(certificate-bytes1 . ,(bytevector-copy bytes 12 (+ 12 ASN.1-length1 1))) #;(certificate-bytes2 . ,(bytevector-copy bytes (+ 12 ASN.1-length1 1) (+ 12 ASN.1-length1 1 ASN.1-length2))) #;(test . ,(bytevector-copy bytes (+ 12 ASN.1-length1 1 ASN.1-length2) (+ 12 ASN.1-length1 1 ASN.1-length2 64))) ;(bytes-len ,(bytevector-length bytes)) #;(certificates . ,(read-certificates bytes 10 (bytevector-length bytes) '())) ;(version . ,(bytevector-u8-ref bytes 4)) ;; https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.2 ;(serial-number . ,(bytevector-u8-ref bytes 5)) ;; https://datatracker.ietf.org/doc/html/rfc5280#section-4.1.2.3 ;(signature . ,(bytevector-u8-ref bytes 6)) )) ))))))) (define (tls-client-handshake sender receiver . options) (let* ((version 'tls-1.2) ;; Default, and currently only one ;; No unix time as first four bytes of random-bytes ;; https://datatracker.ietf.org/doc/html/draft-mathewson-no-gmtunixtime-00 (random-bytes (get-random-bytes 32)) (session-id (bytevector 0)) (client-hello (make-client-hello version random-bytes session-id (cdr (car cipher-suites))))) (display "HERE: client-hello ") (write client-hello) (newline) (sender client-hello) (let ((server-hello (read-tls-record receiver))) (when (not (equal? (car server-hello) 'server_hello)) (error "tls error: Unexpected response from server, expected server_hello" server-hello)) (let ((server-version-bytes (cdr (assoc 'version (cdr server-hello)))) (client-version-bytes (cdr (assoc version versions)))) (when (not (equal? client-version-bytes server-version-bytes)) (error "tls error: Client server version mismatch" client-version-bytes server-version-bytes)) (write server-hello) (newline) (let ((certificate (read-tls-record receiver))) (write certificate) (newline) )))))