about summary refs log tree commit diff
path: root/arunisaac/snac.scm
blob: 0268388e8f52f0d24a4dd8ddf36569f5759c5425 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
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)))))))