test for TLS SNI in racket

ssl-sni-test.rkt

#lang racket

(require openssl)

(define (make-sctx pem)
  (define sctx (ssl-make-server-context 'tls))
  (ssl-load-default-verify-sources! sctx)
  (ssl-set-ciphers! sctx "DEFAULT:!aNULL:!eNULL:!LOW:!EXPORT:!SSLv2")
  (ssl-load-certificate-chain! sctx pem)
  (ssl-load-private-key! sctx pem)
  sctx)

(define lambda-sctx
  (make-sctx "test.pem")) ; racket test.pem
(define theultimate-sctx
  (make-sctx "test2.pem")) ; attached racket-esque test2.pem
(define (callback name)
  (cond [(equal? name "lambda") lambda-sctx]
        [(equal? name "theultimate") theultimate-sctx]
	[else #f]))
(ssl-set-server-name-identification-callback! lambda-sctx callback)
(ssl-set-server-name-identification-callback! theultimate-sctx callback)
(ssl-seal-context! lambda-sctx)
(ssl-seal-context! theultimate-sctx)
(define listener
  (ssl-listen 4433 5 #t #f lambda-sctx))
(thread (lambda ()
  (for ([x (in-naturals)])
    (ssl-accept listener))))

(define (test-name name)
  (let*-values ([(in out) (tcp-connect "localhost" 4433)]
		[(ssl-in ssl-out)
                 (ports->ssl-ports in out
                                   #:encrypt 'tls
                                   #:hostname name)])
    (printf "~a: ~a~n" name (ssl-peer-certificate-hostnames ssl-in))
    (ssl-peer-check-hostname ssl-in name)))

(test-name "theultimate")
(test-name "spacebadger")
(test-name "lambda")
(test-name "spacebadger")

; expected output:
; #<thread:...ssl-sni-test.rkt:27:8>
; theultimate: (theultimate)
; #t
; spacebadger: (lambda)
; #f
; lambda: (lambda)
; #t
; spacebadger: (lambda)
; #f

test2.pem

-----BEGIN RSA PRIVATE KEY-----
MIICXQIBAAKBgQDqRO6P6aKD530N5P9Pr9FWqqT8JoEWlmgxbLnlWxbkJk6XzXCG
Mvm+RS8Dcb4qsDglUncpAOE/2TW41e/Rc/aekFSo2vVpNv4/AmY8RWH80YhAwyPl
+aYLt/dyxJT1tB1fmRYHQIM3/D1aSF1XyMudN7XjANMwEVYC50+Q/uLE1wIDAQAB
AoGBAMB/+/fNZ3kz0pKERTbZpg6tEf0QNqq01NEoImjQvLKkt5gNfBUJ9iXe+468
/CJfwwMIDFppGq44ceh8Ax/9Rfvaz7yD0GWvR1t1aWt3ytGmz1P7WfxRSnU5NVOJ
Na9y7YtrHDIKohxhbMhknAuYrisQShRbCR+O3huG4HZEgECBAkEA+uj98LN9iQU1
oSNKkHz56eMygEQCKARoAHdxxGCRsNs8Vm44gtcPRMxR6Qf5ylYXcmouGUjpvgNJ
CZ8/6Brp0QJBAO8FhZcx/3TxDmpO+f3OeLvKlAUCWMi4GnexOvwXclQCuvWlcbmG
x7QvNn8RSs3nunMlKPeZ0RQb7qWrnVW6RicCQFUsWF+oHnov6YecukgYFKH/vPnr
nCvHayKVaWo3Od2mXnIcklRf+s/o5/lJ+tJjrSvqvWFZ7fbRmK6Kf6Aj2rECQQCy
+a6DfVOsjAfgQIzeqKks7M6TRaOXgIuJDnN9ak0YbQbzg1O5uRt2Z1fmI9ugfKDX
MX8Qj+PHq/axpORl2dpHAkAmqLWbi+GIGWczNh/8JoLbKdm8JWphkkkaDsUeNjIo
HHucKaRUUFTrHqjvHP8MdokEEZVlzgpmk4KtDDnqhBEV
-----END RSA PRIVATE KEY-----
-----BEGIN CERTIFICATE-----
MIICgzCCAewCCQDTC6QhKBun7TANBgkqhkiG9w0BAQsFADCBhTELMAkGA1UEBhMC
VVMxDTALBgNVBAgMBFV0YWgxFzAVBgNVBAcMDlNhbHQgTGFrZSBDaXR5MRIwEAYD
VQQKDAlQTFQsIEluYy4xFDASBgNVBAMMC3RoZXVsdGltYXRlMSQwIgYJKoZIhvcN
AQkBFhVtZmxhdHRAcGx0LXNjaGVtZS5vcmcwHhcNMTQwNTEyMDEyNTA1WhcNMjIw
NjI2MDEyNTA1WjCBhTELMAkGA1UEBhMCVVMxDTALBgNVBAgMBFV0YWgxFzAVBgNV
BAcMDlNhbHQgTGFrZSBDaXR5MRIwEAYDVQQKDAlQTFQsIEluYy4xFDASBgNVBAMM
C3RoZXVsdGltYXRlMSQwIgYJKoZIhvcNAQkBFhVtZmxhdHRAcGx0LXNjaGVtZS5v
cmcwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBAOpE7o/pooPnfQ3k/0+v0Vaq
pPwmgRaWaDFsueVbFuQmTpfNcIYy+b5FLwNxviqwOCVSdykA4T/ZNbjV79Fz9p6Q
VKja9Wk2/j8CZjxFYfzRiEDDI+X5pgu393LElPW0HV+ZFgdAgzf8PVpIXVfIy503
teMA0zARVgLnT5D+4sTXAgMBAAEwDQYJKoZIhvcNAQELBQADgYEASOFJ/upbYS+E
2Y8bQ1w5URKbjb7zGKRjHL4Luis+oeh5Qr68dCaBQzfqnvgkG/0kteIhnGWlRhWk
Ar5ioWbD7Ifxrt+pSwg+vbZhHoCtLqgWKck94H+UAXG77PCsQu1cNmnqKio+0Xzd
SxaXsHb/O0mZnfxAVeS6SJyhGs60Yj0=
-----END CERTIFICATE-----