Re: Adding https support

[Ludovic Courtès]

Christopher Allan Webber  skribis:

> There are remaining issues:
>  - The tls file descriptor leak bug from Guix has been carried over here
>http://debbugs.gnu.org/cgi/bugreport.cgi?bug=20145
>but I don't really know enough to know what I'm supposed to fix.
>Pointers?

Here we use ‘set-session-transport-fd!’ to give GnuTLS the underlying
file descriptor, which avoids crossing the Scheme/C layer, and so is
better performance-wise.

The problem with that is that ‘tls-wrap’ then “loses” the file
descriptor: Closing the session port it returns does not close the
underlying file descriptor.

To fix that, I think we have to go heavyweight and use custom binary
ports.  But!  I just realized that we’re not providing
‘make-custom-binary-input/output-port’, which is what we need here.  So
we first need to add this to libguile.  I can work on it, but no ETA.

>  - open-socket-for-uri and open-connection-for-uri should be merged
>together.

Right.

>  - needs a better commit message, I'll get to it!
>  - I probably need to sign papers... I've signed them for other GNU
>projects but I think I haven't signed any kind of across-the-board
>GNU copyright assignment thing.

I’ll email it off-line.

To summarize, there’s a bit more work to be done before we can add
that.  Sorry for disappointing!

Thanks,
Ludo’.

Adding https support

[Christopher Allan Webber]

Hello!

So, Guile currently lacks https support, which I think is... strange in
the present day!  I've currently hit a limit with what I can do in
implementing federation tools using Guile without https support.
Luckily, I was pointed to Guix's guix/build/download.scm containing
https support.  Ludovic said he'd be fine with having his
https-supporting code in Guile core and under the LGPL, and I offered to
port it.  The good news: I have it working locally separated from Guix.
Attached is a patch with the current state of things.  It isn't done
though!

There are remaining issues:
 - The tls file descriptor leak bug from Guix has been carried over here
   http://debbugs.gnu.org/cgi/bugreport.cgi?bug=20145
   but I don't really know enough to know what I'm supposed to fix.
   Pointers?
 - open-socket-for-uri and open-connection-for-uri should be merged
   together.
 - needs a better commit message, I'll get to it!
 - I probably need to sign papers... I've signed them for other GNU
   projects but I think I haven't signed any kind of across-the-board
   GNU copyright assignment thing.

Thoughts?
 - Chris

>From 5df084b42bf6633af8107d6c994f7171afb04a84 Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber 
Date: Thu, 17 Sep 2015 15:14:54 -0500
Subject: [PATCH] Preliminary but mostly-working addition of https support to
 guile

---
 module/web/client.scm | 108 +-
 1 file changed, 107 insertions(+), 1 deletion(-)

diff --git a/module/web/client.scm b/module/web/client.scm
index 070b0c3..4159f73 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -1,6 +1,6 @@
 ;;; Web client
 
-;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013, 2014, 2015 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
@@ -45,6 +45,7 @@
   #:use-module (srfi srfi-9 gnu)
   #:export (current-http-proxy
 open-socket-for-uri
+open-connection-for-uri
 http-get
 http-get*
 http-head
@@ -54,11 +55,116 @@
 http-trace
 http-options))
 
+(define %http-receive-buffer-size
+  ;; Size of the HTTP receive buffer.
+  65536)
+
+;; Provide access to the gnutls-module, but fail gracefully if not available.
+;; Why take this route and not just straight up import the module?
+;; Guile can't depend on gnutls because gnutls includes Guile as a dependency.
+;; There's some risk of dependency cycles, so lazily resolving things only
+;; once needed helps!
+
+(define gnutls-module
+  (delay
+(catch 'misc-error
+  (lambda ()
+(resolve-interface '(gnutls)))
+  (lambda _
+(format (current-error-port)
+"warning: (gnutls) module not available\n")
+#f
+
+(define (ensure-gnutls)
+  (if (not (force gnutls-module))
+  (error "(gnutls) module not available")))
+
+(define (gnutls-ref symbol)
+  "Fetch method-symbol from the gnutls module"
+  (ensure-gnutls)
+  (module-ref (force gnutls-module) symbol))
+
 (define current-http-proxy
   (make-parameter (let ((proxy (getenv "http_proxy")))
 (and (not (equal? proxy ""))
  proxy
 
+(define add-weak-reference
+  (let ((table (make-weak-key-hash-table)))
+(lambda (from to)
+  "Hold a weak reference from FROM to TO."
+  (hashq-set! table from to
+
+(define (tls-wrap port server)
+  "Return PORT wrapped in a TLS connection to SERVER.  SERVER must be a DNS
+host name without trailing dot."
+  (define (log level str)
+(format (current-error-port)
+"gnutls: [~a|~a] ~a" (getpid) level str))
+
+  (ensure-gnutls)
+
+  (let ((session ((gnutls-ref 'make-session)
+  (gnutls-ref '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
+;;  for details.
+(if (module-defined? (force gnutls-module)
+ 'set-session-server-name!)
+((gnutls-ref 'set-session-server-name!)
+ session (gnutls-ref 'server-name-type/dns) server)
+(format (current-error-port)
+"warning: TLS 'SERVER NAME' extension not supported~%"))
+
+((gnutls-ref 'set-session-transport-fd!) session (fileno port))
+((gnutls-ref 'set-session-default-priority!) session)
+((gnutls-ref 'set-session-credentials!) session
+ ((gnutls-ref 'make-certificate-credentials)))
+
+;; Uncomment the following lines in case of debugging emergency.
+;;(set-log-level! 10)
+;;(set-log-procedure! log)
+
+((gnutls-ref 'handshake) session)
+(let ((record ((gnutls-ref 'session-record-port) session)))
+  ;; Since we