webhook: Use least-authority-wrapper.

* guix/forge/webhook.scm: Import (gnu build linux-container), (gnu
system file-systems) and (guix least-authority).
(webhook-shepherd-service): Deprecate
make-forkexec-constructor/container in favor of
least-authority-wrapper.

1 files changed, 27 insertions, 19 deletions

diff --git a/guix/forge/webhook.scm b/guix/forge/webhook.scm
index 6f42808..39bb7d0 100644
--- a/guix/forge/webhook.scm
+++ b/guix/forge/webhook.scm
@@ -19,17 +19,20 @@
 
 (define-module (forge webhook)
   #:use-module (srfi srfi-1)
+  #:use-module (gnu build linux-container)
   #:use-module ((gnu packages admin) #:select (shadow))
   #:use-module ((gnu packages guile) #:select (guile-json-4))
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system accounts)
+  #:use-module (gnu system file-systems)
   #:use-module (gnu system shadow)
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix git-download)
+  #:use-module (guix least-authority)
   #:use-module (guix build-system go)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (forge socket)
@@ -157,25 +160,30 @@ Everything else is the responsibility of the command's author.")
      (documentation "Run webhook.")
      (provision '(webhook))
      (requirement '(networking))
-     (modules '((gnu build shepherd)
-                (gnu system file-systems)))
-     (start (with-imported-modules (source-module-closure
-                                    '((gnu build shepherd)
-                                      (gnu system file-systems)))
-              #~(make-forkexec-constructor/container
-                 (list #$(file-append (webhook-configuration-package config)
-                                      "/bin/webhook")
-                       "-hooks" #$(computed-file "hooks.json"
-                                                 (hooks-json-gexp config))
-                       "-ip" #$(forge-ip-socket-ip (webhook-configuration-socket config))
-                       "-port" #$(number->string (forge-ip-socket-port (webhook-configuration-socket config)))
-                       "-logfile" #$(string-append (webhook-configuration-log-directory config)
-                                                   "/webhook.log"))
-                 #:mappings (list (file-system-mapping
-                                   (source #$(webhook-configuration-log-directory config))
-                                   (target source)
-                                   (writable? #t)))
-                 #:log-file "/var/log/webhook.log")))
+     (start
+      (let ((hooks-json (computed-file "hooks.json" (hooks-json-gexp config))))
+        #~(make-forkexec-constructor
+           (list #$(least-authority-wrapper
+                    (file-append (webhook-configuration-package config)
+                                 "/bin/webhook")
+                    #:name "webhook"
+                    #:mappings (list (file-system-mapping
+                                      (source hooks-json)
+                                      (target source))
+                                     (file-system-mapping
+                                      (source (webhook-configuration-log-directory config))
+                                      (target source)
+                                      (writable? #t)))
+                    ;; TODO: If socket is a Unix socket, run in a
+                    ;; network namespace. We can't do this yet due to
+                    ;; https://yhetil.org/guix/m1ilknoi5r.fsf@fastmail.net/
+                    #:namespaces (delq 'net %namespaces))
+                 "-hooks" #$hooks-json
+                 "-ip" #$(forge-ip-socket-ip (webhook-configuration-socket config))
+                 "-port" #$(number->string (forge-ip-socket-port (webhook-configuration-socket config)))
+                 "-logfile" #$(string-append (webhook-configuration-log-directory config)
+                                             "/webhook.log"))
+           #:log-file "/var/log/webhook.log")))
      (stop #~(make-kill-destructor)))))
 
 (define webhook-service-type