[bug#48299] [PATCH] ipfs: Do not redirect to non-existent subdomains

[bug#48299] [PATCH] ipfs: Do not redirect to non-existent subdomains

[Maxime Devos]

[-- Attachment #1.1: Type: text/plain, Size: 451 bytes --]

Hi guix,

This patchs configures the ipfs service to allow
read access via http://localhost:8082/ipfs/THE-OBJECT.
Previous, it redirected to a subdomain of localhost,
but the required DNS trickery does not yet exist for
Guix System, so that redirect failed.

I added a system test for testing this functionality
(make check-system TESTS=ipfs). Not yet tested on a ‘real’ system,
though I don't expect any issues.

Greetings,
Maxime.

[-- Attachment #1.2: 0001-services-ipfs-Do-not-redirect-to-non-existent-subdom.patch --]
[-- Type: text/x-patch, Size: 8315 bytes --]

From f4415e8a3fc75fc4b09d085919447364b8518009 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 8 May 2021 20:16:19 +0200
Subject: [PATCH 1/2] services: ipfs: Do not redirect to (non-existent)
 subdomains.

Using subdomains is important for properly isolating separate
websites on IPFS from each other, but requires some DNS trickery
that is not currently supported, so disable subdomains for now.

* gnu/services/networking.scm
  (uglify-field, serialize-field, serialize-string, serialize-boolean)
  (gateway-path?, gateway-path, gateway-path-list?)
  (serialize-gateway-path-list, ipfs-public-gateway->scm): New procedures.
  (ipfs-public-gateway): New configuration type. Disable use-subdomains?
  by default, deviating from upstream.
  (ipfs-gateways->json-file): New procedure for serialising
  ipfs-public-gateway to JSON
  (%ipfs-localhost-public-gateway): New constant.
  (<ipfs-configuration>)[public-gateways]: New field.
  (%ipfs-activation)[ipfs-config-comand,set-config!-gexp,settings]
  [inner-gexp]: Set new configuration.
* doc/guix.texi (Networking Services): Document new IPFS configuration
  options.
---
 doc/guix.texi               | 35 ++++++++++++++
 gnu/services/networking.scm | 92 ++++++++++++++++++++++++++++++++++---
 2 files changed, 120 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f3f94307cd..36423fd225 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17581,6 +17581,41 @@ Address of the gateway, in ‘multiaddress’ format.
 
 @item @code{api} (default: @code{"/ip4/127.0.0.1/tcp/5001"})
 Address of the API endpoint, in ‘multiaddress’ format.
+
+@item @code{public-gateways}
+A list of @code{ipfs-public-gateway} objects for each hostname
+at which the IPFS service is accessed.  By default, this is a list
+with an entry for @code{localhost} (i.e., the local system) which
+should be sufficient for most users.
+
+See below for details on @code{ipfs-public-gateway}.
+
+@end table
+@end deftp
+
+@deftp {Data Type} ipfs-public-gateway
+Data type representing how the IPFS service can be accessed at
+some hostname.
+This type has the following parameters:
+
+@table @asis
+@item @code{hostname}
+The hostname to configure.
+
+@item @code{use-subdomains?} (default: @code{#f})
+If @code{#t}, expect requests on subdomains of the hostname and
+automatically redirect to the subdomains.  As the required DNS machinery does
+not yet exist for Guix System, this is disabled by default for now.  However,
+for preventing websites on IPFS from interfering or conspiring with each
+other (e.g. via cookies), subdomains are required.
+
+@item @code{paths} (default: @code{'("/ipfs" "/ipns")})
+A list of paths to expose on the hostname.  The paths @samp{/ipfs} and
+@samp{/ipns} are used for read access.  The path @samp{/api} is used for
+‘pinning’ and many other activities, including changing the configuration
+of the daemon!  As such, it is probably inadvisable to expose @samp{/api}
+on publicly-accessibly interface unless you're very careful.
+
 @end table
 @end deftp
 
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 761820ad2e..2e87106aca 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -57,6 +57,7 @@
   #:use-module (gnu packages wicd)
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages ipfs)
+  #:use-module ((gnu packages guile) #:select (guile-json-4))
   #:use-module (gnu build linux-container)
   #:use-module (guix gexp)
   #:use-module (guix records)
@@ -1891,6 +1892,75 @@ See yggdrasil -genconf for config options.")
 ;;; IPFS
 ;;;
 
+(define (uglify-field-name name)
+  (match name
+    ('paths "Paths")
+    ('use-subdomains? "UseSubdomains")))
+
+(define (serialize-field field-name value)
+  (if (eq? field-name 'hostname)
+      value
+      (cons (uglify-field-name field-name) value)))
+
+(define serialize-string serialize-field)
+(define serialize-boolean serialize-field)
+
+(define (gateway-path? p)
+  ;; Hardcode the list of possible paths, for simplicity and to prevent
+  ;; typos from biting the user at run-time.
+  (and (string? p)
+       (member p '("/ipfs" "/ipns" "/api"))))
+
+(define (gateway-path-list? l)
+  (and (list? l)
+       (every gateway-path? l)))
+
+(define (serialize-gateway-path-list field-name paths)
+  (serialize-field field-name (list->vector paths)))
+
+(define-configuration ipfs-public-gateway
+  (hostname
+   (string (configuration-missing-field 'ipfs-public-gateway 'hostname))
+   "The hostname to configure.")
+  (use-subdomains?
+   (boolean #f)
+   "If @code{#t}, expect requests on subdomains of the hostname and
+automatically redirect to the subdomains.  As the required DNS machinery does
+not yet exist for Guix System, this is disabled by default for now.  However,
+for preventing websites on IPFS from interfering or conspiring with each
+other (e.g. via cookies), subdomains are required.")
+  (paths
+   (gateway-path-list '("/ipfs" "/ipns"))
+   "A list of paths to expose on the hostname.  The paths @samp{/ipfs} and
+@samp{/ipns} are used for read access.  The path @samp{/api} is used for
+‘pinning’ and many other activities, including changing the configuration
+of the daemon!  As such, it is probably inadvisable to expose @samp{/api}
+on publicly-accessibly interface unless you're very careful."))
+
+(define (ipfs-public-gateway->scm public-gateway)
+  (map (lambda (field)
+         ((configuration-field-serializer field)
+          (configuration-field-name field)
+          ((configuration-field-getter field) public-gateway)))
+       ipfs-public-gateway-fields))
+
+(define (ipfs-gateways->json-file gateways)
+  "Return a @code{computed-file} object that, when unquoted in a G-expression,
+procedures a JSON file with the value for the Gateway.PublicGateways setting."
+  (computed-file
+   "gateways.json"
+   (with-extensions (list guile-json-4)
+     #~(begin
+         (use-modules (json))
+         (with-output-to-file #$output
+           (lambda ()
+             (scm->json '#$(map ipfs-public-gateway->scm gateways))))))))
+
+(define %ipfs-localhost-public-gateway
+  (ipfs-public-gateway
+   (hostname "localhost")
+   (paths '("/ipfs" "/ipns" "/api"))))
+
 (define-record-type* <ipfs-configuration>
   ipfs-configuration
   make-ipfs-configuration
@@ -1900,7 +1970,9 @@ See yggdrasil -genconf for config options.")
   (gateway ipfs-configuration-gateway
            (default "/ip4/127.0.0.1/tcp/8082"))
   (api     ipfs-configuration-api
-           (default "/ip4/127.0.0.1/tcp/5001")))
+           (default "/ip4/127.0.0.1/tcp/5001"))
+  (public-gateways ipfs-configuration-public-gateways
+                   (default (list %ipfs-localhost-public-gateway))))
 
 (define %ipfs-home "/var/lib/ipfs")
 
@@ -1957,20 +2029,26 @@ See yggdrasil -genconf for config options.")
 
 (define (%ipfs-activation config)
   "Return an activation gexp for IPFS with CONFIG"
-  (define (ipfs-config-command setting value)
-    #~(#$(ipfs-binary config) "config" #$setting #$value))
-  (define (set-config!-gexp setting value)
-    #~(system* #$@(ipfs-config-command setting value)))
+  (define (ipfs-config-command setting . values)
+    #~(#$(ipfs-binary config) "config" #$setting #$@values))
+  (define (set-config!-gexp setting . values)
+    #~(system* #$@(apply ipfs-config-command setting values)))
   (define settings
     `(("Addresses.API" ,(ipfs-configuration-api config))
-      ("Addresses.Gateway" ,(ipfs-configuration-gateway config))))
+      ("Addresses.Gateway" ,(ipfs-configuration-gateway config))
+      ("Gateway.PublicGateways" "--json"
+       (call-with-input-file
+           ,(ipfs-gateways->json-file
+             (ipfs-configuration-public-gateways config))
+         get-string-all #:encoding "UTF-8"))))
   (define inner-gexp
     #~(begin
+        (use-modules (ice-9 textual-ports))
         (umask #o077)
         ;; Create $HOME/.ipfs structure
         (system* #$(ipfs-binary config) "init")
         ;; Apply settings
-        #$@(map (cute apply set-config!-gexp <>) settings)))
+        #$@(map (cute apply set-config!-gexp <...>) settings)))
   (define inner-script
     (program-file "ipfs-activation-inner" inner-gexp))
   ;; Run ipfs init and ipfs config from a container,
-- 
2.31.1


[-- Attachment #1.3: 0002-tests-networking-Test-whether-the-gateway-is-usable.patch --]
[-- Type: text/x-patch, Size: 2821 bytes --]

From ca43bd364112cf15ff5871e92890b4a0a201c817 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sat, 8 May 2021 21:48:20 +0200
Subject: [PATCH 2/2] tests: networking: Test whether the gateway is usable.

The IPFS daemon listens at two endpoints.  One is called the gateway
and the other is called the API.  There are some tests for the API, but
none yet for the gateway.  Test whether data can be read from the gateway.

* gnu/tests/networking.scm
  (run-ipfs-test)[test]{read-contents/gateway}: New procedure, variant
  of 'read-contents'.
  (run-ipfs-test)[test]{can upload and download a file to/from ipfs}:
  Rename to ...
  (run-ipfs-test)[test]{can upload and download a file to/from ipfs via API}
  This.
  (run-ipfs-test)[test]{can download a file from ipfs via gateway}:
  New test.
---
 gnu/tests/networking.scm | 27 +++++++++++++++++++++++----
 1 file changed, 23 insertions(+), 4 deletions(-)

diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index 453e63f52d..6e759b7679 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -620,8 +620,21 @@ COMMIT
                 (close-port input)
                 all-input)
              marionette))
-
-          (marionette-eval '(use-modules (guix ipfs)) marionette)
+          (define (read-contents/gateway object)
+            (marionette-eval
+             `(receive (response body)
+                  (http-get (string->uri
+                             (string-append "http://localhost:8082/ipfs/"
+                                            ,object))
+                            #:decode-body? #f)
+                (list (response-code response) body))
+             marionette))
+          (marionette-eval '(use-modules (guix ipfs)
+                                         (web client)
+                                         (web response)
+                                         (web uri)
+                                         (srfi srfi-8))
+                           marionette)
           (mkdir #$output)
           (chdir #$output)
 
@@ -640,9 +653,15 @@ COMMIT
               (wait-for-tcp-port default-port marionette)))
 
           (define test-bv (string->utf8 "hello ipfs!"))
-          (test-equal "can upload and download a file to/from ipfs"
+          (define test-object (delay (add-data test-bv)))
+
+          (test-equal "can upload and download a file to/from ipfs via API"
             test-bv
-            (read-contents (add-data test-bv)))
+            (read-contents (force test-object)))
+
+          (test-equal "can download a file from ipfs via gateway"
+            (list 200 test-bv)
+            (read-contents/gateway (force test-object)))
 
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-- 
2.31.1


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]