tests for SSL server-side SNI

thanks to Jay Kominek

pkgs/racket-pkgs/racket-test/tests/openssl/sni-test2.pem

@@ -0,0 +1,31 @@
+-----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-----

pkgs/racket-pkgs/racket-test/tests/openssl/test-server-sni.rkt

@@ -0,0 +1,49 @@
+#lang racket
+(require openssl
+         rackunit
+         racket/runtime-path)
+
+(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-runtime-path test-pem '(lib "openssl/test.pem"))
+(define-runtime-path test2-pem "sni-test2.pem")
+
+(define lambda-sctx (make-sctx test-pem))
+(define theultimate-sctx (make-sctx 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))
+(void
+ (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 "testing ~a: ~a~n" name (ssl-peer-certificate-hostnames ssl-in))
+    (list (ssl-peer-certificate-hostnames ssl-in)
+          (ssl-peer-check-hostname ssl-in name))))
+
+(check-equal? (test-name "theultimate") '(("theultimate") #t))
+(check-equal? (test-name "spacebadger") '(("lambda") #f))
+(check-equal? (test-name "lambda")      '(("lambda") #t))
+(check-equal? (test-name "spacebadger") '(("lambda") #f))