(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))))