mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

web: Continue handshake upon TLS warning alerts.

Browse source 
This is a backport of Guix commit 7b9ac883ea62a816afbfa747c1377dc273c15c20.

* module/web/client.scm (tls-wrap): Catch 'gnutls-error' around
'handshake'.  Upon ERROR/WARNING-ALERT-RECEIVED, print a message and
call 'handshake'.
This commit is contained in:
Ludovic Courtès 2020-01-10 12:11:45 +01:00
parent 80bbebef4d
commit bcba213284
1 changed files with 16 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/web/client.scm
View file

@ -125,7 +125,22 @@ host name without trailing dot."
;;(set-log-level! 10) ;;(set-log-level! 10)
;;(set-log-procedure! log) ;;(set-log-procedure! log)
(handshake session) (catch 'gnutls-error
(lambda ()
(handshake session))
(lambda (key err proc . rest)
(cond ((eq? err error/warning-alert-received)
;; Like Wget, do no stop upon non-fatal alerts such as
;; 'alert-description/unrecognized-name'.
(format (current-error-port)
"warning: TLS warning alert received: ~a~%"
(alert-description->string (alert-get session)))
(handshake session))
(else
;; XXX: We'd use 'gnutls_error_is_fatal' but (gnutls) doesn't
;; provide a binding for this.
(apply throw key err proc rest)))))
;; FIXME: It appears that session-record-port is entirely ;; FIXME: It appears that session-record-port is entirely
;; sufficient; it's already a port. The only value of this code is ;; sufficient; it's already a port. The only value of this code is
;; to keep a reference on "port", to keep it alive! To fix this we ;; to keep a reference on "port", to keep it alive! To fix this we