fixed-fcgiwrap.scm (5746B)
1 (define-module (fixed-fcgiwrap) 2 #:use-module (ice-9 match) 3 #:use-module (ice-9 regex) 4 #:use-module (gnu services) 5 #:use-module (gnu packages admin) 6 #:use-module (gnu system shadow) 7 #:use-module (gnu packages web) 8 #:use-module (gnu services shepherd) 9 #:use-module (guix modules) 10 #:use-module (guix i18n) 11 #:use-module (guix records) 12 #:use-module (guix gexp) 13 #:export (fcgiwrap-configuration 14 fcgiwrap-service-type)) 15 16 17 ;;; 18 ;;; Our definition of the fcgiwrap-service, 19 ;;; this should eventually go upstream. 20 ;;; 21 22 23 (define-record-type* <fcgiwrap-configuration> fcgiwrap-configuration 24 make-fcgiwrap-configuration 25 fcgiwrap-configuration? 26 (package fcgiwrap-configuration-package ;<package> 27 (default fcgiwrap)) 28 (socket fcgiwrap-configuration-socket 29 (default "tcp:127.0.0.1:9000")) 30 (user fcgiwrap-configuration-user 31 (default "fcgiwrap")) 32 (group fcgiwrap-configuration-group 33 (default "fcgiwrap")) 34 (log-file fcgiwrap-log-file 35 (default #f)) 36 ;; boolean or octal mode integer 37 (adjusted-socket-permissions fcgiwrap-adjusted-socket-permissions? 38 (default #f)) 39 (ensure-socket-dir? fcgiwrap-ensure-socket-dir? 40 (default #f))) 41 42 (define fcgiwrap-accounts 43 (match-lambda 44 (($ <fcgiwrap-configuration> package socket user group) 45 (filter identity 46 (list 47 (and (equal? group "fcgiwrap") 48 (user-group 49 (name "fcgiwrap") 50 (system? #t))) 51 (and (equal? user "fcgiwrap") 52 (user-account 53 (name "fcgiwrap") 54 (group group) 55 (system? #t) 56 (comment "Fcgiwrap Daemon") 57 (home-directory "/var/empty") 58 (shell (file-append shadow "/sbin/nologin"))))))))) 59 60 (define (parse-fcgiwrap-socket s) 61 "Parse a fcgiwrap socket specification string into '(type args ...)" 62 (cond 63 ((string-prefix? "unix:" s) 64 (list 'unix (substring s 5))) 65 ((string-prefix? "tcp:" s) 66 (match (string-match "^tcp:([.0-9]+):([0-9]+)$" s) 67 ((? regexp-match? m) 68 (list 69 'tcp 70 (match:substring m 1) 71 (string->number (match:substring m 2)))) 72 (_ (error "invalid tcp socket address")))) 73 ((string-prefix? "tcp6:" s) 74 (match (string-match "^tcp6:\\[(.*)\\]:([0-9]+)$" s) 75 ((? regexp-match? m) 76 (list 77 'tcp6 78 (match:substring m 1) 79 (string->number (match:substring m 2)))) 80 (_ (error "invalid tcp6 socket address")))) 81 (else (error "unrecognized socket protocol")))) 82 83 84 (define fcgiwrap-shepherd-service 85 (match-lambda 86 (($ <fcgiwrap-configuration> package socket user group log-file perm ensure-dir?) 87 (define parsed-socket (parse-fcgiwrap-socket socket)) 88 (list 89 (shepherd-service 90 (provision '(fcgiwrap)) 91 (documentation "Run the fcgiwrap daemon.") 92 (requirement '(networking)) 93 (modules `((shepherd support) (ice-9 match) ,@%default-modules)) 94 (start 95 #~(lambda args 96 (define (clean-up file) 97 (catch 'system-error 98 (lambda () 99 (delete-file file)) 100 (lambda args 101 (unless (= ENOENT (system-error-errno args)) 102 (apply throw args))))) 103 (define* (wait-for-file file #:key (max-delay 10)) 104 (define start (current-time)) 105 (local-output "w: waiting for file ~s" file) 106 (let loop () 107 (cond 108 ((file-exists? file) 109 (local-output "w: file ~s exists" file) 110 #t) 111 ((< (current-time) (+ start max-delay)) 112 (local-output "w: file ~s does not exist yet" file) 113 (sleep 1) 114 (loop)) 115 (else 116 (local-output "w: file ~s: giving up" file) 117 #f)))) 118 (define (adjust-permissions file mode) 119 (match mode 120 (#t (chmod file #o660)) 121 (n (chmod file n)) 122 (#f 0))) 123 (define (ensure-socket-dir dir user group) 124 (unless (file-exists? dir) 125 (mkdir dir) ; FIXME: use mkdir-p instead? 126 (let ((uid (passwd:uid (getpwnam user))) 127 (gid (group:gid (getgrnam group)))) 128 (chown dir uid gid)))) 129 (define start-fcgiwrap 130 (make-forkexec-constructor 131 '(#$(file-append package "/sbin/fcgiwrap") 132 "-s" #$socket) 133 #:user #$user 134 #:group #$group 135 #:log-file #$log-file)) 136 (match '#$parsed-socket 137 (('unix path) 138 ;; Clean up socket, otherwise fcgiwrap might not start properly. 139 (clean-up path) 140 (when #$ensure-dir? 141 (ensure-socket-dir (dirname path) #$user #$group)) 142 (let ((pid (start-fcgiwrap)) 143 (socket-exists? (wait-for-file path))) 144 (if socket-exists? 145 (adjust-permissions path #$perm) 146 (local-output 147 #$(G_ "fcgiwrap: warning: waiting for socket ~s failed") 148 path)) 149 pid)) 150 (_ (start-fcgiwrap))))) 151 (stop #~(make-kill-destructor))))))) 152 153 (define fcgiwrap-service-type 154 (service-type (name 'fcgiwrap) 155 (extensions 156 (list (service-extension shepherd-root-service-type 157 fcgiwrap-shepherd-service) 158 (service-extension account-service-type 159 fcgiwrap-accounts))) 160 (default-value (fcgiwrap-configuration)))) 161