unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 54997@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#54997] [PATCH 09/12] services: ipfs: Use 'least-authority-wrapper'.
Date: Sun, 17 Apr 2022 23:04:50 +0200	[thread overview]
Message-ID: <20220417210453.27884-9-ludo@gnu.org> (raw)
In-Reply-To: <20220417210453.27884-1-ludo@gnu.org>

* gnu/services/networking.scm (ipfs-binary): Call
'least-authority-wrapper'.
(%ipfs-home-mapping): Remove surrounding gexp.
(ipfs-shepherd-service)[exec-command]: New procedure.
[ipfs-config-command, set-config!-gexp, shepherd&co]
[container-gexp, container-script]: Remove.
[inner-gexp]: Use 'exec-command'.
---
 gnu/services/networking.scm | 123 +++++++++++++++++-------------------
 1 file changed, 58 insertions(+), 65 deletions(-)

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index b302be5aaf..4708ade0ca 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
@@ -43,6 +43,7 @@ (define-module (gnu services networking)
   #:use-module (gnu services dbus)
   #:use-module (gnu system shadow)
   #:use-module (gnu system pam)
+  #:use-module ((gnu system file-systems) #:select (file-system-mapping))
   #:use-module (gnu packages admin)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
@@ -59,6 +60,7 @@ (define-module (gnu services networking)
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages ipfs)
   #:use-module (gnu build linux-container)
+  #:autoload   (guix least-authority) (least-authority-wrapper)
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
@@ -2018,13 +2020,20 @@ (define %ipfs-accounts
          (system? #t))))
 
 (define (ipfs-binary config)
-  (file-append (ipfs-configuration-package config) "/bin/ipfs"))
+  (define command
+    (file-append (ipfs-configuration-package config) "/bin/ipfs"))
+
+  (least-authority-wrapper
+   command
+   #:name "ipfs"
+   #:mappings (list %ipfs-home-mapping)
+   #:namespaces (delq 'net %namespaces)))
 
 (define %ipfs-home-mapping
-  #~(file-system-mapping
-     (source #$%ipfs-home)
-     (target #$%ipfs-home)
-     (writable? #t)))
+  (file-system-mapping
+   (source %ipfs-home)
+   (target %ipfs-home)
+   (writable? #t)))
 
 (define %ipfs-environment
   #~(list #$(string-append "HOME=" %ipfs-home)))
@@ -2033,82 +2042,66 @@ (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))))))
+
+  (list (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")
+         (start #~(make-forkexec-constructor
+                   #$ipfs-daemon-command
+                   #: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 (exec-command . args)
+    ;; Exec the given ifps command with the right authority.
+    #~(let ((pid (primitive-fork)))
+        (if (zero? pid)
+            (dynamic-wind
+              (const #t)
+              (lambda ()
+                ;; 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.
+                (let ((pw (getpwnam "ipfs")))
+                  (setgroups '#())
+                  (setgid (passwd:gid pw))
+                  (setuid (passwd:uid pw))
+                  (environ #$%ipfs-environment)
+                  (execl #$(ipfs-binary config) #$@args)))
+              (lambda ()
+                (primitive-exit 127)))
+            (waitpid pid))))
+
   (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")
+        #$(exec-command "ipfs" "init")
         ;; Apply settings
-        #$@(map (cute apply set-config!-gexp <>) settings)))
+        #$@(map (match-lambda
+                  ((setting value)
+                   (exec-command "ipfs" "config" setting value)))
+                settings)))
+
   (define inner-script
     (program-file "ipfs-activation-inner" inner-gexp))
 
-  (define shepherd&co
-    ;; 'make-forkexec-constructor/container' needs version 0.9 for
-    ;; #:supplementary-groups.
-    (cons shepherd-0.9
-          (list (lookup-package-input shepherd-0.9 "guile-fibers"))))
-
-  ;; 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 shepherd&co
-      (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))
+  #~(system* #$inner-script))
 
 (define ipfs-service-type
   (service-type
-- 
2.35.1





  parent reply	other threads:[~2022-04-17 21:07 UTC|newest]

Thread overview: 54+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-04-17 21:01 [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-17 21:04 ` [bug#54997] [PATCH 01/12] gexp: Add 'references-file' Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 02/12] file-systems: Avoid load-time warnings when attempting to load (guix store) Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 03/12] linux-container: 'call-with-container' relays SIGTERM and SIGINT Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 04/12] Add (guix least-authority) Ludovic Courtès
2022-04-18  9:15     ` Maxime Devos
2022-04-19 22:04       ` [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-18  9:18     ` [bug#54997] [PATCH 04/12] Add (guix least-authority) Maxime Devos
2022-04-19 22:05       ` [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-22 20:10     ` [bug#54997] [PATCH 04/12] Add (guix least-authority) Thiago Jung Bauermann via Guix-patches via
2022-04-26 20:30       ` [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-29  3:43         ` Thiago Jung Bauermann via Guix-patches via
2022-04-26 20:48       ` Ludovic Courtès
2022-04-27 16:56         ` [bug#54997] [PATCH v2 00/15] " Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 01/15] gexp: Add 'references-file' Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 02/15] file-systems: Avoid load-time warnings when attempting to load (guix store) Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 03/15] linux-container: 'call-with-container' relays SIGTERM and SIGINT Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 04/15] linux-container: Ensure signal-handling asyncs get a chance to run Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 05/15] linux-container: Add #:child-is-pid1? parameter to 'call-with-container' Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 06/15] Add (guix least-authority) Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 07/15] services: dicod: Rewrite using 'least-authority-wrapper' Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 08/15] services: dicod: Use 'make-inetd-constructor' Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 09/15] services: bitlbee: " Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 10/15] services: ipfs: Adjust for Shepherd 0.9 Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 11/15] services: ipfs: Use 'least-authority-wrapper' Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 12/15] services: wesnothd: Grant write access to /var/run/wesnothd Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 13/15] services: wesnothd: Use 'least-authority-wrapper' Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 14/15] services: quassel: " Ludovic Courtès
2022-04-27 16:56           ` [bug#54997] [PATCH v2 15/15] services: opendht: " Ludovic Courtès
2022-05-01 20:16           ` bug#54997: [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-05-02  4:25             ` [bug#54997] " Thiago Jung Bauermann via Guix-patches via
2022-04-17 21:04   ` [bug#54997] [PATCH 05/12] services: dicod: Rewrite using 'least-authority-wrapper' Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 06/12] services: dicod: Use 'make-inetd-constructor' Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 07/12] services: bitlbee: " Ludovic Courtès
2022-04-18  9:13     ` Maxime Devos
2022-04-19 22:03       ` [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 08/12] services: ipfs: Adjust for Shepherd 0.9 Ludovic Courtès
2022-04-17 21:04   ` Ludovic Courtès [this message]
2022-04-18  9:08     ` [bug#54997] [PATCH 09/12] services: ipfs: Use 'least-authority-wrapper' Maxime Devos
2022-04-19 22:02       ` [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-22 14:39         ` Maxime Devos
2022-04-27 22:01           ` Ludovic Courtès
2022-04-28 11:29             ` Maxime Devos
2022-04-28 19:25               ` Ludovic Courtès
2022-04-28 19:52                 ` Maxime Devos
2022-04-17 21:04   ` [bug#54997] [PATCH 10/12] services: wesnothd: Grant write access to /var/run/wesnothd Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 11/12] services: wesnothd: Use 'least-authority-wrapper' Ludovic Courtès
2022-04-17 21:04   ` [bug#54997] [PATCH 12/12] services: quassel: " Ludovic Courtès
2022-04-18  9:12     ` Maxime Devos
2022-04-19 21:59       ` [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-22  5:01   ` [bug#54997] [PATCH 01/12] gexp: Add 'references-file' Thiago Jung Bauermann via Guix-patches via
2022-04-26 20:17     ` [bug#54997] [PATCH 00/12] Add "least authority" program wrapper Ludovic Courtès
2022-04-22 15:02 ` Maxime Devos
2022-04-26 20:22   ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220417210453.27884-9-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=54997@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).