unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#45905] [PATCH] IPFS service definition
@ 2021-01-15 21:22 Maxime Devos
  2021-03-22 17:17 ` Ludovic Courtès
  2021-03-30 13:37 ` [bug#45905] [PATCH v3] " Maxime Devos
  0 siblings, 2 replies; 10+ messages in thread
From: Maxime Devos @ 2021-01-15 21:22 UTC (permalink / raw)
  To: 45905


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

Hi Guix!

A patch defining simple ‘ipfs-service-type’ is attached. I've tested
this in a VM, and will test it on a ‘real’ system later. The gateway
is currently broken, it tries to redirect to non-existent subdomains
of localhost. Correcting this might require fiddling with the DNS
configuration.

Maxime
-- 
Maxime Devos <maximedevos@telenet.be>
PGP Key: C1F3 3EE2 0C52 8FDB 7DD7  011F 49E3 EE22 1917 25EE
Freenode handle: mdevos

[-- Attachment #1.2: 0001-services-Add-ipfs-service-type.patch --]
[-- Type: text/x-patch, Size: 8683 bytes --]

From c441bca727df67837652eb2f0b5ad23528fd11a3 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Fri, 15 Jan 2021 21:46:42 +0100
Subject: [PATCH] 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               |  33 +++++++++
 gnu/services/networking.scm | 138 ++++++++++++++++++++++++++++++++++++
 2 files changed, 171 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index cea7f8a8cf..49680b13e9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -86,6 +86,7 @@ Copyright @copyright{} 2020 raingloom@*
 Copyright @copyright{} 2020 Daniel Brooks@*
 Copyright @copyright{} 2020 John Soo@*
 Copyright @copyright{} 2020 Jonathan Brielmaier@*
+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
@@ -17221,6 +17222,38 @@ 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
+;; part of the operating-system declaration
+(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 dd4061341e..4a1d04dfbb 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,6 +55,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)
@@ -196,6 +199,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))
@@ -1873,6 +1883,134 @@ 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))
+      (requirement '(networking))
+      (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.30.0


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

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH] IPFS service definition
  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-30 13:37 ` [bug#45905] [PATCH v3] " Maxime Devos
  1 sibling, 1 reply; 10+ messages in thread
From: Ludovic Courtès @ 2021-03-22 17:17 UTC (permalink / raw)
  To: Maxime Devos; +Cc: 45905

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> A patch defining simple ‘ipfs-service-type’ is attached. I've tested
> this in a VM, and will test it on a ‘real’ system later. The gateway
> is currently broken, it tries to redirect to non-existent subdomains
> of localhost. Correcting this might require fiddling with the DNS
> configuration.

OK.  That doesn’t prevent one from using it, right?

> From c441bca727df67837652eb2f0b5ad23528fd11a3 Mon Sep 17 00:00:00 2001
> From: Maxime Devos <maximedevos@telenet.be>
> Date: Fri, 15 Jan 2021 21:46:42 +0100
> Subject: [PATCH] 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.

[...]

> +@lisp
> +;; part of the operating-system declaration

I think you can omit this line.

> +(service ipfs-service-type
> +              (ipfs-configuration
> +               (gateway "/ip4/127.0.0.1/tcp/8880")
> +               (api "/ip4/127.0.0.1/tcp/8881")))

Indentation is left (should be aligned with ‘ipfs-service-type’.)

> +      (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))

Nice!

> +  ;; 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))

That’s a bit involved, but it makes sense to me.

The patch LGTM.  However, we usually commit services along with a system
test under (gnu tests …).  The manual has info on how to run individual
system tests:

  https://guix.gnu.org/manual/en/html_node/Running-the-Test-Suite.html

Could you write a test that ensures that basic functionality works?  It
could be as simple as waiting for the service to be up, then invoking
‘ipfs add’ and ‘ipfs get’.  WDYT?

Thank you!

Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH] IPFS service definition
  2021-03-22 17:17 ` Ludovic Courtès
@ 2021-03-22 18:40   ` Maxime Devos
  2021-03-23 13:08     ` Ludovic Courtès
  0 siblings, 1 reply; 10+ messages in thread
From: Maxime Devos @ 2021-03-22 18:40 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 45905

[-- Attachment #1: Type: text/plain, Size: 4740 bytes --]

On Mon, 2021-03-22 at 18:17 +0100, Ludovic Courtès wrote:
> Hi Maxime,
Hi

> Maxime Devos <maximedevos@telenet.be> skribis:
> 
> > A patch defining simple ‘ipfs-service-type’ is attached. I've tested
> > this in a VM, and will test it on a ‘real’ system later. The gateway
> > is currently broken, it tries to redirect to non-existent subdomains
> > of localhost. Correcting this might require fiddling with the DNS
> > configuration.
> 
> OK.  That doesn’t prevent one from using it, right?

Nah, the REST API presumably works just fine and there is plenty to see on
the webui:

http://localhost:5001/ipfs/bafybeif4zkmu7qdhkpf3pnhwxipylqleof7rl6ojbe7mq3fzogz6m4xk3i/#/

Not perfect, but it might suffice for your purposes.
That reminds me the configuration can be modified from there.
I didn't figure how to disable that.  Not ideal from a security
perspective, but at least its only loopback & ipfs is in a container.

> > +@lisp
> > +;; part of the operating-system declaration

> I think you can omit this line.

I think I found that line somewhere & copied it for consistency,
but it has been some time ago.

> > +(service ipfs-service-type
> > +              (ipfs-configuration
> > +               (gateway "/ip4/127.0.0.1/tcp/8880")
> > +               (api "/ip4/127.0.0.1/tcp/8881")))
> 
> Indentation is left (should be aligned with ‘ipfs-service-type’.)

Ok, not sure how this happened.

> > +      (start #~(make-forkexec-constructor/container
> > +                [container stuff]
> > +                #:environment-variables #$%ipfs-environment))
> 
> Nice!
Yep!  Also, this reminds me I'm not sure what the distinction between
#+ and #~ is in activation gexps, in shepherd services definitions,
etc.

> > +  ;; 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 [complicated container stuff])
> > 
> That’s a bit involved, but it makes sense to me.

Unfortunately, there are (non-container related) some more issues.
Last few weeks I've been seeing this error (/var/log/ipfs.log):

(start snip)
Error: fs-repo requires migration
Initializing daemon...
go-ipfs version: 0.8.0
Repo version: 11
System version: amd64/linux
Golang version: go1.14.15
Found outdated fs-repo, migrations need to be run.
Run migrations now? [y/N] Not running migrations of fs-repo now.
Please get fs-repo-migrations from https://dist.ipfs.io

Error: fs-repo requires migration
(end snip)

(Super hacky work-around:
  rm -r /var/lib/ipfs
  mkdir /var/lib/ipfs
  chmod a-rwx /var/lib/ipfs
  chmod u+rwx /var/lib/ipfs
  chown ipfs:ipfs /var/lib/ipfs
  sudo -u ipfs -g ipfs "`guix build go-ipfs`/bin/ipfs" init
  # ^ this can take some seconds to complete
  sudo -u ipfs -g ipfs "`guix build go-ipfs`/bin/ipfs" config API /ip4/127.0.0.1/tcp/5001
  sudo -u ipfs -g ipfs "`guix build go-ipfs`/bin/ipfs" config Addresses.Gateway /ip4/127.0.0.1/tcp/8082
  herd enable ipfs
  herd start ipfs)

Unfortunately "fs-repo-migrations" does not seem to be packaged in Guix.
Apparently there has been a change in repo format in the go-ipfs v0.7.0
--> v0.8.0 upgrade.  I believe for most users simply automatically running
the upgrades would be sufficient.

Now, how could we do this safely from shepherd?  Maybe before starting open
a pipe, write "y\n" to it an pass it as file descriptor 0 (stdin) would
be sufficient?  But shepherd always closes /dev/stdin before exec IIRC ..

Seems like shepherd needs support for file descriptor!  I've a patch for
that, but it needs to be verified (& corrected likely) on GNU/Hurd.  Feel
free to ask for the incomplete patch if you're impatient and want to finish
it yourself!  (Seems to work on GNU/Linux in any case.)

> The patch LGTM.  However, we usually commit services along with a system
> test under (gnu tests …).  The manual has info on how to run individual
> system tests:
> 
>   https://guix.gnu.org/manual/en/html_node/Running-the-Test-Suite.html
> 
> Could you write a test that ensures that basic functionality works?  It
> could be as simple as waiting for the service to be up, then invoking
> ‘ipfs add’ and ‘ipfs get’.  WDYT?

Will look into it eventually, but I am currently occupied with other things
that have deadlines )-:. (Not feeling very inspired for a
writing/presentation assignment ...)  (And I would rather hack on GNUnet
frankly; IPFS is more of a stop-gap to me for having some distributed
something for substitutes.)  So feel free to beat me to it.

Greetings,
Maxime.

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

^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH] IPFS service definition
  2021-03-22 18:40   ` Maxime Devos
@ 2021-03-23 13:08     ` Ludovic Courtès
  2021-03-28 16:36       ` Maxime Devos
  0 siblings, 1 reply; 10+ messages in thread
From: Ludovic Courtès @ 2021-03-23 13:08 UTC (permalink / raw)
  To: Maxime Devos; +Cc: 45905

Hi Maxime!

Maxime Devos <maximedevos@telenet.be> skribis:

>> OK.  That doesn’t prevent one from using it, right?
>
> Nah, the REST API presumably works just fine and there is plenty to see on
> the webui:
>
> http://localhost:5001/ipfs/bafybeif4zkmu7qdhkpf3pnhwxipylqleof7rl6ojbe7mq3fzogz6m4xk3i/#/
>
> Not perfect, but it might suffice for your purposes.
> That reminds me the configuration can be modified from there.
> I didn't figure how to disable that.  Not ideal from a security
> perspective, but at least its only loopback & ipfs is in a container.

Good.

[...]

> Yep!  Also, this reminds me I'm not sure what the distinction between
> #+ and #~ is in activation gexps, in shepherd services definitions,
> etc.

#+ is ‘ungexp-native’.  It makes sense if you consider a cross-compiled
system.  Code in an activation gexp is meant to run on the target
system, so you want to use #$ (‘ungexp’) there.

You might want to use #+ when building things that can just as well be
built natively.  For instance, the background image for GRUB must be
built by running Inkscape natively on the host system, so we use
#+inkscape (or similar) to do that.

I hope that makes sense.

> Unfortunately, there are (non-container related) some more issues.
> Last few weeks I've been seeing this error (/var/log/ipfs.log):
>
> (start snip)
> Error: fs-repo requires migration
> Initializing daemon...
> go-ipfs version: 0.8.0
> Repo version: 11
> System version: amd64/linux
> Golang version: go1.14.15
> Found outdated fs-repo, migrations need to be run.
> Run migrations now? [y/N] Not running migrations of fs-repo now.
> Please get fs-repo-migrations from https://dist.ipfs.io
>
> Error: fs-repo requires migration
> (end snip)

Bah, I remember seeing that.

> Unfortunately "fs-repo-migrations" does not seem to be packaged in Guix.
> Apparently there has been a change in repo format in the go-ipfs v0.7.0
> --> v0.8.0 upgrade.  I believe for most users simply automatically running
> the upgrades would be sufficient.

Yes, I think so.  We “just” need to package ‘fs-repo-migrations’ first.

Perhaps it’d be okay, as a first step, to provide an IPFS service that
doesn’t handle migrations automatically.

> Now, how could we do this safely from shepherd?  Maybe before starting open
> a pipe, write "y\n" to it an pass it as file descriptor 0 (stdin) would
> be sufficient?  But shepherd always closes /dev/stdin before exec IIRC ..

You could have the ‘ipfs’ Shepherd service depend on, say, a one-shot
‘ipfs-migration’ service.  The ‘ipfs-migration’ service would run
‘fs-repo-migrations’ if it’s necessary.

>> The patch LGTM.  However, we usually commit services along with a system
>> test under (gnu tests …).  The manual has info on how to run individual
>> system tests:
>> 
>>   https://guix.gnu.org/manual/en/html_node/Running-the-Test-Suite.html
>> 
>> Could you write a test that ensures that basic functionality works?  It
>> could be as simple as waiting for the service to be up, then invoking
>> ‘ipfs add’ and ‘ipfs get’.  WDYT?
>
> Will look into it eventually, but I am currently occupied with other things
> that have deadlines )-:. (Not feeling very inspired for a
> writing/presentation assignment ...)  (And I would rather hack on GNUnet
> frankly; IPFS is more of a stop-gap to me for having some distributed
> something for substitutes.)  So feel free to beat me to it.

I’m not offering to work on it :-), but hopefully you or maybe some
fellow contributor can finish it up in the coming weeks!

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH] IPFS service definition
  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
  0 siblings, 2 replies; 10+ messages in thread
From: Maxime Devos @ 2021-03-28 16:36 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 45905


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

On Tue, 2021-03-23 at 14:08 +0100, Ludovic Courtès wrote:
> [...]
> Yes, I think so.  We “just” need to package ‘fs-repo-migrations’ first.
> 
> Perhaps it’d be okay, as a first step, to provide an IPFS service that
> doesn’t handle migrations automatically.
> 
> [...]

Punt for later.

> > > The patch LGTM.  However, we usually commit services along with a system
> > > test under (gnu tests …).  The manual has info on how to run individual
> > > system tests:
> > > 
> > >   https://guix.gnu.org/manual/en/html_node/Running-the-Test-Suite.html
> > > 
> > > Could you write a test that ensures that basic functionality works?  It
> > > could be as simple as waiting for the service to be up, then invoking
> > > ‘ipfs add’ and ‘ipfs get’.  WDYT?
> > 
> > [...]

I have attached a revised patch series testing such basic functionality.
However, I tested the functionality with the HTTP interface instead of
with the command line, as the CLI tools assume the IPFS daemon is run
as the same user as the CLI tools.

(IIRC there is an implementation of the CLI tools somewhere that uses
the API endpoint instead of reading/writing to ~/.ipfs, but I don't
recall where.)

I have a problem: I can't run the test I wrote.

$ make && make check-system TESTS="ipfs"
> [compilation bla bla]
> Compiling Scheme modules...
> Selected 1 system tests...
> (end of output)

For some reason, the test I wrote seems to be ignored.

(Also available from my public git repo:
<https://notabug.org/mdevos/guix-gnunet/commit/732c018b9d24f0f36700c6f8715e989ee3d94663>)

Greetings,
Maxime.

[-- Attachment #1.2: 0001-services-Add-ipfs-service-type.patch --]
[-- Type: text/x-patch, Size: 8867 bytes --]

From 1c3182dab19394748a09264b543874de1b777ec5 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/3] 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               |  33 +++++++++
 gnu/services/networking.scm | 141 ++++++++++++++++++++++++++++++++++++
 2 files changed, 174 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 74f3fbd299..9314327039 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,38 @@ 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
+;; part of the operating-system declaration
+(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.0


[-- Attachment #1.3: 0002-Add-guix-ipfs.patch --]
[-- Type: text/x-patch, Size: 10245 bytes --]

From c000adc1da40a460943dabcab6142981adfad9e9 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/3] 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.0


[-- Attachment #1.4: 0003-gnu-tests-Test-basic-funtionality-of-the-IPFS-servic.patch --]
[-- Type: text/x-patch, Size: 4425 bytes --]

From 732c018b9d24f0f36700c6f8715e989ee3d94663 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 28 Mar 2021 17:01:49 +0200
Subject: [PATCH 3/3] 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.

TODO: this test isn't run for some reason:

$ make && make check-system TESTS="ipfs"
> [compilation bla bla]
> Compiling Scheme modules...
> Selected 1 system tests...
> (end of output)

??? why isn't the IPFS test executed?

* gnu/tests/networking.scm
  (%ipfs-os): New variable.
  (run-ipfs-test): New procedure.
  (%test-ipfs): New system test.
---
 gnu/tests/networking.scm | 81 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 80 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index 022663aa67..f886eac881 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.
 ;;;
@@ -34,7 +35,8 @@
   #:use-module (gnu packages networking)
   #: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 +565,80 @@ 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 '((gnu services herd)
+                                                      (guix ipfs))
+                                 #:requirements '(ipfs)))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+
+          (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.
+          ;; By running this within the VM instead of outside the VM
+          ;; this system test does not have to forward any ports. 
+          (define (add-data data)
+            (marionette-eval
+             `((@ (guix ipfs) add-contents) ,data)))
+          (define (read-contents object)
+            (marionette-eval
+             `((@ (guix ipfs) read-contents) ,object)))
+
+          (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.0


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

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH] IPFS service definition
  2021-03-28 16:36       ` Maxime Devos
@ 2021-03-29 14:06         ` Ludovic Courtès
  2021-03-29 14:07         ` Ludovic Courtès
  1 sibling, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2021-03-29 14:06 UTC (permalink / raw)
  To: Maxime Devos; +Cc: 45905

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> TODO: this test isn't run for some reason:
>
> $ make && make check-system TESTS="ipfs"
>> [compilation bla bla]
>> Compiling Scheme modules...
>> Selected 1 system tests...
>> (end of output)
>
> ??? why isn't the IPFS test executed?

[...]

> +(define (run-ipfs-test)
> +  (define os
> +    (marionette-operating-system %ipfs-os
> +                                 #:imported-modules '((gnu services herd)
> +                                                      (guix ipfs))
> +                                 #:requirements '(ipfs)))
> +
> +  (define test
> +    (with-imported-modules '((gnu build marionette))
> +      #~(begin
> +          (use-modules (gnu build marionette)
> +                       (srfi srfi-64))
> +
> +          (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.
> +          ;; By running this within the VM instead of outside the VM
> +          ;; this system test does not have to forward any ports. 
> +          (define (add-data data)
> +            (marionette-eval
> +             `((@ (guix ipfs) add-contents) ,data)))
> +          (define (read-contents object)
> +            (marionette-eval
> +             `((@ (guix ipfs) read-contents) ,object)))
> +
> +          (test-begin "ipfs")

[...]

> +  (gexp->derivation "ipfs-test" test))

You need to add:

  (mkdir #$output)
  (chdir #$output)

right before (test-begin "ipfs").

Failing to do that, you create “ipfs-test.drv” as a zero-output
derivation—i.e., a derivation that doesn’t produce any output.  Since it
produces nothing, the daemon doesn’t bother running its code.

Nitpick: please avoid ‘@’.  Instead, explicitly do:

  (marionette-eval '(use-modules (ipfs)) marionette)

Alternatively, you can arrange to set up port forwarding for the VM and
use the (ipfs) module from the host rather than from the guest.  This is
what (gnu tests ssh) does, for example.

As it stands, the test fails because you need to:

  (define test
    (with-extensions (list guile-json)
      …))

so that Guile-JSON is available, and probably also:

  (with-imported-modules '((ipfs))
    …)

The rest LGTM.

HTH!

Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH] IPFS service definition
  2021-03-28 16:36       ` Maxime Devos
  2021-03-29 14:06         ` Ludovic Courtès
@ 2021-03-29 14:07         ` Ludovic Courtès
  1 sibling, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2021-03-29 14:07 UTC (permalink / raw)
  To: Maxime Devos; +Cc: 45905

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> TODO: this test isn't run for some reason:
>
> $ make && make check-system TESTS="ipfs"
>> [compilation bla bla]
>> Compiling Scheme modules...
>> Selected 1 system tests...
>> (end of output)
>
> ??? why isn't the IPFS test executed?

[...]

> +(define (run-ipfs-test)
> +  (define os
> +    (marionette-operating-system %ipfs-os
> +                                 #:imported-modules '((gnu services herd)
> +                                                      (guix ipfs))
> +                                 #:requirements '(ipfs)))
> +
> +  (define test
> +    (with-imported-modules '((gnu build marionette))
> +      #~(begin
> +          (use-modules (gnu build marionette)
> +                       (srfi srfi-64))
> +
> +          (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.
> +          ;; By running this within the VM instead of outside the VM
> +          ;; this system test does not have to forward any ports. 
> +          (define (add-data data)
> +            (marionette-eval
> +             `((@ (guix ipfs) add-contents) ,data)))
> +          (define (read-contents object)
> +            (marionette-eval
> +             `((@ (guix ipfs) read-contents) ,object)))
> +
> +          (test-begin "ipfs")

[...]

> +  (gexp->derivation "ipfs-test" test))

You need to add:

  (mkdir #$output)
  (chdir #$output)

right before (test-begin "ipfs").

Failing to do that, you create “ipfs-test.drv” as a zero-output
derivation—i.e., a derivation that doesn’t produce any output.  Since it
produces nothing, the daemon doesn’t bother running its code.

Nitpick: please avoid ‘@’.  Instead, explicitly do:

  (marionette-eval '(use-modules (ipfs)) marionette)

Alternatively, you can arrange to set up port forwarding for the VM and
use the (ipfs) module from the host rather than from the guest.  This is
what (gnu tests ssh) does, for example.

As it stands, the test fails because you need to:

  (define test
    (with-extensions (list guile-json)
      …))

so that Guile-JSON is available, and probably also:

  (with-imported-modules '((ipfs))
    …)

The rest LGTM.

HTH!

Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH v3] IPFS service definition
  2021-01-15 21:22 [bug#45905] [PATCH] IPFS service definition Maxime Devos
  2021-03-22 17:17 ` Ludovic Courtès
@ 2021-03-30 13:37 ` Maxime Devos
  2021-04-12 16:48   ` bug#45905: [PATCH] " Ludovic Courtès
  1 sibling, 1 reply; 10+ messages in thread
From: Maxime Devos @ 2021-03-30 13:37 UTC (permalink / raw)
  Cc: 45905


[-- 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 --]

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* bug#45905: [PATCH] IPFS service definition
  2021-03-30 13:37 ` [bug#45905] [PATCH v3] " Maxime Devos
@ 2021-04-12 16:48   ` Ludovic Courtès
  2021-04-12 18:35     ` [bug#45905] " Maxime Devos
  0 siblings, 1 reply; 10+ messages in thread
From: Ludovic Courtès @ 2021-04-12 16:48 UTC (permalink / raw)
  To: Maxime Devos; +Cc: 45905-done

Hi Maxime,

Apologies for the delay — I had not seen this new version.

Maxime Devos <maximedevos@telenet.be> skribis:

> 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.

[...]

> 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.

[...]

> 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'.

[...]

> 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.

Pushed all four patches as 68c9e0a56e008f19427bd213cf5b24bdd8fe5922.

Thanks!

Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#45905] [PATCH] IPFS service definition
  2021-04-12 16:48   ` bug#45905: [PATCH] " Ludovic Courtès
@ 2021-04-12 18:35     ` Maxime Devos
  0 siblings, 0 replies; 10+ messages in thread
From: Maxime Devos @ 2021-04-12 18:35 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 45905-done

On Mon, 2021-04-12 at 18:48 +0200, Ludovic Courtès wrote:
> [...]
> 
> Pushed all four patches as 68c9e0a56e008f19427bd213cf5b24bdd8fe5922.
> 
> Thanks!

Thanks!

Maxime.





^ permalink raw reply	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2021-04-12 18:37 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
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 ` [bug#45905] [PATCH v3] " Maxime Devos
2021-04-12 16:48   ` bug#45905: [PATCH] " Ludovic Courtès
2021-04-12 18:35     ` [bug#45905] " Maxime Devos

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).