02/09: services: Add ipfs-service-type

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 2978832b9264b89325605fe2525bc3992d753135
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Fri Jan 15 21:46:42 2021 +0100

    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.
    
    Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 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 22b4c6a..0b8180e 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
@@ -17506,6 +17507,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 231a9f6..6e93b56 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))
@@ -1878,6 +1888,137 @@ See yggdrasil -genconf for config options.")
 
 
 ;;;
+;;; 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.")))
+
+
+;;;
 ;;; Keepalived
 ;;;