summaryrefslogtreecommitdiff
path: root/guix/fixed-fcgiwrap.scm
blob: 21b39d6d07d2633099e8d7370b822ce98a18ac3c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
(define-module (fixed-fcgiwrap)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (gnu services)
  #:use-module (gnu packages admin)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages web)
  #:use-module (gnu services shepherd)
  #:use-module (guix modules)
  #:use-module (guix i18n)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #: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"))
  (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
    (($ <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 (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 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 10))
              (define start (current-time))
	      (local-output "w: waiting for file ~s" file)
              (let loop ()
                (cond
                 ((file-exists? file)
		  (local-output "w: file ~s exists" file)
		  #t)
                 ((< (current-time) (+ start max-delay))
		  (local-output "w: file ~s does not exist yet" file)
                  (sleep 1)
                  (loop))
                 (else
		   (local-output "w: file ~s: giving up" file)
		   #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
                                          fcgiwrap-accounts)))
                (default-value (fcgiwrap-configuration))))