[Guile-commits] 01/04: web: Adjust (gnutls) loading to new module autoload semantics.

[Ludovic Courtès]

civodul pushed a commit to branch wip-https-client
in repository guile.

commit 55924a5ec73805b8887df69720f8309aa72c0400
Author: Ludovic Courtès <address@hidden>
AuthorDate: Fri Jan 10 10:40:02 2020 +0100

    web: Adjust (gnutls) loading to new module autoload semantics.
    
    Prior to commit cb14fd214365e50b6b1655616ae74d0228933bbd (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 cb14fd214365e50b6b1655616ae74d0228933bbd.
    
    * 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'.
---
 module/web/client.scm | 45 +++++++++++++++++----------------------------
 1 file changed, 17 insertions(+), 28 deletions(-)

diff --git a/module/web/client.scm b/module/web/client.scm
index 75719e1..874b04d 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
 ;;; 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
 ;; 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
 ;; not available.  At compile time, this yields "possibly unbound
-;; variable" warnings, but these are OK: we know that the variables will
-;; be bound if we need them, because (guix download) adds GnuTLS as an
-;; input in that case.
-
-;; XXX: Use this hack instead of #:autoload to avoid compilation errors.
-;; See <http://bugs.gnu.org/12202>.
-(module-autoload! (current-module)
-                  '(gnutls) '(make-session connection-end/client))
-
-(define gnutls-module
-  (delay
-    (catch 'misc-error
-      (lambda ()
-        (let ((module (resolve-interface '(gnutls))))
-          ;; In some 2.1/2.2 installations installed alongside Guile 2.0, 
gnutls
-          ;; can be imported but the bindings are broken as "unknown type".
-          ;; Here we check that gnutls-version is the right type (a procedure)
-          ;; to make sure the bindings are ok.
-          (if (procedure? (module-ref module 'gnutls-version))
-              module
-              #f)))
-      (const #f))))
-
-(define (ensure-gnutls)
-  (if (not (force gnutls-module))
+;; variable" warnings, but these are OK: they'll be resolved at run time
+;; thanks to 'load-gnutls'.
+
+(define (load-gnutls)
+  "Attempt to load the (gnutls) module.  Throw to 'gnutls-not-available
+if it is unavailable."
+  (catch 'misc-error
+    (lambda ()
+      ;; XXX: Use this hack instead of #:autoload to avoid compilation
+      ;; errors.  See <http://bugs.gnu.org/12202>.
+      (module-use! (resolve-module '(web client))
+                   (resolve-interface '(gnutls))))
+    (lambda _
       (throw 'gnutls-not-available "(gnutls) module not available")))
+  (set! load-gnutls (const #t)))
 
 (define current-http-proxy
   (make-parameter (let ((proxy (getenv "http_proxy")))
@@ -101,14 +90,14 @@ host name without trailing dot."
     (format (current-error-port)
             "gnutls: [~a|~a] ~a" (getpid) level str))
 
-  (ensure-gnutls)
+  (load-gnutls)
 
   (let ((session (make-session connection-end/client)))
     ;; Some servers such as 'cloud.github.com' require the client to support
     ;; the 'SERVER NAME' extension.  However, 'set-session-server-name!' is
     ;; not available in older GnuTLS releases.  See
     ;; <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! session server-name-type/dns server)
         (format (current-error-port)