path: root/container.scm

;; SPDX-License-Identifier: CC0-1.0

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

(use-modules (gnu)
             (koszko-org-website)
             (sheets-websites)
             (hydrilla-website)
             (hydrilla-json-schemas)
             (hydrilla)
             (ice-9 match)
             ;; The following 4 are needed to construct GUIX_PYTHONPATH for
             ;; Hydrilla WSGI scripts.
             (guix build-system python)
             (guix packages)
             (guix search-paths)
             (guix modules))
(use-package-modules web)
(use-package-modules python)
(use-service-modules web)
(use-service-modules shepherd)

(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-package-file package file)
  (g-string-append package "/" file))

(define (httpd-conf-token arg)
  (match arg
    ((? string?)
     (if (or-map (lambda (substr) (string-contains arg substr)) '(" " "\""))
         (format #f "~s" arg)
         arg))
    ((? symbol?)
     (httpd-conf-token (symbol->string arg)))
    ((? gexp?)
     #~(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 (g-package-file 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* (koszko-httpd-server-meta server-name #:optional (use-www-alias #t))
  (let ((basic-dirs (list (httpd-directive 'ServerName server-name)
                          (httpd-directive 'ServerAdmin "koszko@koszko.org"))))
    (if use-www-alias
        (cons (httpd-directive 'ServerAlias (string-append "www." server-name))
              basic-dirs)
        basic-dirs)))

(define (koszko-httpd-redirect-if-other-host host-name)
  (httpd-tag 'If (list (format #f "%{HTTP_HOST} != '~a'" host-name))
             (httpd-directive
              'Redirect 'permanent "/" (format #f "http://~a/" host-name))))

(define (koszko-httpd-virtualhost-redirect from to)
  (httpd-virtualhost
   "*:80"
   `(,@(koszko-httpd-server-meta from)
     ,(httpd-directive 'Redirect 'permanent "/" (format #f "http://~a" to)))))

(define %koszko-org-virtualhost
  (httpd-virtualhost
   "*:80"
   `(,@(koszko-httpd-server-meta "koszko.org")
     ,(httpd-directive 'DocumentRoot "/srv/http/koszko.org")

     ,(koszko-httpd-redirect-if-other-host "koszko.org")

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

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

(define %koszkonutek-tmp-virtualhost
  (koszko-httpd-virtualhost-redirect "koszkonutek-tmp.pl.eu.org" "koszko.org"))

(define %sheets-virtualhosts
  (map
   (lambda (name)
     (httpd-virtualhost
      "*:80"
      `(,@(koszko-httpd-server-meta (string-append name ".koszko.org"))
        ,(httpd-directive
          'DocumentRoot (g-package-file
                         sheets-websites
                         (string-append "/share/" name "-website")))

        ,(koszko-httpd-redirect-if-other-host
          (string-append name ".koszko.org")))))
   '("sheets" "pray")))

(define %hydrillabugs-virtualhost
  (httpd-virtualhost
   "*:80"
   `(,@(koszko-httpd-server-meta "hydrillabugs.koszko.org")

     ,(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 "/" "http://10.207.87.1:21011/")
     ,(httpd-directive 'ProxyPassReverse "/" "http://10.207.87.1:21011/"))))

(define %hachettebugs-virtualhost
  (koszko-httpd-virtualhost-redirect
   "hachettebugs.koszko.org" "hydrillabugs.koszko.org"))

(define %haketilo-virtualhost
  (httpd-virtualhost
   "*:80"
   `(,@(koszko-httpd-server-meta "haketilo.koszko.org")

     ,(koszko-httpd-redirect-if-other-host "haketilo.koszko.org")

     ,(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 (map cadr (package-transitive-target-inputs hydrilla))))

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

(define %hydrilla-virtualhost
  (httpd-virtualhost
   "*:80"
   `(,@(koszko-httpd-server-meta "hydrilla.koszko.org")

     ,(koszko-httpd-redirect-if-other-host "hydrilla.koszko.org")

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

     ,(httpd-directive
       'Alias "/schemas"
       (g-package-file 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")))))

(define %hydrillarepos-virtualhost
  (httpd-virtualhost
   "*:80"
   `(,@(koszko-httpd-server-meta "hydrillarepos.koszko.org" #f)
     ,(httpd-directive 'DocumentRoot "/srv/http/hydrillarepos.koszko.org"))))

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

;; 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
  (service
   httpd-service-type
   (httpd-configuration
    (config
     (httpd-config-file
      (server-name "koszko.org")
      (error-log "/var/log/httpd/error.log")
      (modules `(,%wsgi-module
                 ,@%proxy-http-modules
                 ,%logio-module
                 ,@%default-httpd-modules))
      (extra-config
       (list
        (string-join `("LogFormat" ,%logformat-combined "combined")) "\n"
        "CustomLog /var/log/httpd/access.log combined" "\n"
        )))))))

(operating-system
  (host-name "koszko")
  (timezone "Europe/Warsaw")
  (groups (cons* (user-group
                  ;; The `httpd` group must have an explicit id so that the host
                  ;; can provide files that are readable by Apache and not
                  ;; readable by the world.
                  (name "httpd")
                  (id 133)
                  (system? #t))
                 %base-groups))
  (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 httpd-service-type
                          `(,%koszko-org-virtualhost
                            ,%koszkonutek-tmp-virtualhost
                            ,@%sheets-virtualhosts
                            ,%hydrillabugs-virtualhost
                            ,%hachettebugs-virtualhost
                            ,%haketilo-virtualhost
                            ,%hydrilla-virtualhost
                            ,%hydrillarepos-virtualhost))
          (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)
          %base-services)))