suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

openssl: fix test comment, use different listener port

Browse Source
This commit is contained in:
Ryan Culpepper 2019-07-15 09:15:39 +02:00
parent fa155727df
commit 228c3132ca
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/racket-test/tests/openssl/peer-verif2.rkt
View File

@ -4,6 +4,8 @@
racket/tcp racket/tcp
racket/runtime-path) racket/runtime-path)
(define PORT 55001)
(define (check fmt got expect) (define (check fmt got expect)
(unless (equal? got expect) (unless (equal? got expect)
(error 'check fmt got))) (error 'check fmt got)))
@ -36,14 +38,14 @@
(call/custodian (call/custodian
(lambda () (lambda ()
(define chan (make-channel)) (define chan (make-channel))
(define listener (ssl-listen 55000 4 #t "localhost" server-ctx)) (define listener (ssl-listen PORT 4 #t "localhost" server-ctx))
(thread (lambda () (thread (lambda ()
(ssl-try-verify! listener #t) (ssl-try-verify! listener #t)
(define-values (in out) (ssl-accept listener)) (define-values (in out) (ssl-accept listener))
(channel-put chan (and (ssl-peer-verified? in) (ssl-peer-subject-name in))))) (channel-put chan (and (ssl-peer-verified? in) (ssl-peer-subject-name in)))))
;; Use ports->ssl-ports instead of ssl-connect so we can supply a fake hostname. ;; Use ports->ssl-ports instead of ssl-connect so we can supply a fake hostname.
;; (ssl-connect "localhost" 55000 client-ctx) ;; (ssl-connect "localhost" PORT client-ctx)
(define-values (in out) (tcp-connect "localhost" 55000)) (define-values (in out) (tcp-connect "localhost" PORT))
(if (symbol? client-ctx) (if (symbol? client-ctx)
(ports->ssl-ports in out #:mode 'connect #:encrypt client-ctx #:hostname server-hostname) (ports->ssl-ports in out #:mode 'connect #:encrypt client-ctx #:hostname server-hostname)
(ports->ssl-ports in out #:mode 'connect #:context client-ctx #:hostname server-hostname)) (ports->ssl-ports in out #:mode 'connect #:context client-ctx #:hostname server-hostname))
@ -56,7 +58,7 @@
(ssl-load-certificate-chain! ctx server-crt) (ssl-load-certificate-chain! ctx server-crt)
(ssl-load-private-key! ctx server-key #f #f) (ssl-load-private-key! ctx server-key #f #f)
ctx)) ctx))
;; Set ;; Set roots for server-verifying-client
(parameterize ((ssl-default-verify-sources (list cacert))) (parameterize ((ssl-default-verify-sources (list cacert)))
(ssl-load-default-verify-sources! server-ctx1) (ssl-load-default-verify-sources! server-ctx1)
(ssl-load-default-verify-sources! server-ctx2)) (ssl-load-default-verify-sources! server-ctx2))