fixed fcgiwrap

2 files changed, 146 insertions, 98 deletions

diff --git a/guix/config.scm b/guix/config.scm
index 0ec90c4..e3f95fa 100644
--- a/guix/config.scm
+++ b/guix/config.scm
@@ -29,7 +29,8 @@
  (guix records)
  (guix modules)
  ((gnu packages admin) #:select (shadow shepherd))
- (taler-helpers))
+ (taler-helpers)
+ ((fixed-fcgiwrap) #:prefix fixed:))
 
 (use-system-modules nss)
 (use-service-modules networking ssh version-control cgit databases admin web shepherd)
@@ -40,97 +41,6 @@
 ;;; The GNU/Linux system that runs on gv.taler.net is defined here.
 
 
-;;;
-;;; Our definition of the fcgiwrap-service,
-;;; this should eventually go upstream.
-;;;
-
-
-(define-record-type* <my-fcgiwrap-configuration> my-fcgiwrap-configuration
-  make-my-fcgiwrap-configuration
-  my-fcgiwrap-configuration?
-  (package       my-fcgiwrap-configuration-package ;<package>
-                 (default fcgiwrap))
-  (socket        my-fcgiwrap-configuration-socket
-                 (default "tcp:127.0.0.1:9000"))
-  (user          my-fcgiwrap-configuration-user
-                 (default "fcgiwrap"))
-  (group         my-fcgiwrap-configuration-group
-                 (default "fcgiwrap")))
-
-(define (parse-fcgiwrap-socket s)
-  (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 my-fcgiwrap-shepherd-service
-  (match-lambda
-    (($ <my-fcgiwrap-configuration> package socket user group)
-     (let ((parsed-socket (parse-fcgiwrap-socket socket)))
-       (list
-        (shepherd-service
-         (provision '(fcgiwrap))
-         (documentation "Run the fcgiwrap daemon.")
-         (requirement '(networking))
-         (start (with-extensions
-                 (list shepherd)
-                 (with-imported-modules
-                  `(((shepherd-with-sock) => ,(local-file "shepherd-with-sock.scm")))
-                  #~(begin
-                      (use-modules ((shepherd-with-sock) #:prefix my:))
-                      (my:make-forkexec-constructor
-                       '(#$(file-append package "/sbin/fcgiwrap"))
-                       #:user #$user
-                       #:group #$group
-                       #:stdin-socket '#$parsed-socket)))))
-                (stop #~(make-kill-destructor))))))))
-
-
-(define my-fcgiwrap-accounts
-  (match-lambda
-    (($ <my-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 my-fcgiwrap-service-type
-  (service-type (name 'fcgiwrap)
-                (extensions
-                 (list (service-extension shepherd-root-service-type
-                                          my-fcgiwrap-shepherd-service)
-		       (service-extension account-service-type
-                                          my-fcgiwrap-accounts)))
-                (default-value (fcgiwrap-configuration))))
 
 
 
@@ -345,12 +255,11 @@
              (constraint-from '("www.gnu.org"))
              (constraints-from '("https://www.google.com/"))
              (allow-large-adjustment? #t)))
-   ;; FIXME: To be able to better test and replicate this,
-   ;; we have to replicate what's done in nginx (copy into
-   ;; store, use location in store).
-   (service my-fcgiwrap-service-type
-            (my-fcgiwrap-configuration
-             (socket "unix:/var/run/fcgiwrap.socket")))
+   (service fixed:fcgiwrap-service-type
+            (fixed:fcgiwrap-configuration
+             (socket "unix:/var/run/fcgiwrap/fcgiwrap.socket")
+             (adjusted-socket-permissions #t)
+             (ensure-socket-dir? #t)))
    ;(service cgit-service-type
    ;         (opaque-cgit-configuration
    ;          (cgitrc "/etc/deployment/guix/etc/cgitrc")))
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))))