diff mbox series

[bug#54997,09/12] services: ipfs: Use 'least-authority-wrapper'.

Message ID 20220417210453.27884-9-ludo@gnu.org
State Accepted
Headers show
Series Add "least authority" program wrapper | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Ludovic Courtès April 17, 2022, 9:04 p.m. UTC 
* 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(-)

Comments

M April 18, 2022, 9:08 a.m. UTC | #1 
Ludovic Courtès schreef op zo 17-04-2022 om 23:04 [+0200]:
> [...]
>  
>  (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)))

To simplify things later, could #:user "ipfs" and #:group "ipfs" be
added to the least-authority wrapper (and implemented in the 'least-
authority procedre)?  Then ...

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

would become simpler as it wouldn't need to fork, exec, waitpid and
dynamic-wind.  Alternatively, if associating a user and group with a
pola wrapper is problematic (*), what do you think of defining a
'system*/with-capabilities' or 'invoke/with-capabilities' in a central
location?

Greetings,
Maxime.
Ludovic Courtès April 19, 2022, 10:02 p.m. UTC | #2 
Maxime Devos <maximedevos@telenet.be> skribis:

> Ludovic Courtès schreef op zo 17-04-2022 om 23:04 [+0200]:
>> [...]
>>  
>>  (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)))
>
> To simplify things later, could #:user "ipfs" and #:group "ipfs" be
> added to the least-authority wrapper (and implemented in the 'least-
> authority procedre)?  Then ...

To me it’s setuid/setgid is beyond the scope of
‘least-authority-wrapper’.  And indeed, this place is the only one that
needs it.

> would become simpler as it wouldn't need to fork, exec, waitpid and
> dynamic-wind.  Alternatively, if associating a user and group with a
> pola wrapper is problematic (*), what do you think of defining a
> 'system*/with-capabilities' or 'invoke/with-capabilities' in a central
> location?

I’m not sure what these procedures would do.

I think we should build the house one brick at a time; this is the first
brick but I’m sure there’ll be others as we gain more experience and
clearer use cases.

Ludo’.
M April 22, 2022, 2:39 p.m. UTC | #3 
Ludovic Courtès schreef op wo 20-04-2022 om 00:02 [+0200]:
> > would become simpler as it wouldn't need to fork, exec, waitpid and
> > dynamic-wind.  Alternatively, if associating a user and group with
> > a
> > pola wrapper is problematic (*), what do you think of defining a
> > 'system*/with-capabilities' or 'invoke/with-capabilities' in a
> > central
> > location?
> 
> I’m not sure what these procedures would do.
> 
> I think we should build the house one brick at a time; this is the
> first brick but I’m sure there’ll be others as we gain more
> experience and clearer use cases.

This system*/with-capabilities brick would do the primitive-
fork+setuid+setgid+execl thing:

(define (system*/with-capabilities command #:key user group extra-
groups environment)
  ;; Exec the given command with the right authority.
  (let ((pid (primitive-fork)))
        (if (zero? pid)
           (dynamic-wind
              (const #t)
              (lambda ()
                (let ((pw (getpwnam "ipfs")))  ; TODO use 'user' and
'group', and don't change user/group when already this user/group
                  (setgroups '#())
                  (setgid (passwd:gid pw))
                  (setuid (passwd:uid pw))
                  (environ environment)
                  (apply execl command)))
              (lambda ()
                (primitive-exit 127)))
            (waitpid pid)))))

This would make this functionality available outside the ipfs service
as well.  Over time, it could be extended to support more kinds of
ambient authority, e.g. namespaces, POSIX ‘capabilities’, capability
masks to disallow gaining capabilities by runningsetuid binaries, the
file system hierarchy (with bind mounts), removing all users and groups
(on the Hurd), ...

Many of these are supported by 'least-authority-wrapper' but these POLA
wrappers require creating an additional process which seems a bit
unoptimal to me (memory- and latency-wise).

Also, having to do fork, waitpid and primitive-fork seems rather low-
level to me, so I prefer moving this code into somewhere like (gnu
build SOMEWHERE) or to keep the old make-forkexec-constructor/container
code.

Greetinsgs,
Maxime.
diff mbox series

Patch

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