From 3ac9c6fa536faff23291b21d4e649b85386fedfc Mon Sep 17 00:00:00 2001
From: Florian Dold <flo@dold.me>
Date: Thu, 3 Jan 2019 14:22:49 +0100
Subject: [PATCH] services: fcgiwrap: Implement additional options

The fcgiwrap service now supports logging and can be run
on a unix domain socket as unprivileged user.

* doc/guix.texi (Web Services): Document new options and replace
dangerous advice about running fcgiwrap as root.
* gnu/services/web.scm: Add the options 'log-file',
'adjusted-socket-permissions' and 'ensure-socket-dir?'.
---
 doc/guix.texi        |  26 +++++++---
 gnu/services/web.scm | 119 ++++++++++++++++++++++++++++++++++++-------
 2 files changed, 120 insertions(+), 25 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index fcb5b8c08..608dd26ca 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17756,12 +17756,26 @@ The user and group names, as strings, under which to run the
 the user asks for the specific user or group names @code{fcgiwrap} that
 the corresponding user and/or group is present on the system.
 
-It is possible to configure a FastCGI-backed web service to pass HTTP
-authentication information from the front-end to the back-end, and to
-allow @code{fcgiwrap} to run the back-end process as a corresponding
-local user.  To enable this capability on the back-end., run
-@code{fcgiwrap} as the @code{root} user and group.  Note that this
-capability also has to be configured on the front-end as well.
+Note that whoever can write to the fcgiwrap socket is effectively able to
+execute programs as the user/group running the fcgiwrap process.  It is thus
+strongly discouraged to run fcgiwrap as the @code{root} user or group.
+
+@item @code{log-file} (default: @code{#f})
+File where @command{fcgiwrap}'s output is written, or @code{#f} to not
+store the output.
+
+@item @code{adjusted-socket-permissions} (default: @code{#f})
+Only applies to @code{unix} sockets.  Adjusts the permissions of the socket
+after it has been created.  If set to an integer, it is interpreted as a
+numeric file mode.  If set to @code{#t}, it is interpreted as mode @code{#o660}
+(read and write permissions for user and group).  If set to the default
+@code{#f}, no adjustments are made.
+
+@item @code{ensure-socket-dir?} (default: @code{#f})
+Only applies to @code{unix} sockets.  If set to @code{#t} and the directory
+component of the socket path in @code{socket} does not exist yet, the
+directory is created with ownership set to the user and group running the
+fcgiwrap process.
 @end table
 @end deftp
 
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index d71fed20e..a3d435489 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -39,6 +39,7 @@
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module (guix gexp)
+  #:use-module (guix i18n)
   #:use-module ((guix store) #:select (text-file))
   #:use-module ((guix utils) #:select (version-major))
   #:use-module ((guix packages) #:select (package-version))
@@ -696,14 +697,21 @@ of index files."
 (define-record-type* <fcgiwrap-configuration> fcgiwrap-configuration
   make-fcgiwrap-configuration
   fcgiwrap-configuration?
-  (package       fcgiwrap-configuration-package ;<package>
-                 (default fcgiwrap))
-  (socket        fcgiwrap-configuration-socket
-                 (default "tcp:127.0.0.1:9000"))
-  (user          fcgiwrap-configuration-user
-                 (default "fcgiwrap"))
-  (group         fcgiwrap-configuration-group
-                 (default "fcgiwrap")))
+  (package fcgiwrap-configuration-package ;<package>
+           (default fcgiwrap))
+  (socket fcgiwrap-configuration-socket
+          (default "tcp:127.0.0.1:9000"))
+  (user fcgiwrap-configuration-user
+        (default "fcgiwrap"))
+  (group fcgiwrap-configuration-group
+         (default "fcgiwrap"))
+  (log-file fcgiwrap-log-file
+            (default #f))
+  ;; boolean or octal mode integer
+  (adjusted-socket-permissions fcgiwrap-adjusted-socket-permissions?
+                               (default #f))
+  (ensure-socket-dir? fcgiwrap-ensure-socket-dir?
+                      (default #f)))
 
 (define fcgiwrap-accounts
   (match-lambda
@@ -723,25 +731,98 @@ of index files."
                     (home-directory "/var/empty")
                     (shell (file-append shadow "/sbin/nologin")))))))))
 
+(define (parse-fcgiwrap-socket s)
+  "Parse a fcgiwrap socket specification string into '(type args ...)"
+  (cond
+   ((string-prefix? "unix:" s)
+    (list 'unix (substring s 5)))
+   ((string-prefix? "tcp:" s)
+    (match (string-match "^tcp:([.0-9]+):([0-9]+)$" s)
+      ((? regexp-match? m)
+       (list
+        'tcp
+        (match:substring m 1)
+        (string->number (match:substring m 2))))
+      (_ (error "invalid tcp socket address"))))
+   ((string-prefix? "tcp6:" s)
+    (match (string-match "^tcp6:\\[(.*)\\]:([0-9]+)$" s)
+      ((? regexp-match? m)
+       (list
+        'tcp6
+        (match:substring m 1)
+        (string->number (match:substring m 2))))
+      (_ (error "invalid tcp6 socket address"))))
+   (else (error "unrecognized socket protocol"))))
+
 (define fcgiwrap-shepherd-service
   (match-lambda
-    (($ <fcgiwrap-configuration> package socket user group)
-     (list (shepherd-service
-            (provision '(fcgiwrap))
-            (documentation "Run the fcgiwrap daemon.")
-            (requirement '(networking))
-            (start #~(make-forkexec-constructor
-                      '(#$(file-append package "/sbin/fcgiwrap")
-			  "-s" #$socket)
-		      #:user #$user #:group #$group))
-            (stop #~(make-kill-destructor)))))))
+    (($ <fcgiwrap-configuration> package socket user group log-file perm ensure-dir?)
+     (define parsed-socket (parse-fcgiwrap-socket socket))
+     (list
+      (shepherd-service
+       (provision '(fcgiwrap))
+       (documentation "Run the fcgiwrap daemon.")
+       (requirement '(networking))
+       (modules `((shepherd support) (ice-9 match) ,@%default-modules))
+       (start
+        #~(lambda args
+            (define (clean-up file)
+              (catch 'system-error
+                (lambda ()
+                  (delete-file file))
+                (lambda args
+                  (unless (= ENOENT (system-error-errno args))
+                    (apply throw args)))))
+            (define* (wait-for-file file #:key (max-delay 5))
+              (define start (current-time))
+              (let loop ()
+                (cond
+                 ((file-exists? file) #t)
+                 ((< (current-time) (+ start max-delay))
+                  (sleep 1)
+                  (loop))
+                 (else #f))))
+            (define (adjust-permissions file mode)
+              (match mode
+                (#t (chmod file #o660))
+                (n (chmod file n))
+                (#f 0)))
+            (define (ensure-socket-dir dir user group)
+              (unless (file-exists? dir)
+                (mkdir dir) ; FIXME: use mkdir-p instead?
+                (let ((uid (passwd:uid (getpwnam user)))
+                      (gid (group:gid (getgrnam group))))
+                  (chown dir uid gid))))
+            (define start-fcgiwrap
+              (make-forkexec-constructor
+               '(#$(file-append package "/sbin/fcgiwrap")
+                   "-s" #$socket)
+               #:user #$user
+               #:group #$group
+               #:log-file #$log-file))
+            (match '#$parsed-socket
+              (('unix path)
+               ;; Clean up socket, otherwise fcgiwrap might not start properly.
+               (clean-up path)
+               (when #$ensure-dir?
+                 (ensure-socket-dir (dirname path) #$user #$group))
+               (let ((pid (start-fcgiwrap))
+		     (socket-exists? (wait-for-file path)))
+		 (if socket-exists?
+		     (adjust-permissions path #$perm)
+		     (local-output
+		       #$(G_ "fcgiwrap: warning: waiting for socket ~s failed")
+		       path))
+		 pid))
+              (_ (start-fcgiwrap)))))
+       (stop #~(make-kill-destructor)))))))
 
 (define fcgiwrap-service-type
   (service-type (name 'fcgiwrap)
                 (extensions
                  (list (service-extension shepherd-root-service-type
                                           fcgiwrap-shepherd-service)
-		       (service-extension account-service-type
+                       (service-extension account-service-type
                                           fcgiwrap-accounts)))
                 (default-value (fcgiwrap-configuration))))
 
-- 
2.20.1

