;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2023, 2024 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of guix-forge.
;;;
;;; guix-forge is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published
;;; by the Free Software Foundation, either version 3 of the License,
;;; or (at your option) any later version.
;;;
;;; guix-forge is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guix-forge.  If not, see
;;; <https://www.gnu.org/licenses/>.

(define-module (forge fcgiwrap)
  #:use-module (forge environment)
  #:use-module (forge socket)
  #:use-module (gnu build linux-container)
  #:use-module ((gnu packages web) #:select (fcgiwrap))
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system file-systems)
  #:use-module (guix gexp)
  #:use-module (guix least-authority)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (fcgiwrap-service-type
            fcgiwrap-configuration
            fcgiwrap-configuration?
            fcgiwrap-configuration-package
            fcgiwrap-configuration-instances
            fcgiwrap-instance
            fcgiwrap-instance?
            fcgiwrap-instance-name
            fcgiwrap-instance-socket
            fcgiwrap-instance-processes
            fcgiwrap-instance-environment-variables
            fcgiwrap-instance-mappings))

(define-record-type* <fcgiwrap-configuration>
  fcgiwrap-configuration make-fcgiwrap-configuration
  fcgiwrap-configuration?
  (package fcgiwrap-configuration-package
           (default fcgiwrap))
  (instances fcgiwrap-configuration-instances
             (default '())))

(define-record-type* <fcgiwrap-instance>
  fcgiwrap-instance make-fcgiwrap-instance
  fcgiwrap-instance?
  this-fcgiwrap-instance
  (name fcgiwrap-instance-name)
  (socket fcgiwrap-instance-socket
          (default (forge-unix-socket
                    (path (string-append "/var/run/fcgiwrap/"
                                         (fcgiwrap-instance-name this-fcgiwrap-instance)
                                         "/socket"))))
          (thunked))
  (user fcgiwrap-instance-user)
  (group fcgiwrap-instance-group)
  (processes fcgiwrap-instance-processes
             (default 1))
  (environment-variables fcgiwrap-instance-environment-variables
                         (default '()))
  (mappings fcgiwrap-instance-mappings
            (default '())))

(define (fcgiwrap-activation config)
  (with-imported-modules '((guix build utils))
    #~(begin
        (use-modules (guix build utils))

        ;; Create socket directories and set ownership.
        (for-each (match-lambda
                    ((user-name group-name socket-directory)
                     (mkdir-p socket-directory)
                     (let ((user (getpw user-name))
                           (group (getgr group-name)))
                       (chown socket-directory (passwd:uid user) (group:gid group)))))
                  '#$(filter-map (match-record-lambda <fcgiwrap-instance>
                                     (socket user group)
                                     (and (forge-unix-socket? socket)
                                          (list user
                                                group
                                                (dirname (forge-unix-socket-path socket)))))
                                 (fcgiwrap-configuration-instances config))))))

(define (socket->fcgiwrap-socket-url socket)
  "Serialize @var{socket} to URL as required by fcgiwrap."
  (match socket
    ;; KLUDGE: When passed a host socket, we assume it resolves to an
    ;; IPv4 address, not an IPv6 address.
    (($ <forge-host-socket> hostname port)
     (string-append "tcp:" hostname ":" (number->string port)))
    (($ <forge-ip-socket> (? ipv4-address? ip) port)
     (string-append "tcp:" ip ":" (number->string port)))
    (($ <forge-ip-socket> (? ipv6-address? ip) port)
     (string-append "tcp6:[" ip "]:" (number->string port)))
    (($ <forge-unix-socket> path)
     (string-append "unix:" path))))

(define (fcgiwrap-shepherd-services config)
  (map (match-record-lambda <fcgiwrap-instance>
           (name socket user group processes environment-variables mappings)
         (shepherd-service
          (documentation (string-append "Run fcgiwrap for " name " script."))
          (provision '(fcgiwrap))
          (requirement '(networking))
          (modules '((ice-9 match)))
          (start
           #~(make-forkexec-constructor
              (list #$(least-authority-wrapper
                       (file-append (fcgiwrap-configuration-package config)
                                    "/sbin/fcgiwrap")
                       #:name (string-append "fcgiwrap-" name "-pola-wrapper")
                       #:mappings (append
                                   ;; Mappings for Unix socket directories
                                   (if (forge-unix-socket? socket)
                                       (list (file-system-mapping
                                              (source (dirname (forge-unix-socket-path socket)))
                                              (target source)
                                              (writable? #t)))
                                       (list))
                                   ;; Additional mappings
                                   mappings)
                       #:preserved-environment-variables
                       (map environment-variable-name
                            environment-variables)
                       ;; TODO: If socket is a Unix socket, run in a
                       ;; network namespace. We can't do this yet due to
                       ;; https://yhetil.org/guix/m1ilknoi5r.fsf@fastmail.net/
                       #:namespaces (delq 'net %namespaces))
                    "-s" #$(socket->fcgiwrap-socket-url socket)
                    "-c" #$(number->string processes)
                    "-f")
              #:user #$user
              #:group #$group
              #:environment-variables
              (list #$@(map (lambda (variable)
                              #~(string-append #$(environment-variable-name variable)
                                               "="
                                               #$(environment-variable-value variable)))
                            environment-variables))
              #:log-file #$(string-append "/var/log/fcgiwrap/" name ".log")))
          (stop #~(make-kill-destructor))))
       (fcgiwrap-configuration-instances config)))

(define fcgiwrap-service-type
  (service-type
   (name 'fcgiwrap)
   (description "Run fcgiwrap.")
   (extensions (list (service-extension activation-service-type
                                        fcgiwrap-activation)
                     (service-extension shepherd-root-service-type
                                        fcgiwrap-shepherd-services)))
   (compose concatenate)
   (extend (lambda (config instances)
             (fcgiwrap-configuration
              (inherit config)
              (instances (append (fcgiwrap-configuration-instances config)
                                 instances)))))
   (default-value (fcgiwrap-configuration))))