2d4f3e2ac9
The layer is now redundant, since everything left in "pkgs" is in the "racket-pkgs" category.
87 lines
2.9 KiB
Racket
87 lines
2.9 KiB
Racket
#lang racket
|
|
(require openssl
|
|
rackunit
|
|
racket/tcp
|
|
racket/runtime-path)
|
|
|
|
#|
|
|
"openssl s_server" prints a "Hostname in TLS extension: <hostname>"
|
|
line when the client uses SNI. BUT it only seems to print it when run
|
|
interactively (tty). (stupid openssl...)
|
|
|
|
So use "-tlsextdebug" and use small hostnames so that they're
|
|
recognizable despite the "pretty" formatting.
|
|
|#
|
|
|
|
(define-runtime-path server-key "server_key.pem")
|
|
(define-runtime-path server-crt "server_crt.pem")
|
|
(define-runtime-path server-crt2 "server_crt2.pem")
|
|
|
|
(define MSG "Hello. This is Racket speaking.\n")
|
|
|
|
;; server listens on localhost:PORT+counter
|
|
;; (need to change port, otherwise get "Address still in use")
|
|
(define PORT 4433)
|
|
(define counter 0)
|
|
|
|
(define (go hostname connect)
|
|
(set! counter (add1 counter))
|
|
;; Set up server
|
|
(define srvout (open-output-string))
|
|
(define-values (_srvout _srvin srvpid _srverr srvctl)
|
|
(apply values
|
|
(process* "/usr/bin/openssl" "s_server"
|
|
"-tlsextdebug"
|
|
"-accept" (number->string (+ PORT counter))
|
|
"-cert" server-crt "-key" server-key
|
|
"-cert2" server-crt2 "-key2" server-key "-servername" "test.com")))
|
|
(sleep 0.2) ;; wait for server to bind the port
|
|
(define buf (make-bytes #e1e4))
|
|
(define buflen (read-bytes-avail! buf _srvout))
|
|
;; (eprintf "s_server says: ~s bytes: ~s\n" buflen (subbytes buf 0 buflen))
|
|
|
|
;; Make client connection
|
|
(define-values (cin cout) (connect (+ PORT counter)))
|
|
(display MSG cout)
|
|
;; Close client connection
|
|
(close-output-port cout)
|
|
(close-input-port cin)
|
|
|
|
;; FIXME: create a read-until-silent-for-nsecs helper fun?
|
|
|
|
;; Shut down server
|
|
(sleep 0.1)
|
|
(define buflen2 (read-bytes-avail! buf _srvout))
|
|
(define stext (bytes->string/utf-8 (subbytes buf 0 buflen2)))
|
|
(srvctl 'interrupt)
|
|
(srvctl 'kill)
|
|
;; (eprintf "s_server says(2): ~s bytes: ~s\n" buflen2 stext)
|
|
|
|
;; Check server output
|
|
;; - Check for SNI extension output
|
|
(when hostname
|
|
(check-regexp-match
|
|
(string-append "TLS client extension \"server name\".*"
|
|
(regexp-quote hostname))
|
|
stext))
|
|
;; - Check for msg output (sanity check)
|
|
(check-regexp-match (regexp-quote MSG)
|
|
stext)
|
|
(void))
|
|
|
|
;; ssl-connect automatically passes along hostname (for tls, not sslv3)
|
|
(test-case "TLS ssl-connect localhost"
|
|
(go "localhost" (lambda (port) (ssl-connect "localhost" port 'tls))))
|
|
|
|
;; check alternate hostname by using ports->ssl-ports
|
|
(define ((make-connect/hostname protocol hostname) port)
|
|
(define-values (in out) (tcp-connect "localhost" port))
|
|
(ports->ssl-ports in out #:encrypt protocol #:hostname hostname))
|
|
|
|
(test-case "TLS w/ SNI, #1"
|
|
(go "test.com" (make-connect/hostname 'tls "test.com")))
|
|
(test-case "TLS w/ SNI, #2"
|
|
(go "another.org" (make-connect/hostname 'tls "another.org")))
|
|
(test-case "TLS w/o SNI"
|
|
(go #f (make-connect/hostname 'tls #f)))
|