From 2595ca2e738b7a886fa85272f2c3203e544e5fcf Mon Sep 17 00:00:00 2001
From: Florian Dold <florian.dold@gmail.com>
Date: Fri, 21 Dec 2018 15:47:51 +0100
Subject: fixed fcgiwrap

---
 guix/fixed-fcgiwrap.scm | 139 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 139 insertions(+)
 create mode 100644 guix/fixed-fcgiwrap.scm

(limited to 'guix/fixed-fcgiwrap.scm')

diff --git a/guix/fixed-fcgiwrap.scm b/guix/fixed-fcgiwrap.scm
new file mode 100644
index 0000000..3672a1a
--- /dev/null
+++ b/guix/fixed-fcgiwrap.scm
@@ -0,0 +1,139 @@
+(define-module (fixed-fcgiwrap)
+  #:export (fcgiwrap-configuration
+            fcgiwrap-service-type))
+
+
+;;;
+;;; Our definition of the fcgiwrap-service,
+;;; this should eventually go upstream.
+;;;
+
+
+(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"))
+  ;; boolean or octal mode integer
+  (adjusted-socket-permissions fcgiwrap-adjusted-socket-permissions?
+                               (default #f))
+  (ensure-socket-dir? fcgiwrap-ensure-socket-dir?
+                      (default #f)))
+
+(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 perm ensure-dir?)
+     (define parsed-socket (parse-fcgiwrap-socket socket))
+     (list
+      (shepherd-service
+       (provision '(fcgiwrap))
+       (documentation "Run the fcgiwrap daemon.")
+       (requirement '(networking))
+       (modules `((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 file) ; FIXME: use mkdir-p instead?
+                (let ((uid (passwd:uid (getpwnam user)))
+                      (gid (group:gid (getgrnam group))))
+                  (chown file uid gid))))
+            (define start-fcgiwrap
+              (make-forkexec-constructor
+               '(#$(file-append package "/sbin/fcgiwrap")
+                   "-s" $#socket)
+               #:user #$user
+               #:group #$group))
+            (match '#$parsed-socket
+              (('unix path)
+               ;; Clean up socket, otherwise fcgiwrap might not start properly.
+               (cleanup path)
+               (when #$ensure-dir?
+                 (ensure-socket-dir (dirname path) #$user #$group))
+               (let ((pid (start-fcgiwrap)))
+                 (cond
+                  ((wait-for-file path)
+                   (adjust-permissions path perm)
+                   pid)
+                  (else #f)))))))
+              (_ (start-fcgiwrap)))))
+       (stop #~(make-kill-destructor))))))))
+
+
+(define fcgiwrap-accounts
+  (match-lambda
+    (($ <fcgiwrap-configuration> package socket user group)
+     (filter identity
+             (list
+              (and (equal? group "fcgiwrap")
+                   (user-group
+                    (name "fcgiwrap")
+                    (system? #t)))
+              (and (equal? user "fcgiwrap")
+                   (user-account
+                    (name "fcgiwrap")
+                    (group group)
+                    (system? #t)
+                    (comment "Fcgiwrap Daemon")
+                    (home-directory "/var/empty")
+                    (shell (file-append shadow "/sbin/nologin")))))))))
+
+
+(define fcgiwrap-service-type
+  (service-type (name 'fcgiwrap)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          fcgiwrap-shepherd-service)
+                       (service-extension account-service-type
+                                          fcgiwrap-accounts)))
+                (default-value (fcgiwrap-configuration))))
-- 
cgit v1.2.3