From: Maxime Devos <maximedevos@telenet.be>
Cc: 45905@debbugs.gnu.org
Subject: [bug#45905] [PATCH v3] IPFS service definition
Date: Tue, 30 Mar 2021 15:37:46 +0200 [thread overview]
Message-ID: <42e840c5a55968ecf8173e4eb84af7dc415f3a51.camel@telenet.be> (raw)
In-Reply-To: <af02fc3aaa36504cd63cdc5d48bb1f8f31a46d83.camel@telenet.be>
[-- Attachment #1.1: Type: text/plain, Size: 1048 bytes --]
Hi Guix,
Revised patch series is attached.
Changes in v2:
* let the shepherd service depend on (loopback) instead of
(networking)
* added a (broken) system test for the IPFS service
Changes in v3:
* added 'extensions' argument to 'marionette-operating-system'.
* fixed the system test
* tweaked the documentation formatting and removed a misleading comment
on forwarding (port forwarding would be fine here, as the test is run
in a container so there is no risk of port conflicts IIUC)
Ludovic Courtès wrote:
> Nitpick: please avoid ‘@’. Instead, explicitly do:
> [...]
I actually prefer '(@ (...) ...)' here, but whatever. It's changed
in v3.
> As it stands, the test fails because you need to:
> (define test
> (with-extensions (list guile-json)
> …))
As the uploading and downloading is done in the guest, not the host,
this needs to be done somewhat differently. That's what the patch
‘tests: Support package extensions in the backdoor REPL’ is for.
Greetings,
Maxime
[-- Attachment #1.2: 0001-services-Add-ipfs-service-type.patch --]
[-- Type: text/x-patch, Size: 8806 bytes --]
From 74149efb0dbd1b412fdd14aa87bee80640ea5463 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 15 Jan 2021 21:46:42 +0100
Subject: [PATCH 1/4] services: Add ipfs-service-type
* gnu/services/networking.scm (ipfs-service-type)
(%ipfs-home-mapping, %ipfs-environment)
(%ipfs-accounts, %ipfs-home): New variables.
(ipfs-configuration, ipfs-configuration?)
(ipfs-configuration-package, ipfs-configuration-gateway)
(ipfs-configuration-api, ipfs-shepherd-service)
(ipfs-binary, %ipfs-activation): New procedures.
* doc/guix.texi (Networking Services): Document it.
---
doc/guix.texi | 32 ++++++++
gnu/services/networking.scm | 141 ++++++++++++++++++++++++++++++++++++
2 files changed, 173 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index 74f3fbd299..fe1442a9d3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -87,6 +87,7 @@ Copyright @copyright{} 2020 Daniel Brooks@*
Copyright @copyright{} 2020 John Soo@*
Copyright @copyright{} 2020 Jonathan Brielmaier@*
Copyright @copyright{} 2020 Edgar Vincent@*
+Copyright @copyright{} 2021 Maxime Devos@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -17462,6 +17463,37 @@ address, delete everything except these options:
@end table
@end deftp
+@cindex IPFS
+@defvr {Scheme Variable} ipfs-service-type
+The service type for connecting to the @uref{https://ipfs.io,IPFS network},
+a global, versioned, peer-to-peer file system. Pass it a
+@code{ipfs-configuration} to change the ports used for the gateway and API.
+
+Here's an example configuration, using some non-standard ports:
+
+@lisp
+(service ipfs-service-type
+ (ipfs-configuration
+ (gateway "/ip4/127.0.0.1/tcp/8880")
+ (api "/ip4/127.0.0.1/tcp/8881")))
+@end lisp
+@end defvr
+
+@deftp {Data Type} ipfs-configuration
+Data type representing the configuration of IPFS.
+
+@table @asis
+@item @code{package} (default: @code{go-ipfs})
+Package object of IPFS.
+
+@item @code{gateway} (default: @code{"/ip4/127.0.0.1/tcp/8082"})
+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.
+@end table
+@end deftp
+
@cindex keepalived
@deffn {Scheme Variable} keepalived-service-type
This is the type for the @uref{https://www.keepalived.org/, Keepalived}
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 231a9f66c7..6e93b56717 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -16,6 +16,7 @@
;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2021 Christopher Lemmer Webber <cwebber@dustycloud.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -55,6 +56,8 @@
#:use-module (gnu packages ntp)
#:use-module (gnu packages wicd)
#:use-module (gnu packages gnome)
+ #:use-module (gnu packages ipfs)
+ #:use-module (gnu build linux-container)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix modules)
@@ -197,6 +200,13 @@
yggdrasil-configuration-json-config
yggdrasil-configuration-package
+ ipfs-service-type
+ ipfs-configuration
+ ipfs-configuration?
+ ipfs-configuration-package
+ ipfs-configuration-gateway
+ ipfs-configuration-api
+
keepalived-configuration
keepalived-configuration?
keepalived-service-type))
@@ -1876,6 +1886,137 @@ See yggdrasil -genconf for config options.")
(service-extension profile-service-type
(compose list yggdrasil-configuration-package))))))
+\f
+;;;
+;;; IPFS
+;;;
+
+(define-record-type* <ipfs-configuration>
+ ipfs-configuration
+ make-ipfs-configuration
+ ipfs-configuration?
+ (package ipfs-configuration-package
+ (default go-ipfs))
+ (gateway ipfs-configuration-gateway
+ (default "/ip4/127.0.0.1/tcp/8082"))
+ (api ipfs-configuration-api
+ (default "/ip4/127.0.0.1/tcp/5001")))
+
+(define %ipfs-home "/var/lib/ipfs")
+
+(define %ipfs-accounts
+ (list (user-account
+ (name "ipfs")
+ (group "ipfs")
+ (system? #t)
+ (comment "IPFS daemon user")
+ (home-directory "/var/lib/ipfs")
+ (shell (file-append shadow "/sbin/nologin")))
+ (user-group
+ (name "ipfs")
+ (system? #t))))
+
+(define (ipfs-binary config)
+ (file-append (ipfs-configuration-package config) "/bin/ipfs"))
+
+(define %ipfs-home-mapping
+ #~(file-system-mapping
+ (source #$%ipfs-home)
+ (target #$%ipfs-home)
+ (writable? #t)))
+
+(define %ipfs-environment
+ #~(list #$(string-append "HOME=" %ipfs-home)))
+
+(define (ipfs-shepherd-service config)
+ "Return a <shepherd-service> for IPFS with CONFIG."
+ (define ipfs-daemon-command
+ #~(list #$(ipfs-binary config) "daemon"))
+ (list
+ (with-imported-modules (source-module-closure
+ '((gnu build shepherd)
+ (gnu system file-systems)))
+ (shepherd-service
+ (provision '(ipfs))
+ ;; While IPFS is most useful when the machine is connected
+ ;; to the network, only loopback is required for starting
+ ;; the service.
+ (requirement '(loopback))
+ (documentation "Connect to the IPFS network")
+ (modules '((gnu build shepherd)
+ (gnu system file-systems)))
+ (start #~(make-forkexec-constructor/container
+ #$ipfs-daemon-command
+ #:namespaces '#$(fold delq %namespaces '(user net))
+ #:mappings (list #$%ipfs-home-mapping)
+ #:log-file "/var/log/ipfs.log"
+ #:user "ipfs"
+ #:group "ipfs"
+ #:environment-variables #$%ipfs-environment))
+ (stop #~(make-kill-destructor))))))
+
+(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 settings
+ `(("Addresses.API" ,(ipfs-configuration-api config))
+ ("Addresses.Gateway" ,(ipfs-configuration-gateway config))))
+ (define inner-gexp
+ #~(begin
+ (umask #o077)
+ ;; Create $HOME/.ipfs structure
+ (system* #$(ipfs-binary config) "init")
+ ;; Apply 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,
+ ;; in case the IPFS daemon was compromised at some point
+ ;; and ~/.ipfs is now a symlink to somewhere outside
+ ;; %ipfs-home.
+ (define container-gexp
+ (with-extensions (list shepherd)
+ (with-imported-modules (source-module-closure
+ '((gnu build shepherd)
+ (gnu system file-systems)))
+ #~(begin
+ (use-modules (gnu build shepherd)
+ (gnu system file-systems))
+ (let* ((constructor
+ (make-forkexec-constructor/container
+ (list #$inner-script)
+ #:namespaces '#$(fold delq %namespaces '(user))
+ #:mappings (list #$%ipfs-home-mapping)
+ #:user "ipfs"
+ #:group "ipfs"
+ #:environment-variables #$%ipfs-environment))
+ (pid (constructor)))
+ (waitpid pid))))))
+ ;; The activation may happen from the initrd, which uses
+ ;; a statically-linked guile, while the guix container
+ ;; procedures require a working dynamic-link.
+ (define container-script
+ (program-file "ipfs-activation-container" container-gexp))
+ #~(system* #$container-script))
+
+(define ipfs-service-type
+ (service-type
+ (name 'ipfs)
+ (extensions
+ (list (service-extension account-service-type
+ (const %ipfs-accounts))
+ (service-extension activation-service-type
+ %ipfs-activation)
+ (service-extension shepherd-root-service-type
+ ipfs-shepherd-service)))
+ (default-value (ipfs-configuration))
+ (description
+ "Run @command{ipfs daemon}, the reference implementation
+of the IPFS p2p storage network.")))
+
\f
;;;
;;; Keepalived
--
2.31.1
[-- Attachment #1.3: 0002-Add-guix-ipfs.patch --]
[-- Type: text/x-patch, Size: 10245 bytes --]
From c1ca4e25ff35fabe89fc7a8b2b4d3521840236c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 28 Dec 2018 01:07:58 +0100
Subject: [PATCH 2/4] Add (guix ipfs).
This module allows for communicating with the IPFS
gateway over the HTTP interface. The commit has been
cherry-picked from <https://issues.guix.gnu.org/33899>.
The procedures for adding and restoring file trees have
been removed as according to a reply issue 33899, a different
format will be used. The procedure 'add-data' has been
exported as it will be used in the system test for IPFS.
* guix/ipfs.scm: New file.
* Makefile.am (MODULES): Add it.
---
Makefile.am | 1 +
guix/ipfs.scm | 183 +++++++++++++++++++++++++++++++++++++++++++++++++
tests/ipfs.scm | 55 +++++++++++++++
3 files changed, 239 insertions(+)
create mode 100644 guix/ipfs.scm
create mode 100644 tests/ipfs.scm
diff --git a/Makefile.am b/Makefile.am
index 1c2d45527c..17ad236655 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -126,6 +126,7 @@ MODULES = \
guix/cache.scm \
guix/cve.scm \
guix/workers.scm \
+ guix/ipfs.scm \
guix/build-system.scm \
guix/build-system/android-ndk.scm \
guix/build-system/ant.scm \
diff --git a/guix/ipfs.scm b/guix/ipfs.scm
new file mode 100644
index 0000000000..31a89888a7
--- /dev/null
+++ b/guix/ipfs.scm
@@ -0,0 +1,183 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix ipfs)
+ #:use-module (json)
+ #:use-module (guix base64)
+ #:use-module ((guix build utils) #:select (dump-port))
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (rnrs io ports)
+ #:use-module (rnrs bytevectors)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 ftw)
+ #:use-module (web uri)
+ #:use-module (web client)
+ #:use-module (web response)
+ #:export (%ipfs-base-url
+ add-data
+ add-file
+
+ content?
+ content-name
+ content-hash
+ content-size
+
+ add-empty-directory
+ add-to-directory
+ read-contents
+ publish-name))
+
+;;; Commentary:
+;;;
+;;; This module implements bindings for the HTTP interface of the IPFS
+;;; gateway, documented here: <https://docs.ipfs.io/reference/api/http/>. It
+;;; allows you to add and retrieve files over IPFS, and a few other things.
+;;;
+;;; Code:
+
+(define %ipfs-base-url
+ ;; URL of the IPFS gateway.
+ (make-parameter "http://localhost:5001"))
+
+(define* (call url decode #:optional (method http-post)
+ #:key body (false-if-404? #t) (headers '()))
+ "Invoke the endpoint at URL using METHOD. Decode the resulting JSON body
+using DECODE, a one-argument procedure that takes an input port; when DECODE
+is false, return the input port. When FALSE-IF-404? is true, return #f upon
+404 responses."
+ (let*-values (((response port)
+ (method url #:streaming? #t
+ #:body body
+
+ ;; Always pass "Connection: close".
+ #:keep-alive? #f
+ #:headers `((connection close)
+ ,@headers))))
+ (cond ((= 200 (response-code response))
+ (if decode
+ (let ((result (decode port)))
+ (close-port port)
+ result)
+ port))
+ ((and false-if-404?
+ (= 404 (response-code response)))
+ (close-port port)
+ #f)
+ (else
+ (close-port port)
+ (throw 'ipfs-error url response)))))
+
+;; Result of a file addition.
+(define-json-mapping <content> make-content content?
+ json->content
+ (name content-name "Name")
+ (hash content-hash "Hash")
+ (bytes content-bytes "Bytes")
+ (size content-size "Size" string->number))
+
+;; Result of a 'patch/add-link' operation.
+(define-json-mapping <directory> make-directory directory?
+ json->directory
+ (hash directory-hash "Hash")
+ (links directory-links "Links" json->links))
+
+;; A "link".
+(define-json-mapping <link> make-link link?
+ json->link
+ (name link-name "Name")
+ (hash link-hash "Hash")
+ (size link-size "Size" string->number))
+
+;; A "binding", also known as a "name".
+(define-json-mapping <binding> make-binding binding?
+ json->binding
+ (name binding-name "Name")
+ (value binding-value "Value"))
+
+(define (json->links json)
+ (match json
+ (#f '())
+ (links (map json->link links))))
+
+(define %multipart-boundary
+ ;; XXX: We might want to find a more reliable boundary.
+ (string-append (make-string 24 #\-) "2698127afd7425a6"))
+
+(define (bytevector->form-data bv port)
+ "Write to PORT a 'multipart/form-data' representation of BV."
+ (display (string-append "--" %multipart-boundary "\r\n"
+ "Content-Disposition: form-data\r\n"
+ "Content-Type: application/octet-stream\r\n\r\n")
+ port)
+ (put-bytevector port bv)
+ (display (string-append "\r\n--" %multipart-boundary "--\r\n")
+ port))
+
+(define* (add-data data #:key (name "file.txt") recursive?)
+ "Add DATA, a bytevector, to IPFS. Return a content object representing it."
+ (call (string-append (%ipfs-base-url)
+ "/api/v0/add?arg=" (uri-encode name)
+ "&recursive="
+ (if recursive? "true" "false"))
+ json->content
+ #:headers
+ `((content-type
+ . (multipart/form-data
+ (boundary . ,%multipart-boundary))))
+ #:body
+ (call-with-bytevector-output-port
+ (lambda (port)
+ (bytevector->form-data data port)))))
+
+(define (not-dot? entry)
+ (not (member entry '("." ".."))))
+
+(define* (add-file file #:key (name (basename file)))
+ "Add FILE under NAME to the IPFS and return a content object for it."
+ (add-data (match (call-with-input-file file get-bytevector-all)
+ ((? eof-object?) #vu8())
+ (bv bv))
+ #:name name))
+
+(define* (add-empty-directory #:key (name "directory"))
+ "Return a content object for an empty directory."
+ (add-data #vu8() #:recursive? #t #:name name))
+
+(define* (add-to-directory directory file name)
+ "Add FILE to DIRECTORY under NAME, and return the resulting directory.
+DIRECTORY and FILE must be hashes identifying objects in the IPFS store."
+ (call (string-append (%ipfs-base-url)
+ "/api/v0/object/patch/add-link?arg="
+ (uri-encode directory)
+ "&arg=" (uri-encode name) "&arg=" (uri-encode file)
+ "&create=true")
+ json->directory))
+
+(define* (read-contents object #:key offset length)
+ "Return an input port to read the content of OBJECT from."
+ (call (string-append (%ipfs-base-url)
+ "/api/v0/cat?arg=" object)
+ #f))
+
+(define* (publish-name object)
+ "Publish OBJECT under the current peer ID."
+ (call (string-append (%ipfs-base-url)
+ "/api/v0/name/publish?arg=" object)
+ json->binding))
diff --git a/tests/ipfs.scm b/tests/ipfs.scm
new file mode 100644
index 0000000000..3b662b22bd
--- /dev/null
+++ b/tests/ipfs.scm
@@ -0,0 +1,55 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-ipfs)
+ #:use-module (guix ipfs)
+ #:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module (guix tests)
+ #:use-module (web uri)
+ #:use-module (srfi srfi-64))
+
+;; Test the (guix ipfs) module.
+
+(define (ipfs-gateway-running?)
+ "Return true if the IPFS gateway is running at %IPFS-BASE-URL."
+ (let* ((uri (string->uri (%ipfs-base-url)))
+ (socket (socket AF_INET SOCK_STREAM 0)))
+ (define connected?
+ (catch 'system-error
+ (lambda ()
+ (format (current-error-port)
+ "probing IPFS gateway at localhost:~a...~%"
+ (uri-port uri))
+ (connect socket AF_INET INADDR_LOOPBACK (uri-port uri))
+ #t)
+ (const #f)))
+
+ (close-port socket)
+ connected?))
+
+(unless (ipfs-gateway-running?)
+ (test-skip 1))
+
+(test-assert "add-file-tree + restore-file-tree"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (let* ((source (dirname (search-path %load-path "guix/base32.scm")))
+ (target (string-append directory "/r"))
+ (content (pk 'content (add-file-tree source))))
+ (restore-file-tree (content-name content) target)
+ (file=? source target)))))
--
2.31.1
[-- Attachment #1.4: 0003-tests-Support-package-extensions-in-the-backdoor-REP.patch --]
[-- Type: text/x-patch, Size: 3961 bytes --]
From bbf35272775de63ad64aed98a2fa081374f28505 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Tue, 30 Mar 2021 12:40:14 +0200
Subject: [PATCH 3/4] tests: Support package extensions in the backdoor REPL.
* gnu/tests.scm
(<marionette-configuration>): Add 'extensions' field.
(marionette-shepherd-service): Honour the field.
(with-import-modules-and-extensions): Define a combination
of 'with-import-modules' and 'with-extensions'.
---
gnu/tests.scm | 26 +++++++++++++++++++++++---
1 file changed, 23 insertions(+), 3 deletions(-)
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 3b10a6d5ac..eb636873a2 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -74,13 +75,24 @@
(default "/dev/virtio-ports/org.gnu.guix.port.0"))
(imported-modules marionette-configuration-imported-modules
(default '()))
+ (extensions marionette-configuration-extensions
+ (default '())) ; list of packages
(requirements marionette-configuration-requirements ;list of symbols
(default '())))
+;; Hack: avoid indenting code beyond column 80 in marionette-shepherd-service.
+(define-syntax-rule (with-imported-modules-and-extensions imported-modules
+ extensions
+ gexp)
+ (with-imported-modules imported-modules
+ (with-extensions extensions
+ gexp)))
+
(define (marionette-shepherd-service config)
"Return the Shepherd service for the marionette REPL"
(match config
- (($ <marionette-configuration> device imported-modules requirement)
+ (($ <marionette-configuration> device imported-modules extensions
+ requirement)
(list (shepherd-service
(provision '(marionette))
@@ -90,7 +102,7 @@
(modules '((ice-9 match)
(srfi srfi-9 gnu)))
(start
- (with-imported-modules imported-modules
+ (with-imported-modules-and-extensions imported-modules extensions
#~(lambda ()
(define (self-quoting? x)
(letrec-syntax ((one-of (syntax-rules ()
@@ -154,11 +166,13 @@
(define* (marionette-operating-system os
#:key
(imported-modules '())
+ (extensions '())
(requirements '()))
"Return a marionetteed variant of OS such that OS can be used as a
marionette in a virtual machine--i.e., controlled from the host system. The
marionette service in the guest is started after the Shepherd services listed
-in REQUIREMENTS."
+in REQUIREMENTS. The packages in the list EXTENSIONS are made available from
+the backdoor REPL."
(operating-system
(inherit os)
;; Make sure the guest dies on error.
@@ -172,6 +186,7 @@ in REQUIREMENTS."
(services (cons (service marionette-service-type
(marionette-configuration
(requirements requirements)
+ (extensions extensions)
(imported-modules imported-modules)))
(operating-system-user-services os)))))
@@ -281,4 +296,9 @@ result."
"Return the list of system tests."
(reverse (fold-system-tests cons '())))
+
+;; Local Variables:
+;; eval: (put 'with-imported-modules-and-extensions 'scheme-indent-function 2)
+;; End:
+
;;; tests.scm ends here
--
2.31.1
[-- Attachment #1.5: 0004-gnu-tests-Test-basic-funtionality-of-the-IPFS-servic.patch --]
[-- Type: text/x-patch, Size: 4792 bytes --]
From b9134c60d9e662dd497caf0c1819e3e04a5e8b4e Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 28 Mar 2021 17:01:49 +0200
Subject: [PATCH 4/4] gnu: tests: Test basic funtionality of the IPFS service.
It is tested whether the IPFS service listens
at the gateway and API ports and whether it
is possible to upload and download a bytevector.
* gnu/tests/networking.scm
(%ipfs-os): New variable.
(run-ipfs-test): New procedure.
(%test-ipfs): New system test.
---
gnu/tests/networking.scm | 92 +++++++++++++++++++++++++++++++++++++++-
1 file changed, 91 insertions(+), 1 deletion(-)
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index 022663aa67..453e63f52d 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2017, 2020 Marius Bakke <marius@gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,12 +30,15 @@
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
+ #:use-module (guix modules)
#:use-module (gnu packages bash)
#:use-module (gnu packages linux)
#:use-module (gnu packages networking)
+ #:use-module (gnu packages guile)
#:use-module (gnu services shepherd)
#:use-module (ice-9 match)
- #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables))
+ #:export (%test-inetd %test-openvswitch %test-dhcpd %test-tor %test-iptables
+ %test-ipfs))
(define %inetd-os
;; Operating system with 2 inetd services.
@@ -563,3 +567,89 @@ COMMIT
(name "iptables")
(description "Test a running iptables daemon.")
(value (run-iptables-test))))
+
+\f
+;;;
+;;; IPFS service
+;;;
+
+(define %ipfs-os
+ (simple-operating-system
+ (service ipfs-service-type)))
+
+(define (run-ipfs-test)
+ (define os
+ (marionette-operating-system %ipfs-os
+ #:imported-modules (source-module-closure
+ '((gnu services herd)
+ (guix ipfs)))
+ #:extensions (list guile-json-4)
+ #:requirements '(ipfs)))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (rnrs bytevectors)
+ (srfi srfi-64)
+ (ice-9 binary-ports))
+
+ (define marionette
+ (make-marionette (list #$(virtual-machine os))))
+
+ (define (ipfs-is-alive?)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd)
+ (srfi srfi-1))
+ (live-service-running
+ (find (lambda (live)
+ (memq 'ipfs
+ (live-service-provision live)))
+ (current-services))))
+ marionette))
+
+ ;; The default API endpoint port 5001 is used,
+ ;; so there is no need to parameterize %ipfs-base-url.
+ (define (add-data data)
+ (marionette-eval `(content-name (add-data ,data)) marionette))
+ (define (read-contents object)
+ (marionette-eval
+ `(let* ((input (read-contents ,object))
+ (all-input (get-bytevector-all input)))
+ (close-port input)
+ all-input)
+ marionette))
+
+ (marionette-eval '(use-modules (guix ipfs)) marionette)
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "ipfs")
+
+ ;; Test the IPFS service.
+
+ (test-assert "ipfs is alive" (ipfs-is-alive?))
+
+ (test-assert "ipfs is listening on the gateway"
+ (let ((default-port 8082))
+ (wait-for-tcp-port default-port marionette)))
+
+ (test-assert "ipfs is listening on the API endpoint"
+ (let ((default-port 5001))
+ (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"
+ test-bv
+ (read-contents (add-data test-bv)))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+ (gexp->derivation "ipfs-test" test))
+
+(define %test-ipfs
+ (system-test
+ (name "ipfs")
+ (description "Test a running IPFS daemon configuration.")
+ (value (run-ipfs-test))))
--
2.31.1
[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]
next prev parent reply other threads:[~2021-03-30 13:39 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-15 21:22 [bug#45905] [PATCH] IPFS service definition Maxime Devos
2021-03-22 17:17 ` Ludovic Courtès
2021-03-22 18:40 ` Maxime Devos
2021-03-23 13:08 ` Ludovic Courtès
2021-03-28 16:36 ` Maxime Devos
2021-03-29 14:06 ` Ludovic Courtès
2021-03-29 14:07 ` Ludovic Courtès
2021-03-30 13:37 ` Maxime Devos [this message]
2021-04-12 16:48 ` bug#45905: " Ludovic Courtès
2021-04-12 18:35 ` [bug#45905] " Maxime Devos
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=42e840c5a55968ecf8173e4eb84af7dc415f3a51.camel@telenet.be \
--to=maximedevos@telenet.be \
--cc=45905@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).