diff options
| -rw-r--r-- | arunisaac/snac.scm | 152 |
1 files changed, 152 insertions, 0 deletions
diff --git a/arunisaac/snac.scm b/arunisaac/snac.scm new file mode 100644 index 0000000..0268388 --- /dev/null +++ b/arunisaac/snac.scm @@ -0,0 +1,152 @@ +(define-module (arunisaac snac) + #:use-module ((forge nginx) #:select (forge-nginx-service-type)) + #:use-module (gnu build linux-container) + #:use-module ((gnu packages admin) #:select (shadow)) + #:use-module ((gnu packages fediverse) #:select (snac2)) + #:use-module ((gnu packages guile) #:select (guile-json-4)) + #:use-module ((gnu packages nss) #:select (nss-certs)) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module ((gnu services web) + #:select (nginx-server-configuration + nginx-location-configuration)) + #:use-module (gnu system file-systems) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix least-authority) + #:use-module (guix records) + #:export (snac-service-type + + snac-configuration + snac-configuration-package + snac-configuration-server-name + snac-configuration-data-directory)) + +(define-record-type* <snac-configuration> + snac-configuration make-snac-configuration + snac-configuration? + (package snac-configuration-package + (default snac2)) + (server-name snac-configuration-server-name) + (data-directory snac-configuration-data-directory + (default "/var/lib/snac"))) + +(define %snac-unix-socket + "/var/run/snac/socket") + +(define %snac-accounts + (list (user-account + (name "snac") + (group "snac") + (system? #t) + (comment "snac user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))) + (user-group + (name "snac") + (system? #t)))) + +(define snac-activation + (match-record-lambda <snac-configuration> + (data-directory server-name) + (with-extensions (list guile-json-4) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (json) + (srfi srfi-26)) + + (let ((user (getpw "snac"))) + ;; Ensure data directory has the right ownership. + (for-each (lambda (file) + (chown file (passwd:uid user) (passwd:gid user))) + (find-files #$data-directory + #:directories? #t)) + ;; Create parent directory for the Unix socket. + (mkdir-p #$(dirname %snac-unix-socket)) + (chown #$(dirname %snac-unix-socket) + (passwd:uid user) + (passwd:gid user))) + ;; Mutate server.json setting host and address. + (let* ((config-file #$(string-append data-directory "/server.json")) + (config (call-with-input-file config-file + json->scm))) + (unless (and (assoc "address" config) + (assoc "host" config)) + (display "Some of fields \"address\" and \"host\" are missing from server.json; erring on the side of caution by aborting") + (newline) + (exit #f)) + (call-with-output-file config-file + (cut scm->json + (append '(("host" . #$server-name) + ("address" . #$%snac-unix-socket)) + (alist-delete "host" + (alist-delete "address" config))) + <> + #:pretty #t)))))))) + +(define snac-shepherd-service + (match-record-lambda <snac-configuration> + (package data-directory) + (shepherd-service + (documentation "Snac ActivityPub instance") + (provision '(snac)) + (requirement '(networking)) + (start #~(make-forkexec-constructor + (list #$(least-authority-wrapper + (file-append package "/bin/snac") + #:name "snac-pola-wrapper" + #:mappings (cons* (file-system-mapping + (source data-directory) + (target source) + (writable? #t)) + (file-system-mapping + (source (dirname %snac-unix-socket)) + (target source) + (writable? #t)) + (file-system-mapping + (source (file-append nss-certs "/etc/ssl/certs")) + (target source)) + %network-file-mappings) + #:preserved-environment-variables (cons "SSL_CERT_DIR" + %default-preserved-environment-variables) + ;; snac needs to make outgoing network + ;; requests. + #:namespaces (delq 'net %namespaces)) + "httpd" + #$data-directory) + #:environment-variables (list (string-append "SSL_CERT_DIR=" + #$(file-append nss-certs "/etc/ssl/certs"))) + #:user "snac" + #:group "snac" + #:log-file "/var/log/snac.log")) + (stop #~(make-kill-destructor))))) + +(define snac-nginx-server-blocks + (match-record-lambda <snac-configuration> + (server-name) + (list (nginx-server-configuration + (server-name (list server-name)) + (locations + (list (nginx-location-configuration + (uri "/") + (body + (list (string-append "proxy_pass http://unix:" + %snac-unix-socket + ":;") + "proxy_set_header Host $host;"))))))))) + +(define snac-service-type + (service-type + (name 'snac) + (description "Run snac.") + (extensions (list (service-extension account-service-type + (const %snac-accounts)) + (service-extension activation-service-type + snac-activation) + (service-extension shepherd-root-service-type + (compose list snac-shepherd-service)) + (service-extension forge-nginx-service-type + snac-nginx-server-blocks) + (service-extension profile-service-type + (const (list snac2))))))) |