openssl: adjust peer-verif test for renegotiation
TLS v1.3 does not support renegotiation.
This commit is contained in:
parent
83fb6d2ca8
commit
197d6db634
|
@ -15,6 +15,13 @@
|
||||||
(define-runtime-path client-crt "client_crt.pem")
|
(define-runtime-path client-crt "client_crt.pem")
|
||||||
(define-runtime-path cacert "cacert.pem")
|
(define-runtime-path cacert "cacert.pem")
|
||||||
|
|
||||||
|
;; TLS v1.3 does not allow renegotiation, so use v1.2 for testing if
|
||||||
|
;; available, otherwise skip renegotiation
|
||||||
|
(define can-tls12? (memq 'tls12 (supported-client-protocols)))
|
||||||
|
(printf (if can-tls12?
|
||||||
|
"Using TLS v1.2\n"
|
||||||
|
"Skipping renegotiation tests\n"))
|
||||||
|
|
||||||
(define (go valid?
|
(define (go valid?
|
||||||
#:later [later-mode #f]
|
#:later [later-mode #f]
|
||||||
#:early [early-mode (and (not later-mode) 'try)]
|
#:early [early-mode (and (not later-mode) 'try)]
|
||||||
|
@ -83,13 +90,13 @@
|
||||||
(close-input-port in)
|
(close-input-port in)
|
||||||
(close-output-port out))))))
|
(close-output-port out))))))
|
||||||
|
|
||||||
|
(define ssl-client-context (ssl-make-client-context (if can-tls12?
|
||||||
(define ssl-client-context (ssl-make-client-context))
|
'tls12
|
||||||
|
'auto)))
|
||||||
|
|
||||||
(ssl-load-private-key! ssl-client-context client-key)
|
(ssl-load-private-key! ssl-client-context client-key)
|
||||||
|
|
||||||
;;connection will still proceed if these methods aren't called
|
;; connection will still proceed if these functions aren't called
|
||||||
;;change to #f to try it
|
|
||||||
(when valid?
|
(when valid?
|
||||||
(ssl-load-certificate-chain! ssl-client-context client-crt)
|
(ssl-load-certificate-chain! ssl-client-context client-crt)
|
||||||
(ssl-load-verify-root-certificates! ssl-client-context cacert)
|
(ssl-load-verify-root-certificates! ssl-client-context cacert)
|
||||||
|
@ -120,9 +127,11 @@
|
||||||
(go #t)
|
(go #t)
|
||||||
(go #t #:early 'req)
|
(go #t #:early 'req)
|
||||||
(go #f)
|
(go #f)
|
||||||
(go #t #:later 'try)
|
(when can-tls12?
|
||||||
|
(go #t #:later 'try))
|
||||||
(go #f #:later 'try)
|
(go #f #:later 'try)
|
||||||
(go #t #:later 'req)
|
(when can-tls12?
|
||||||
|
(go #t #:later 'req))
|
||||||
|
|
||||||
(define (check-fail thunk)
|
(define (check-fail thunk)
|
||||||
(define s
|
(define s
|
||||||
|
|
Loading…
Reference in New Issue
Block a user