tcp-tls.rkt

#lang racket/base

(require racket/tcp
         openssl)

(define port 8080)
(define test.pem (collection-file-path "test.pem" "openssl"))

(define (serve .pem handle)
  (define main-cust (make-custodian))
  (parameterize ([current-custodian main-cust])
    (define ctx
      (ssl-make-server-context 'tls12
                               #:private-key (list 'pem .pem)
                               #:certificate-chain .pem))
    (define listener (ssl-listen port 5 #f #f ctx))
    (define (loop)
      (accept-and-handle listener handle)
      (loop))
    (thread loop)
    (λ ()
      (ssl-close listener)
      (custodian-shutdown-all main-cust))))


(define (accept-and-handle listener handle)
  (define cust (make-custodian))
  (custodian-limit-memory cust (* 50 1024 1024))
  (parameterize ([current-custodian cust])
    (define-values (in out) (ssl-accept listener))
    (thread (λ ()
              (handle in out)
              (flush-output out)
              (close-input-port in)
              (close-output-port out))))
  (thread (λ ()
            (sleep 10)
            (custodian-shutdown-all cust))))


(module+ test
  (require "test.rkt")

  (test-case "TCP over TLS 1.2"
    (define cctx
      (ssl-make-client-context
       'tls12
       #:private-key (list 'pem test.pem)
       #:certificate-chain test.pem))

    (define stop
      (serve test.pem
             (λ (from-client to-client)
               (write-bytes (read-bytes 3 from-client) to-client))))

    (dynamic-wind void
                  (λ ()
                    (define-values (i o) (ssl-connect "localhost" port cctx))
                    (write-bytes #"yay" o)
                    (flush-output o)
                    (close-output-port o)
                    (check-equal? (read-bytes 3 i) #"yay")
                    (close-input-port i))
                  stop)))