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