path: root/container.scm

;; SPDX-License-Identifier: CC0-1.0

;; Copyright (C) 2022-2023 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))
(use-package-modules web
                     python
                     version-control
                     mail)
(use-service-modules web
                     shepherd
                     certbot
                     mail)

(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 (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
  (match-lambda
    (($ <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 "https://~a/" name)))
         ,(httpd-directive
           'Alias "/.well-known/acme-challenge" "/srv/http/acme-challenge/")
         ,@body)))))

(define (make-virtualhosts koszko-site-conf-record)
  (list (httpd-virtualhost
         "*:80"
         (make-virtualhost-directives koszko-site-conf-record))))

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

     ,(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"))
  (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
   `(;; GDPR hack
     ,(httpd-directive 'Header 'unset 'Set-Cookie)

     ,(httpd-tag 'Proxy '("*")
                 (httpd-directive
                  'Redirect 'permanent
                  "/projects/hachette" "/projects/haketilo")
                 ;; I don't remember why I added the following line so I'm
                 ;; keeping it just in case.
                 (httpd-directive 'RequestHeader 'unset 'Accept-Encoding))

     ,(httpd-directive
       'ProxyPass "/projects/haketilo"
       "http://10.207.87.1:21011/projects/hachette")
     ,(httpd-directive
       'ProxyPassReverse "/projects/haketilo"
       "http://10.207.87.1:21011/projects/hachette")

     ,(httpd-directive 'ProxyPass "/.well-known/acme-challenge/" "!")
     ,(httpd-directive 'ProxyPass "/" "http://10.207.87.1:21011/")
     ,(httpd-directive 'ProxyPassReverse "/" "http://10.207.87.1:21011/")))))

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

(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 %headers-module
  (httpd-module
   (name "headers_module")
   (file (file-append httpd "/modules/mod_headers.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")
      (error-log "/var/log/httpd/error.log")
      (modules `(,%cgid-module
                 ,%wsgi-module
                 ,@%proxy-http-modules
                 ,%headers-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 %koszko-httpd-deploy-hook
  (program-file
   "httpd-deploy-hook"
   #~(begin
       (for-each (lambda (subdir)
                   (system* "chgrp" "-R" "certsaccess"
                            (string-append "/etc/letsencrypt/" subdir)))
                 '("live" "archive"))
       (system* "find" "/etc/letsencrypt/archive/" "-name" "privkey1.pem"
                "-exec" "chmod" "640" "{}" ";")
       (kill (call-with-input-file "/var/run/httpd" read)
             SIGHUP))))

(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 %koszko-certbot-service
  (service
   (service-type
    (inherit certbot-service-type)
    (name 'koszko-certbot)
    ;; Prevent certbot from pulling in Nginx — we use Apache here.
    (extensions (filter
                 (lambda (ext)
                   (not (extension-of-type? ext nginx-service-type)))
                 (service-type-extensions certbot-service-type))))
   (certbot-configuration
    (email "koszko@koszko.org")
    (rsa-key-size 4096)
    (certificates
     (map
      (match-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 '()))))
           (certificate-configuration
            (name (string-append "guixbot_" (car name-and-aliases)))
            (domains (append name-and-aliases www-aliases))
            (challenge "http")
            (authentication-hook %koszko-certbot-auth-hook)
            (cleanup-hook %koszko-certbot-cleanup-hook)
            (deploy-hook %koszko-httpd-deploy-hook)))))
      %all-site-confs)))))

(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)
                    ;; Make exim logs accessible under /var/log
                    (let ((old-activation (service-extension-compute ext)))
                      (define (new-activation exim-config)
                        #~(begin
                            (symlink "../spool/exim/log" "/var/log/exim")
                            #$(old-activation exim-config)))

                      (service-extension activation-service-type
                                         new-activation)))
                   (else
                    ext)))
                (service-type-extensions exim-service-type)))))

(define %koszko-exim-service
  (service koszko-exim-service-type
           (exim-configuration
            (package (package/inherit exim
                       (arguments
                        (substitute-keyword-arguments
                            (package-arguments exim)
                          ((#:phases phases)
                           #~(modify-phases #$phases
                               (add-after 'configure 'configure-enable-maildir
                                 (lambda _
                                   (substitute* "Local/Makefile"
                                     (("# (SUPPORT_MAILDIR=yes)" all line)
                                      line))))))))))
            (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"))))

(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 "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))
          (user-account
           (name "httpd")
           (group "httpd")
           (supplementary-groups '("gitolite3" "certsaccess"))
           (system? #t))
          ;; 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))
          (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"))))
  (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-exim-service
          %koszko-mail-aliases-service
          %base-services)))