;; SPDX-License-Identifier: CC0-1.0

;; Copyright (C) 2022-2024 Wojtek Kosior <koszko@koszko.org>
;;
;; Available under the terms of Creative Commons Zero v1.0 Universal.

(use-modules ((srfi srfi-1) #:select (append-map filter-map))
             (gnu)
             (koszko-org-website)
             (sheets-websites)
             (hydrilla-website)
             (hydrilla-json-schemas)
             (hydrilla-base)
             (ice-9 match)
             ;; srfi-26 provides `cut`.
             (srfi srfi-26)
             (guix records)
             ;; (guix gexp) is needed for `file-append`.
             (guix gexp)
             ;; The following 4 are needed to construct GUIX_PYTHONPATH for
             ;; Hydrilla WSGI scripts.
             (guix build-system python)
             (guix packages)
             (guix search-paths)
             (guix modules)
             ((guix utils) #:select (substitute-keyword-arguments))
             ;; The following exports account-service-type.
             (gnu system shadow)
             ((gnu system setuid) #:select (setuid-program)))
(use-package-modules web
                     python
                     version-control
                     mail
                     admin
                     tls)
(use-service-modules web
                     shepherd
                     certbot
                     mail
                     dns)

(define %here
  (getcwd))

(define* (g-string-join elements #:optional (joiner " "))
  #~(string-join (list #$@elements) #$joiner))

(define* (g-string-append #:rest args)
  #~(string-append #$@args))

(define g-symlink-exists?
  #~(lambda (path)
      (false-if-exception
       (with-input-from-file (dirname path)
         (lambda _
           (statat (current-input-port)
                   (basename path) AT_SYMLINK_NOFOLLOW))))))

(define (httpd-conf-token arg)
  (match arg
    ((? string?)
     (if (or-map (cut string-contains arg <>) '(" " "\""))
         (format #f "~s" arg)
         arg))
    ((? symbol?)
     (httpd-conf-token (symbol->string arg)))
    (_
     #~(let ((gexp-value #$arg))
         (if (string-contains gexp-value " ")
             (format #f "~s" gexp-value)
             gexp-value)))))

(define* (httpd-directive name #:rest args)
  #~(format #f "~a~%"
            #$(g-string-join (map httpd-conf-token (cons name args)))))

(define* (httpd-tag name args #:rest body)
  (let ((tag-name (httpd-conf-token name)))
    #~(format #f "<~a ~a>~%~a</~a>~%"
              #$tag-name
              #$(g-string-join (map httpd-conf-token args))
              #$(apply g-string-append body)
              #$tag-name)))

(define* (httpd-simple-wsgi-alias package wsgi-path #:key (aliased-path "/"))
  (let ((wsgi-file (file-append package wsgi-path)))
    (g-string-append
     (httpd-tag 'Files (list wsgi-file)
                (httpd-directive 'Require 'all 'granted))
     (httpd-directive 'WSGIScriptAlias aliased-path wsgi-file))))

(define-record-type* <koszko-httpd-site-conf>
  koszko-httpd-site-conf make-koszko-httpd-site-conf
  koszko-httpd-site-conf?
  (name-and-aliases     koszko-httpd-site-conf-name-and-aliases)
  (body                 koszko-httpd-site-conf-body)
  (auto-www-aliases     koszko-httpd-site-conf-auto-www-aliases
                        (default #t)))

(define* (make-virtualhost-directives site-conf #:key (tls? #f))
  (match-record site-conf <koszko-httpd-site-conf>
    (name-and-aliases body auto-www-aliases)
    (let ((name (car name-and-aliases))
          (aliases (cdr name-and-aliases)))
      `(,(httpd-directive 'ServerName name)
        ,@(map (cut httpd-directive 'ServerAlias <>)
               aliases)
        ,@(if auto-www-aliases
              (map (lambda (alias-or-name)
                     (httpd-directive
                      'ServerAlias (string-append "www." alias-or-name)))
                   name-and-aliases)
              '())
        ,(httpd-directive 'ServerAdmin "koszko@koszko.org")
        ,(httpd-tag 'If (list (format #f "%{HTTP_HOST} != '~a'" name))
                    (httpd-directive 'Redirect 'permanent "/"
                                     (format #f "http~a://~a/"
                                             (if tls? "s" "") name)))
        ,(httpd-tag 'ElseIf
                    (list (format #f "~a && (~a !~~ ~a)"
                                  (if tls? "false" "true")
                                  "%{REQUEST_URI}"
                                  "m#^/[.]well-known/acme-challenge/.*#"))
                    (httpd-directive 'Redirect 'permanent "/"
                                     (format #f "https://~a/" name)))
        ,(httpd-directive
          'Alias "/.well-known/acme-challenge" "/srv/http/acme-challenge/")
        ,@body
        ,@(if tls?
              (let ((cert-base (format #f "/etc/cert-links/guixbot_~a" name)))
                (list (httpd-directive 'SSLEngine 'on)
                      (httpd-directive 'SSLCertificateFile
                                       (string-append cert-base "/cert.pem"))
                      (httpd-directive 'SSLCertificateKeyFile
                                       (string-append cert-base "/privkey.pem"))
                      (httpd-directive 'SSLCertificateChainFile
                                       (string-append cert-base "/chain.pem"))))
              '())))))

(define (make-virtualhosts koszko-site-conf-record)
  (list (httpd-virtualhost
         "*:80"
         (make-virtualhost-directives koszko-site-conf-record))
        (httpd-virtualhost
         "*:443"
         (make-virtualhost-directives koszko-site-conf-record #:tls? #t))))

(define %all-site-confs
  (list))

(define (add-site-conf conf)
  (set! %all-site-confs (append %all-site-confs (list conf))))

(add-site-conf
 (koszko-httpd-site-conf
  (name-and-aliases '("koszko.org" "koszkonutek-tmp.pl.eu.org"))
  (body
   `(,(httpd-directive 'DocumentRoot "/srv/http/koszko.org")

     ,(httpd-directive 'Alias "/sideload" "/srv/http/koszko.org")

     ,(httpd-simple-wsgi-alias
       koszko-org-website "/share/koszko-org-website/wsgi.py")))))

(define %cgitrc-text
  (g-string-join
   `("css=/cgit-static/cgit.css"
     "logo=/cgit-static/cgit.png"
     "favicon=/cgit-static/favicon.ico"
     "js="

     ;;,(g-string-append "source-filter="
     ;;                  cgit "/lib/cgit/filters/syntax-highlighting.py")
     "snapshots=tar.gz zip"
     "project-list=/var/lib/gitolite3/projects.list"
     "remove-suffix=1"
     "virtual-root=/"

     "enable-index-links=1"
     "enable-index-owner=0"
     "footer=/var/lib/gitolite3/cgit-footer"
     "max-blob-size=100"
     "root-desc=repositories of Wojtek"

     "mimetype.gif=image/gif"
     "mimetype.html=text/html"
     "mimetype.jpg=image/jpeg"
     "mimetype.jpeg=image/jpeg"
     "mimetype.pdf=application/pdf"
     "mimetype.png=image/png"
     "mimetype.svg=image/svg+xml"

     ,(g-string-append "about-filter="
                       cgit "/lib/cgit/filters/about-formatting.sh")

     ,@(apply append
              (map (lambda (file-name)
                     (map (cut string-append "readme=:" file-name <>)
                          '(".md" ".mkd" ".rst" ".html" ".htm" ".txt" "")))
                   '("readme" "README" "install" "INSTALL")))

     "scan-path=/var/lib/gitolite3/repositories")
   "\n"))

(define %cgitrc-file
  (computed-file "cgitrc"
    #~(with-output-to-file #$output
        (lambda () (display #$%cgitrc-text)))))

(add-site-conf
 (koszko-httpd-site-conf
  (name-and-aliases '("git.koszko.org" "git.koszkonutek-tmp.pl.eu.org"
                      "git.happyhacking.pl"))
  (body
   `(;; Hachette got renamed to "Haketilo", repo moved
     ,(httpd-directive
       'Redirect 'permanent "/hachette-fixes-demo" "/haketilo-fixes-demo")
     ;; Old Hydrilla repo now also hosts Haketilo proxy and got renamed to
     ;; "haketilo-hydrilla"
     ,(httpd-directive
       'Redirect 'permanent "/pydrilla" "/haketilo-hydrilla")

     ;; Make HTTP clone happen through git-core instead of through CGit. CGit
     ;; only supports old HTTP "dumb" cloning protocol while we want the new
     ;; "smart" protocol.
     ,(httpd-tag 'Directory (list (file-append git "/libexec/git-core"))
                 (httpd-directive 'Require 'all 'granted)
                 (httpd-directive
                  'SetEnv "GIT_PROJECT_ROOT" "/var/lib/gitolite3/repositories")
                 (httpd-directive
                  'SetEnv "GIT_HTTP_EXPORT_ALL"))

     ,(httpd-directive
       'ScriptAliasMatch
       "^/(.*/(HEAD|info/refs|objects/info/[^/]+|git-upload-pack))$"
       (file-append git "/libexec/git-core/git-http-backend/$1"))

     ;; Once all git-http-backend paths got handled, handle CGit ones.
     ,(httpd-directive
       'Alias "/cgit-static" (file-append cgit "/share/cgit"))

     ,(httpd-directive
       'SetEnv "CGIT_CONFIG" %cgitrc-file)

     ,(httpd-directive
       'ScriptAlias "/" (file-append cgit "/lib/cgit/cgit.cgi/"))

     ,(httpd-tag 'Directory (list (file-append cgit "/lib/cgit/"))
                 (httpd-directive 'Options '+ExecCGI))))))

(for-each
 (lambda (name)
   (add-site-conf
    (koszko-httpd-site-conf
     (name-and-aliases (list (string-append name ".koszko.org")))
     (body
      `(,(httpd-directive
          'DocumentRoot (file-append
                         sheets-websites
                         (string-append "/share/" name "-website"))))))))
 '("sheets" "pray"))

(add-site-conf
 (koszko-httpd-site-conf
  (name-and-aliases (list "hydrillabugs.koszko.org" "hachettebugs.koszko.org"))
  (body
   `(,(httpd-directive 'DocumentRoot "/srv/http/hydrillabugs.koszko.org")

     ,(httpd-directive 'RewriteEngine 'On)

     ,(httpd-directive 'RewriteCond "%{REQUEST_METHOD}" "!GET")
     ,(httpd-directive 'RewriteRule "^(.*)$" "/hydrillabugs-archived.html"
                       "[L,R=301,QSD]")

     ,(httpd-directive 'Alias "/hydrillabugs-archived.html"
                       (local-file "./hydrillabugs-archived.html"))

     ,(httpd-directive 'RewriteRule "/uri-map.txt" "/dummy" "[L,F]")

     ;; Serve wget-archived website.
     ,(httpd-directive 'RewriteMap 'add-ext
                       "txt:/srv/http/hydrillabugs.koszko.org/uri-map.txt")

     ,(httpd-tag 'Location (list "/javascripts")
                 (httpd-directive 'ForceType "application/javascript"))

     ,(httpd-directive 'RewriteCond "%{QUERY_STRING}" "!^$")
     ,(httpd-directive 'RewriteCond "${add-ext:$1?%{QUERY_STRING}|NONE}"
                       "!NONE")
     ,(httpd-directive 'RewriteRule "^(.*)$" "${add-ext:$1?%{QUERY_STRING}}"
                       "[L,R=301]")

     ,(httpd-directive 'RewriteCond "%{QUERY_STRING}" "!^$")
     ,(httpd-directive 'RewriteRule "^(.*)$" "$1?%{QUERY_STRING}?" "[L,QSL]")

     ,(httpd-directive 'RewriteCond "%{QUERY_STRING}" "^$")
     ,(httpd-directive 'RewriteCond "${add-ext:$1|NONE}" "!NONE")
     ,(httpd-directive 'RewriteRule "^(.*)$" "${add-ext:$1}" "[L,R=301]")))))

(add-site-conf
 (koszko-httpd-site-conf
  (name-and-aliases (list "haketilo.koszko.org"))
  (body
   (list (httpd-simple-wsgi-alias
          hydrilla-website "/share/hydrilla-website/wsgi.py")))))

(define %python-path-spec-sexp
   (search-path-specification->sexp
    (guix-pythonpath-search-path (package-version (default-python)))))

(define %hydrilla-pythonpath-inputs
  (cons hydrilla-without-haketilo
        (map cadr (package-transitive-target-inputs
                   hydrilla-without-haketilo))))

(define %hydrilla-pythonpath-gexp
  (with-imported-modules (source-module-closure '((guix search-paths)))
    #~(begin
        (use-modules (guix search-paths))
        (let ((evaluated-list (evaluate-search-paths
                      (list (sexp->search-path-specification
                             '#$%python-path-spec-sexp))
                      '#$%hydrilla-pythonpath-inputs)))
          (cdar evaluated-list)))))

(add-site-conf
 (koszko-httpd-site-conf
  (name-and-aliases (list "hydrilla.koszko.org"))
  (body
   `(,(httpd-directive
       'Alias "/downloads"
       "/srv/http/hydrilla.koszko.org/downloads")

     ,(httpd-directive
       'Alias "/schemas"
       (file-append hydrilla-json-schemas "/share/hydrilla-json-schemas"))

     ,(httpd-directive 'DocumentRoot "/var/lib/hydrilla/malcontent_dirs")

     ,(httpd-tag 'Location '("~" "^/api_v[^/]+/(resource|mapping)/")
                 (httpd-directive 'ForceType 'application/json))

     ,(httpd-directive
       'SetEnvIf 'Request_URI "^/(api_v[0-9]+)/"
       "MALCONENT_DIR=/var/lib/hydrilla/malcontent_dirs/$1")

     ,(httpd-directive
       'SetEnvIf 'Request_URI "^/api_v[0-9]+/"
       (g-string-append "HYDRILLA_GUIX_PYTHONPATH=" %hydrilla-pythonpath-gexp))

     ,(httpd-directive
       'WSGIScriptAliasMatch
       "^/api_v[^/]+/((resource|mapping)/[^/]+[.]json|query|list_all)$"
       (g-string-append (local-file (string-append %here "/hydrilla-wsgi.py"))
                        "/$1"))))))

(add-site-conf
 (koszko-httpd-site-conf
  (name-and-aliases (list "hydrillarepos.koszko.org"))
  (auto-www-aliases #f)
  (body
   `(,(httpd-directive 'DocumentRoot "/srv/http/hydrillarepos.koszko.org")

     ,(httpd-directive 'Options '+Indexes)))))

(add-site-conf
 (koszko-httpd-site-conf
  (name-and-aliases (list "test4.koszko.org"))
  (auto-www-aliases #f)
  (body
   `(,(httpd-directive 'DocumentRoot "/srv/http/test")))))

(define %ssl-module
  (httpd-module
   (name "ssl_module")
   (file (file-append httpd "/modules/mod_ssl.so"))))

(define %cgid-module
  (httpd-module
   (name "cgid_module")
   (file (file-append httpd "/modules/mod_cgid.so"))))

(define %wsgi-module
  (httpd-module
   (name "wsgi_module")
   (file (file-append mod-wsgi "/modules/mod_wsgi.so"))))

(define %proxy-http-modules
  (list (httpd-module
         (name "proxy_module")
         (file (file-append httpd "/modules/mod_proxy.so")))
        (httpd-module
         (name "proxy_http_module")
         (file (file-append httpd "/modules/mod_proxy_http.so")))))

(define %rewrite-module
  (httpd-module
   (name "rewrite_module")
   (file (file-append httpd "/modules/mod_rewrite.so"))))

;; logio is needed for the '%O' log format directive
(define %logio-module
  (httpd-module
   (name "logio_module")
   (file (file-append httpd "/modules/mod_logio.so"))))

(define %logformat-combined
  "\"%h %l %u %t \\\"%r\\\" %>s %O \\\"%{Referer}i\\\" \\\"%{User-Agent}i\\\"\"")

(define koszko-httpd-service-type
  (service-type
   (inherit httpd-service-type)
   (extensions (filter
                (lambda (ext)
                  (not (eq? (service-extension-target ext)
                            account-service-type)))
                (service-type-extensions httpd-service-type)))))

(define %koszko-httpd-service
  (service
   koszko-httpd-service-type
   (httpd-configuration
    (config
     (httpd-config-file
      (server-name "koszko.org")
      (listen '("80" "443"))
      (error-log "/var/log/httpd/error.log")
      (modules `(,%ssl-module
                 ,%cgid-module
                 ,%wsgi-module
                 ,@%proxy-http-modules
                 ,%rewrite-module
                 ,%logio-module
                 ,@%default-httpd-modules))
      (extra-config
       (list
        (string-join `("LogFormat" ,%logformat-combined "combined")) "\n"
        "CustomLog /var/log/httpd/access.log combined" "\n"
        "ScriptSock /var/run/cgid.sock" "\n")))))))

(define (extension-of-type? ext type)
  (eq? (service-type-name (service-extension-target ext))
       (service-type-name type)))

(define %all-site-domains
  (map (match-record-lambda <koszko-httpd-site-conf>
         (name-and-aliases auto-www-aliases)
         (let ((www-aliases (map (cut string-append "www." <>)
                                 (if auto-www-aliases name-and-aliases '()))))
           (append name-and-aliases www-aliases)))
       %all-site-confs))

(define %all-site-cert-names
  (map (lambda (domains)
         (format #f "guixbot_~a" (car domains)))
       %all-site-domains))

(define %g-certsaccess-gid
  #~(group:gid (getgrnam "certsaccess")))

(define %setup-ca-gexp
  #~(begin
      (use-modules (guix build utils))

      (define initial-umask
        (umask))

      (mkdir-p "/etc/self-issued/")

      (umask #o027)

      (for-each (lambda (path)
                  (mkdir-p path)
                  (chown path 0 #$%g-certsaccess-gid))
                '("/etc/cert-links" "/etc/self-issued/certs"))

      (umask #o266)

      (unless (file-exists? "/etc/self-issued/ca-key.pem")
        (copy-file #$(local-file "./test-ca-key.pem")
                   "/etc/self-issued/ca-key.pem"))

      (umask #o022)

      (unless (file-exists? "/etc/self-issued/ca-cert.pem")
        (copy-file #$(local-file "./test-ca-cert.pem")
                   "/etc/self-issued/ca-cert.pem"))))

(define g-activate-certs
  (with-imported-modules '((guix build utils))
    #~(lambda (cert-names domain-lists)
        (use-modules (guix build utils)
                     (ice-9 format)
                     (ice-9 textual-ports))

        (define (issue-cert cert-name domains)
          (let* ((cert-dir (format #f "/etc/self-issued/certs/~a" cert-name))
                 (cert-path (format #f "~a/cert.pem" cert-dir))
                 (chain-path (format #f "~a/chain.pem" cert-dir))
                 (fullchain-path (format #f "~a/fullchain.pem" cert-dir))
                 (privkey-path (format #f "~a/privkey.pem" cert-dir))
                 (csr-path (format #f "~a/csr.pem" cert-dir))
                 (openssl (string-append #$openssl "/bin/openssl"))
                 (initial-umask (umask)))
            (unless (false-if-exception (> (stat:gid (stat cert-path)) 0))
              ;; Prepare the directory and private key.
              (umask #o027)
              (mkdir-p cert-dir)
              (system* openssl "genrsa" "-out" privkey-path "2048")

              ;; Make cert.pem and chain.pem.
              (with-output-to-file "/tmp/sth"
                (lambda _
                  (display (format #f "subjectAltName=~{DNS:~a~^,~}"
                                   domains))))
              (system* openssl "req"
                       "-new" "-nodes" "-out" csr-path "-key" privkey-path
                       "-subj" "/CN=My Server/C=PL/ST=PL/L=Krakow/O=Koszko"
                       "-addext" (format #f "subjectAltName=~{DNS:~a~^,~}"
                                         domains))
              (system* openssl "x509"
                       "-req" "-in" csr-path "-copy_extensions=copyall"
                       "-CA" "/etc/self-issued/ca-cert.pem"
                       "-CAkey" "/etc/self-issued/ca-key.pem" "-CAcreateserial"
                       "-out" cert-path "-days" "3650" "-sha256")
              (copy-file "/etc/self-issued/ca-cert.pem" chain-path)

              ;; Concatenate cert.pem and chain.pem into fullchain.pem.
              (with-output-to-file fullchain-path
                (lambda _
                  (for-each (lambda (part)
                              (call-with-input-file part
                                (lambda (port)
                                  (display (get-string-all port)))))
                            (list cert-path chain-path))))

              ;; Correct permissions.
              (chmod privkey-path #o640)
              (for-each (lambda (path)
                          (chown path 0 #$%g-certsaccess-gid))
                        (list cert-dir
                              privkey-path
                              cert-path
                              chain-path
                              fullchain-path))
              (umask initial-umask))))

        (for-each (lambda (cert-name domains)
                    (let* ((link-name (format #f "/etc/cert-links/~a"
                                              cert-name))
                           (tmp-link-name (format #f "~a.newlink" link-name))
                           (letsencrypt-target-name
                            (format #f "/etc/letsencrypt/live/~a" cert-name))
                           (self-issued-target-name
                            (format #f "/etc/self-issued/certs/~a" cert-name)))
                      (when (#$g-symlink-exists? tmp-link-name)
                        (delete-file tmp-link-name))
                      (if (file-exists? letsencrypt-target-name)
                          (symlink letsencrypt-target-name tmp-link-name)
                          (begin
                            (issue-cert cert-name domains)
                            (symlink self-issued-target-name tmp-link-name)))
                      (rename-file tmp-link-name link-name)))
                  cert-names domain-lists))))

(define (make-httpd-deploy-hook cert-name domains)
  (program-file
   "httpd-deploy-hook"
   #~(begin
       (define %cert-name
         #$cert-name)

       (define %domains
         '#$domains)

       (for-each (lambda (subdir)
                   (system* "chgrp" "-R" "certsaccess"
                            (format #f "/etc/letsencrypt/~a/~a"
                                    subdir %cert-name)))
                 '("live" "archive"))

       (system* "find" (format #f "/etc/letsencrypt/archive/~a" %cert-name)
                "-name" "privkey1.pem"
                "-exec" "chmod" "640" "{}" ";")

       (#$g-activate-certs (list %cert-name) (list %domains))

       (let ((pid (call-with-input-file "/var/run/httpd" read)))
         (if pid
             (kill pid SIGHUP)
             #t)))))

(define %certbot-token-filename-gexp
  #~(format #f "/srv/http/acme-challenge/~a" (getenv "CERTBOT_TOKEN")))

(define %koszko-certbot-auth-hook
  (program-file
   "cert-auth-hook"
   (with-imported-modules '((guix build utils))
     #~(begin
         (use-modules (guix build utils))
         (let ((filename #$%certbot-token-filename-gexp))
           (mkdir-p (dirname filename))
           (with-output-to-file filename
             (lambda () (display (getenv "CERTBOT_VALIDATION")))))))))

(define %koszko-certbot-cleanup-hook
  (program-file
   "cert-cleanup-hook"
   #~(delete-file #$%certbot-token-filename-gexp)))

(define (adapt-certbot-shepherd-root-extension ext)
  ;; Make certbot independent of Nginx.
  (let ((old-activation (service-extension-compute ext)))
    (define (new-activation certbot-config)
      (cons
       ;; Dummy Nginx shepherd service will prevent reloading in certbot from
       ;; throwing "&service-not-found-error: nginx".
       (shepherd-service
        (provision '(nginx))
        (one-shot? #t)
        (start #~(const #t))
        (documentation "Provide dummy Nginx.")
        (actions
         (list
          (shepherd-action
           (name 'reload)
           (documentation "Dummy reload")
           (procedure #~(const #t))))))

       (map (lambda (shepherd-service-record)
              (shepherd-service
               (inherit shepherd-service-record)
               (requirement '(httpd))))
            (old-activation certbot-config))))

    (service-extension shepherd-root-service-type new-activation)))

(define koszko-certbot-service-type
  (service-type
   (inherit certbot-service-type)
   (name 'koszko-certbot)
   ;; Prevent certbot from pulling in Nginx — we use Apache here.
   (extensions (filter-map
                (lambda (ext)
                  (cond ((extension-of-type? ext nginx-service-type)
                         #f)
                        ((extension-of-type? ext shepherd-root-service-type)
                         (adapt-certbot-shepherd-root-extension ext))
                        (else
                         ext)))
                (service-type-extensions certbot-service-type)))))

(define %koszko-certificate-configurations
  (map (lambda (cert-name domains)
         (certificate-configuration
          (name cert-name)
          (domains domains)
          (challenge "http")
          (authentication-hook %koszko-certbot-auth-hook)
          (cleanup-hook %koszko-certbot-cleanup-hook)
          (deploy-hook (make-httpd-deploy-hook cert-name domains))))
       %all-site-cert-names %all-site-domains))

(define %koszko-certbot-service
  (service koszko-certbot-service-type
           (certbot-configuration
            (email "koszko@koszko.org")
            (rsa-key-size 4096)
            (certificates %koszko-certificate-configurations))))

(define %koszko-certs-activation-service
  (simple-service 'koszko-certs-activation-service
                  activation-service-type
                  #~(begin
                      #$%setup-ca-gexp
                      (#$g-activate-certs '#$%all-site-cert-names
                                          '#$%all-site-domains))))

(define exim-configuration-config-file
  (@@ (gnu services mail) exim-configuration-config-file))

(define exim-configuration-package
  (@@ (gnu services mail) exim-configuration-package))

(define (adapt-exim-activation-extension ext)
  ;; Make exim logs accessible under /var/log/exim and include current
  ;; configuration from /etc/exim.conf.
  (let ((old-activation (service-extension-compute ext)))
    (define (new-activation exim-config)
      #~(begin
          ;; There's unfortunately no option to tell file-exist? or stat not to
          ;; follow symlinks, hence we use statat...
          (unless (#$g-symlink-exists? "/var/log/exim")
            (symlink "../spool/exim/log" "/var/log/exim"))
          ;; Exim often rereads its config file. Let's substitute it
          ;; atomiacally.
          (with-output-to-file "/etc/exim.conf.new"
            (lambda _
              (format #t "
exim_user = exim
exim_group = exim
exim_path = /run/setuid-programs/exim
.include ~a"
                      #$(exim-configuration-config-file exim-config))))
          (rename-file "/etc/exim.conf.new" "/etc/exim.conf")
          #$(old-activation exim-config)))

    (service-extension activation-service-type new-activation)))

(define (adapt-exim-shepherd-extension ext)
  ;; Make exim daemon use /etc/exim.conf which we made include the real config
  ;; file.
  (let ((old-activation (service-extension-compute ext)))
    (define (new-activation exim-config)
      (let ((exim-package (exim-configuration-package exim-config)))
        (map (lambda (shepherd-service-record)
               (shepherd-service
                (inherit shepherd-service-record)
                (start #~(make-forkexec-constructor
                          '(#$(file-append exim-package "/bin/exim")
                            "-bd" "-v")))))
             (old-activation exim-config))))

    (service-extension shepherd-root-service-type new-activation)))

(define koszko-exim-service-type
  (service-type
   (inherit exim-service-type)
   (extensions (filter-map
                (lambda (ext)
                  (cond
                   ((extension-of-type? ext account-service-type)
                    ;; Avoid double declaration of "exim" user and group.
                    #f)
                   ((extension-of-type? ext activation-service-type)
                    (adapt-exim-activation-extension ext))
                   ((extension-of-type? ext shepherd-root-service-type)
                    (adapt-exim-shepherd-extension ext))
                   (else
                    ext)))
                (service-type-extensions exim-service-type)))))

(define koszko-adapted-exim
  (package/inherit exim
    (arguments
     (substitute-keyword-arguments
         (package-arguments exim)
       ((#:phases phases)
        #~(modify-phases #$phases
            (add-after 'configure 'configure*
              (lambda _
                (substitute* "Local/Makefile"
                  (("# (SUPPORT_MAILDIR=yes)" all line)
                   line)
                  (("(EXIM_USER=).*" all var)
                   (string-append var "106\n"))
                  (("# (EXIM_GROUP=).*" all var)
                   (string-append var "113\n")))))
            (add-after 'install 'symlink-config-file
              (lambda _
                (let ((config-path (string-append #$output "/etc/exim.conf")))
                  (delete-file config-path)
                  (symlink "/etc/exim.conf" config-path))))))))))

(define %koszko-exim-service
  (service koszko-exim-service-type
           (exim-configuration
            (package koszko-adapted-exim)
            (config-file (local-file "./exim.conf")))))

(define %koszko-mail-aliases-service
  (service mail-aliases-service-type
           '(("mailer-daemon" "postmaster")
             ("postmaster" "root")
             ("nobody" "root")
             ("hostmaster" "root")
             ("usenet" "root")
             ("news" "root")
             ("webmaster" "root")
             ("www" "root")
             ("ftp" "root")
             ("abuse" "root")
             ("noc" "root")
             ("security" "root")
             ("root" "urz")
             ("dmarc" "urz")
             ("admin" "urz")
             ("wk" "urz")
             ("koszko" "urz")
             ("my-contribution-is-licensed-cc0" "urz"))))

(define koszko-dovecot-service-type
  (service-type
   (inherit dovecot-service-type)
   (extensions (filter-map
                (lambda (ext)
                  (cond
                   ((extension-of-type? ext account-service-type)
                    ;; Avoid double declaration of "dovecot" and "dovenull"
                    ;; users and groups.
                    #f)
                   (else
                    ext)))
                (service-type-extensions dovecot-service-type)))))

(define %koszko-dovecot-service
  (service koszko-dovecot-service-type
           (dovecot-configuration
            (services (list (service-configuration
                             (kind "imap-login")
                             (listeners (list (inet-listener-configuration
                                               (protocol "imaps")
                                               (port 993)
                                               (ssl? #t))))
                             ;; '1' is more secure than '0' because each
                             ;; connection is handled in a separate process.
                             (service-count 1))
                            (service-configuration
                             (kind "imap"))
                            (service-configuration
                             (kind "auth")
                             (listeners (list (unix-listener-configuration
                                               (path "auth-userdb"))))
                             ;; Dovecot requires process-limit to be 1 here.
                             (service-count 0)
                             (process-limit 1))))
            (ssl-cert "</etc/cert-links/guixbot_koszko.org/fullchain.pem")
            (ssl-key "</etc/cert-links/guixbot_koszko.org/privkey.pem")
            (auth-mechanisms '("plain" "login"))
            (passdbs (list (passdb-configuration
                            (driver "passwd-file")
                            (args '("scheme=SHA256-CRYPT"
                                    "username_format=%u"
                                    "/etc/dovecot/users")))))
            (userdbs (list (userdb-configuration
                            (driver "passwd-file")
                            (args '("username_format=%u"
                                    "/etc/dovecot/users")))))
            (mail-location "maildir:~/Maildir"))))

(define (make-zone-entries domain)
  (define-zone-entries entries
    ;; nameservers
    ("@" "" "IN" "NS" "vps-93-95-227-159.1984.is.")
    ("@" "" "IN" "NS" "ns0.1984.is.")
    ("@" "" "IN" "NS" "ns1.1984.is.")
    ("@" "" "IN" "NS" "ns2.1984.is.")
    ("@" "" "IN" "NS" "ns1.1984hosting.com.")
    ("@" "" "IN" "NS" "ns2.1984hosting.com.")
    ;; domain->IP assignments
    ("*.ctftilde" "" "IN" "CNAME" "ctftilde")
    ("ctftilde" "" "IN" "A" "127.0.0.1")
    ("ctftilde" "" "IN" "AAAA" "::1")

    ("antioch" "" "IN" "A" "188.68.236.76")
    ("antioch" "" "IN" "AAAA" "fe80::216:3eff:feb0:4e18")

    ("hachettebugs" "" "IN" "CNAME" "antioch")
    ("www.hachettebugs" "" "IN" "CNAME" "antioch")
    ("hydrillabugs" "" "IN" "CNAME" "antioch")
    ("www.hydrillabugs" "" "IN" "CNAME" "antioch")
    ("imap" "" "IN" "CNAME" "antioch")
    ("pray" "" "IN" "CNAME" "antioch")
    ("www.pray" "" "IN" "CNAME" "antioch")
    ("sheets" "" "IN" "CNAME" "antioch")
    ("www.sheets" "" "IN" "CNAME" "antioch")
    ("smtp" "" "IN" "CNAME" "antioch")

    ("old" "" "IN" "A"     "93.95.227.159")
    ("old" "" "IN" "AAAA"  "fe80::5054:5dff:fe5f:e39f")

    ("@"    "" "IN" "A" "188.68.236.76")
    ("@"    "" "IN" "AAAA" "fe80::216:3eff:feb0:4e18")
    ("*"    "" "IN" "CNAME" "old")
    ;; mail
    ("@"      "" "IN" "MX 10" "smtp.koszko.org.")
    ;; dmarc
    ("@"      "" "IN" "TXT"   "\"v=spf1 ip4:93.95.227.159 ip6:fe80::5054:5dff:fe5f:e39f ip4:188.68.236.76 ip6:fe80::216:3eff:feb0:4e18 -all\"")
    ("_dmarc" "" "IN" "TXT"   "\"v=DMARC1;p=reject;rua=mailto:dmarc@koszko.org;ruf=mailto:dmarc@koszko.org;rf=afrf;pct=100\"")

    ("mail._domainkey" "" "IN" "TXT" "(
     \"k=rsa;t=s;p=MIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAx0kXNRIL\"
     \"VRDaU1iPdUu2FwX+pRbNS4DwojiOYznESt1npY8LzYV3MBKf2XXOSl+6Ui8Jy91V\"
     \"KzoUqwN9Rh6vdsLYPaMMtPUe/gN1AOqyF4qYqz499VZqRLmoPyq4EV5eRSqbDeDb\"
     \"eDOaoJ0+ZJHG6qg2eAz1v2U++lsSRTOkXe3xZFxrHRrvXg5JVl5DNGRKBjotwW8O\"
     \"EMhwUa2LbmJA/EbbCWhXfmaIEwqP2LRUF2HqFMSr4IHHopcTKQwpSwbsOGYG8MV1\"
     \"c5HelO+OROpuUNPE8YoKVHKwfWdwgStrrkSYK+H5JQvJgFvyfsyePfXfqszde+4B\"
     \"EC34ScPW86HKmw4JltFpBCiBThYdD0fu8g5mQzdtwNUbCcPkuUDrUTA4TE44ScHO\"
     \"VYDX0QWaUubrsf5F1+bwyTKuzbUHXnbXw7r7JLC2P4CjtsS4MLYjrfeQ3TIEdj+s\"
     \"WtWVItIVQnFRuSTFmHKqnWNDSjmTeH5m8FWPQeDjXRj2e1f5vCrfIvyXTzWvOeIw\"
     \"DU2QfyUPUKaL9hvNvX9S3G45qM/CH5UTRc2BC0dFZHBNR/uLTGMYaatfw2QAxQzs\"
     \"cmw34IgwLGswxFj3iaDwc8d3Uh+JamFBf+GUrwjRs/sVRRiXrB+qKwlxckzWHVbV\"
     \"oABCxjKDmvE86L3kCQ+MobG0BOtFBR4BqU8CAwEAAQ==\"
     )")

    ("mail-antioch._domainkey" "" "IN" "TXT" "(
     \"k=rsa;t=s;p=MIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAsC9HfcId\"
     \"QGcBzYtBzv/VF7vPrRAASwfeAJ3pr0tddpYtFMGGm8kWPAKykX2LvP4epQPdzGL9\"
     \"W9qLJk3R+iJSlUYLgP1s4Tr5qiUm/PEHPnjzwC8kqtJ/CrQs7WLfiuE3SElWI3iQ\"
     \"FMRCD1Kk07axSOCgLbshthEAxZQqScYiZT7Irl4SHm9SpTUJkqh5xcCTqsW1yuG/\"
     \"YWbfERH4PFp2pA85ZZvVEHqd+e8LMLh9EKMYRbhp9AVKMaESIegkO0RZv0KGp4aU\"
     \"vzquG1FYQ9VOJ6KiviZANuEL4cpNrqmFb4Wbuwc6w7drWaHjFT/j1mS/eB0DN3el\"
     \"nPQnWMTJZPhqnFZKzG37P5VkIDjbcotevsBGV28gx3VJNf1ye1x/P9f4fJw2s7EY\"
     \"izNZx9/xfmAiOpP3KhrpE+cccBWnMHYyp0X7ClgBIQTDiLOBX3KhH+GOuADMcum1\"
     \"4y8SHw2xSYGGk46YI0fBf8kaJsAA9wBQvuBFSj1MjxjdWt0GF0OLnGB1RsPZx+nU\"
     \"Q+EZz0PDuv16ofN7MaOfY+kD6XoBCDjj4FDqLOgBgoLS7LfLyYTElbuItj12Yqph\"
     \"ZPY4I+Lmn9nzl3tEnUqtRNu5LPhIR9mj/4BLp2UPgkVnqTAcA+qxoJghm8hh9AS9\"
     \"2pelav0CarwwvUo09rcvujksuwy8TulK8ckCAwEAAQ==\"
     )")

    ((string-append domain "._report._dmarc") "" "IN" "TXT" "\"v=DMARC1\""))

  entries)

(define %koszko-org-zone-configuration
  (knot-zone-configuration
   (domain "koszko.org")
   (zone (zone-file
          (origin "koszko.org")
          (entries (make-zone-entries "koszko.org"))
          (ns "vps-93-95-227-159.1984.is.")
          (mail "koszko")
          (serial 2024042902)))
   (acl '("allow-axfr-from-1984"))
   (semantic-checks? #t)
   (notify '("1984-axfr-remote"))))

(define %koszkonutek-tmp.pl.eu.org-zone-configuration
  (knot-zone-configuration
   (domain "koszkonutek-tmp.pl.eu.org")
   (zone (zone-file
          (origin "koszkonutek-tmp.pl.eu.org")
          (entries (make-zone-entries "koszkonutek-tmp.pl.eu.org"))
          (ns "vps-93-95-227-159.1984.is.")
          (mail "wk")
          (serial 2024042902)))
   (acl '("allow-axfr-from-1984"))
   (semantic-checks? #t)
   (notify '("1984-axfr-remote"))))

(define knot-configuration-knot
  (@@ (gnu services dns) knot-configuration-knot))

(define knot-config-file
  (@@ (gnu services dns) knot-config-file))

(define (knot-config-file-with-logging knot-config)
  (computed-file "knot-with-logging.conf"
    #~(with-output-to-file #$output
        (lambda _
          (use-modules (ice-9 textual-ports))
          (call-with-input-file #$(knot-config-file knot-config)
            (lambda (port)
              (display (get-string-all port))))
          (newline)
          (display "\
log:
  - target: syslog
")))))

(define (adapt-knot-shepherd-extension ext)
  ;; Make knot daemon log to syslog.
  (let ((old-activation (service-extension-compute ext)))
    (define (new-activation knot-config)
      (let* ((knot-package (knot-configuration-knot knot-config))
             (config-file (knot-config-file-with-logging knot-config)))
        (map (lambda (shepherd-service-record)
               (shepherd-service
                (inherit shepherd-service-record)
                (start #~(make-forkexec-constructor
                          '(#$(file-append knot-package "/sbin/knotd")
                            "-c" #$config-file)))))
             (old-activation knot-config))))

    (service-extension shepherd-root-service-type new-activation)))

(define koszko-knot-service-type
  (service-type
   (inherit knot-service-type)
   (extensions (map (lambda (ext)
                      (if (extension-of-type? ext shepherd-root-service-type)
                          (adapt-knot-shepherd-extension ext)
                          ext))
                    (service-type-extensions knot-service-type)))))

(define %koszko-knot-service
  (service koszko-knot-service-type
           (knot-configuration
            (acls (list (knot-acl-configuration
                         (id "allow-axfr-from-1984")
                         (address '("93.95.224.6"))
                         (action '(transfer)))))
            (remotes (list (knot-remote-configuration
                            (id "1984-axfr-remote")
                            (address '("93.95.224.6")))))
            (zones (list %koszko-org-zone-configuration
                         %koszkonutek-tmp.pl.eu.org-zone-configuration)))))

(operating-system
  (host-name "koszko")
  (timezone "Europe/Warsaw")
  (groups (cons*
           ;; Some groups must have explicit ids so that the host can provide
           ;; files that are readable by certain daemons and not readable by the
           ;; world.
           (user-group
            (name "exim")
            (id 113)
            (system? #t))
           (user-group
            (name "dovecot")
            (id 115)
            (system? #t))
           (user-group
            (name "dovenull")
            (id 116)
            (system? #t))
           (user-group
            (name "httpd")
            (id 133)
            (system? #t))
           (user-group
            (name "gitolite3")
            (id 118)
            (system? #t))
           (user-group
            (name "certsaccess")
            (id 1001)
            (system? #t))
           (user-group
            (name "urz")
            (id 1000))
           (user-group
            (name "joanna")
            (id 1003))
           %base-groups))
  (users (cons*
          (user-account
           (name "exim")
           (group "exim")
           (supplementary-groups '("certsaccess"))
           (uid 106)
           (system? #t)
           (comment "Exim daemon user")
           (home-directory "/var/empty")
           (shell (file-append shadow "/sbin/nologin")))
          (user-account
           (name "dovecot")
           (group "dovecot")
           (supplementary-groups '("certsaccess"))
           (uid 108)
           (system? #t)
           (comment "Dovecot daemon user")
           (home-directory "/var/empty")
           (shell (file-append shadow "/sbin/nologin")))
          (user-account
           (name "dovenull")
           (group "dovenull")
           (uid 109)
           (system? #t)
           (comment "Dovecot daemon login user")
           (home-directory "/var/empty")
           (shell (file-append shadow "/sbin/nologin")))
          (user-account
           (name "httpd")
           (group "httpd")
           (supplementary-groups '("gitolite3" "certsaccess"))
           (system? #t)
           (comment "Apache daemon user")
           (home-directory "/var/empty")
           (shell (file-append shadow "/sbin/nologin")))
          ;; The gitolite user must also have an id that matches the respective
          ;; host user's one — otherwise the cgit CGI process floods logs with
          ;; an error about being unable to determine permissions of some
          ;; files...
          (user-account
           (name "gitolite3")
           (group "gitolite3")
           (uid 110)
           (system? #t)
           (comment "Gitolite3")
           (home-directory "/var/empty")
           (shell (file-append shadow "/sbin/nologin")))
          (user-account
           (name "urz")
           (group "urz")
           (supplementary-groups '("cdrom" "floppy" "audio" "video" "netdev"))
           (uid 1000))
          (user-account
           (name "joanna")
           (group "joanna")
           (uid 1001))
          %base-user-accounts))
  (file-systems (cons (file-system
                        (device (file-system-label "does-not-matter"))
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
  (bootloader (bootloader-configuration
               (bootloader grub-bootloader)
               (targets '("/dev/sdDOES-NOT-MATTER"))))
  (setuid-programs
   (cons* (setuid-program
           (program (file-append koszko-adapted-exim "/bin/exim")))
          %setuid-programs))
  (packages (append (specifications->packages
                     '("nss-certs"
                       "file"
                       "net-tools"
                       "man-pages-posix"))
                    %base-packages))
  (services
   (cons* %koszko-httpd-service
          (simple-service 'koszko-org-website koszko-httpd-service-type
                          (append-map make-virtualhosts %all-site-confs))
          (service
           (shepherd-service-type
            'dummy-network
            (const
             (shepherd-service
              (documentation "Provide 'networking' without actually doing anything")
              (provision '(networking))
              (start #~(const #t))
              (stop #~(const #t))
              (respawn? #f)))
            (description "Make other services assume network is there."))
           #f)
          %koszko-certbot-service
          %koszko-certs-activation-service
          %koszko-exim-service
          %koszko-mail-aliases-service
          %koszko-dovecot-service
          %koszko-knot-service
          %base-services)))