1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

web: Adjust (gnutls) loading to new module autoload semantics.

Prior to commit cb14fd2143 (Guile 2.9.7),
autoloading a module would give you access to all its bindings.  In
future versions, autoloading a module gives access only to the listed
bindings, as per #:select (see <https://bugs.gnu.org/38895>).

This commit adjusts autoloads to the new semantics, fixing a regression
introduced in cb14fd2143.

* module/web/client.scm <top level>: Remove 'module-autoload!' call.
(gnutls-module, ensure-gnutls): Remove.
(load-gnutls): New procedure.
(tls-wrap): Call it instead of 'ensure-gnutls'.  Replace reference to
GNUTLS-MODULE by a call to 'resolve-interface'.
This commit is contained in:
Ludovic Courtès 2020-01-10 10:40:02 +01:00
parent 287d513ef1
commit c9b83a27c7

View file

@ -1,6 +1,6 @@
;;; Web client ;;; Web client
;; Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Free Software Foundation, Inc. ;; Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -62,32 +62,21 @@
;; Autoload GnuTLS so that this module can be used even when GnuTLS is ;; Autoload GnuTLS so that this module can be used even when GnuTLS is
;; not available. At compile time, this yields "possibly unbound ;; not available. At compile time, this yields "possibly unbound
;; variable" warnings, but these are OK: we know that the variables will ;; variable" warnings, but these are OK: they'll be resolved at run time
;; be bound if we need them, because (guix download) adds GnuTLS as an ;; thanks to 'load-gnutls'.
;; input in that case.
;; XXX: Use this hack instead of #:autoload to avoid compilation errors. (define (load-gnutls)
;; See <http://bugs.gnu.org/12202>. "Attempt to load the (gnutls) module. Throw to 'gnutls-not-available
(module-autoload! (current-module) if it is unavailable."
'(gnutls) '(make-session connection-end/client))
(define gnutls-module
(delay
(catch 'misc-error (catch 'misc-error
(lambda () (lambda ()
(let ((module (resolve-interface '(gnutls)))) ;; XXX: Use this hack instead of #:autoload to avoid compilation
;; In some 2.1/2.2 installations installed alongside Guile 2.0, gnutls ;; errors. See <http://bugs.gnu.org/12202>.
;; can be imported but the bindings are broken as "unknown type". (module-use! (resolve-module '(web client))
;; Here we check that gnutls-version is the right type (a procedure) (resolve-interface '(gnutls))))
;; to make sure the bindings are ok. (lambda _
(if (procedure? (module-ref module 'gnutls-version))
module
#f)))
(const #f))))
(define (ensure-gnutls)
(if (not (force gnutls-module))
(throw 'gnutls-not-available "(gnutls) module not available"))) (throw 'gnutls-not-available "(gnutls) module not available")))
(set! load-gnutls (const #t)))
(define current-http-proxy (define current-http-proxy
(make-parameter (let ((proxy (getenv "http_proxy"))) (make-parameter (let ((proxy (getenv "http_proxy")))
@ -101,14 +90,14 @@ host name without trailing dot."
(format (current-error-port) (format (current-error-port)
"gnutls: [~a|~a] ~a" (getpid) level str)) "gnutls: [~a|~a] ~a" (getpid) level str))
(ensure-gnutls) (load-gnutls)
(let ((session (make-session connection-end/client))) (let ((session (make-session connection-end/client)))
;; Some servers such as 'cloud.github.com' require the client to support ;; Some servers such as 'cloud.github.com' require the client to support
;; the 'SERVER NAME' extension. However, 'set-session-server-name!' is ;; the 'SERVER NAME' extension. However, 'set-session-server-name!' is
;; not available in older GnuTLS releases. See ;; not available in older GnuTLS releases. See
;; <http://bugs.gnu.org/18526> for details. ;; <http://bugs.gnu.org/18526> for details.
(if (module-defined? (force gnutls-module) (if (module-defined? (resolve-interface '(gnutls))
'set-session-server-name!) 'set-session-server-name!)
(set-session-server-name! session server-name-type/dns server) (set-session-server-name! session server-name-type/dns server)
(format (current-error-port) (format (current-error-port)