servers/vps/machines.scm: Remove unnecessary code, remove CGit

1 files changed, 17 insertions, 216 deletions

diff --git a/servers/vps/machines.scm b/servers/vps/machines.scm
index a4ccde7..0f6e330 100644
--- a/servers/vps/machines.scm
+++ b/servers/vps/machines.scm
@@ -23,157 +23,16 @@
                      certbot
                      cgit)
 
-
-;; Missing functions from stdlib
-
-(define* (partial f #:rest args1)
-  (lambda* (#:rest args2)
-    (apply f (append args1 args2))))
-
-(define (%every-pred-fn ps x)
-  (if (null? ps)
-      #t
-      (and ((car ps) x)
-           (%every-pred-fn (cdr ps) x))))
-
-(define (every-pred . ps)
-  (partial %every-pred-fn ps))
-
-(define (complement f)
-  (lambda* (#:rest args)
-    (not (apply f args))))
-
-
-;; custom extensions
-
-(define (slurp f)
-  (string-trim-both
-   (call-with-input-file f textual-ports:get-string-all)))
-
-(define (ignored? path)
-  (or (equal? "." path)
-      (equal? ".." path)))
-
-(define (dotfile? path)
-  (equal? #\. (string-ref path 0)))
-
-(define (list-directory path)
-  (ftw:scandir path
-               (every-pred (complement ignored?)
-                           (complement dotfile?))))
-
-(define (hash-double-quote-reader _char port)
-  "Taken almost verbatim from let-over-lambda."
-  (let ((chars '()))
-    (do ((prev (read-char port) curr)
-         (curr (read-char port) (read-char port)))
-        ((and (equal? #\" prev)
-              (equal? #\# curr)))
-      (set! chars (cons prev chars)))
-    (list->string (reverse! chars))))
-
-(read-hash-extend #\" hash-double-quote-reader)
-
-(define (heredoc-reader _char port)
-  "Taken almost verbatim from let-over-lambda."
-  (let ((chars '()))
-    (do ((curr (read-char port)
-               (read-char port)))
-        ((equal? #\newline curr))
-      (set! chars (cons curr chars)))
-    (let* ((pattern (reverse! chars))
-           (pointer pattern)
-           (output '()))
-      (do ((curr (read-char port)
-                 (when (not (null? pointer))
-                   (read-char port))))
-          ((null? pointer))
-        (set! output (cons curr output))
-        (set! pointer
-              (if (equal? (car pointer) curr)
-                  (cdr pointer)
-                  pattern)))
-      (list->string
-       (reverse!
-        (srfi-1:drop output
-                     (length pattern)))))))
-
-(read-hash-extend #\> heredoc-reader)
-
-(define (read-delimited-list char port)
-  (let ((sexp-string (string-append
-                      "("
-                      (rdelim:read-delimited (string char) port)
-                      ")")))
-    (call-with-input-string sexp-string read)))
-
-(define (lambda-shorthand-reader _char port)
-  `(lambda (%)
-     ,(read-delimited-list #\] port)))
-
-(define (cmd . args)
-  (let* ((port (apply popen:open-pipe* OPEN_READ args))
-         (out (string-trim-right (rdelim:read-string port))))
-    (popen:close-pipe port)
-    out))
-
-(read-hash-extend #\[ lambda-shorthand-reader)
-
-(define (tick-cmd-reader _char port)
-  (cons 'cmd
-        (map (lambda (s)
-               (if (equal? #\$ (string-ref s 0))
-                   (string->symbol (substring s 1))
-                   s))
-             (string-split (rdelim:read-delimited "´" port)
-                           #\space))))
-
-(read-hash-extend #\´ tick-cmd-reader)
-
-(define-macro (-> x . sexps)
-  (srfi-1:fold
-   (lambda (el acc)
-     (if (list? el)
-         (append (list (car el)
-                       acc)
-                 (cdr el))
-         (list el acc)))
-   x
-   sexps))
-
-(define-macro (->> x . sexps)
-  (srfi-1:fold
-   (lambda (el acc)
-     (if (list? el)
-         (append el (list acc))
-         (list el acc)))
-   x
-   sexps))
-
-
-;; DNS constants
-
 (define user "andreh")
-
 (define tld (slurp "servers/vps/tld.txt"))
-(define host-name (slurp "servers/vps/hostname.txt"))
-
-(define mail-domain-prefix "mail")
 (define mail-domain (string-append mail-domain-prefix "." tld))
+(define matrix-domain (string-append matrix-domain-prefix "." tld))
 
-(define git-domain-prefix "git")
-(define git-domain (string-append git-domain-prefix "." tld))
-
-
-;; OS configuration
-
+;; permit nopass :wheel
 (define sudoers "\
 root ALL=(ALL) ALL
 %wheel ALL=NOPASSWD: ALL\n")
 
-(define certbot-alias
-  "certbot")
-
 (define letsencrypt-prefix
   "/etc/letsencrypt/live/")
 
@@ -195,38 +54,15 @@ accept for any relay
 pki " mail-domain " cert \"" (tls-pub-for  mail-domain) "\"
 pki " mail-domain " key  \"" (tls-priv-for mail-domain) "\""))
 
-(define tls-prefixes
-  (list mail-domain-prefix
-        git-domain-prefix
-        "chat"))
-
-(define static-projects
-  '("guile-pds" "boneco"))
-
 (define tls-domains
-  (cons tld
-   (append
-    (map #[string-append % "." tld]
-         tls-prefixes)
-    (map (cut string-append <> "." tld) static-projects))))
-
-(define (static-nginx-config domains root)
-  (nginx-server-configuration
-    (server-name domains)
-    (listen '("443 ssl"))
-    (ssl-certificate (tls-pub-for tld))
-    (ssl-certificate-key (tls-priv-for tld))
-    (root root)))
-
-(define static-projects-nginx-config
-  (map #[static-nginx-config (list (string-append % "." tld))
-           (string-append "/srv/http/" %)]
-       static-projects))
+  (list tld
+				mail-domain
+				matrix-domain))
 
 (define my-system
   (operating-system
     (timezone "America/Sao_Paulo")
-    (host-name host-name)
+    (host-name (slurp "servers/vps/hostname.txt"))
     (users (cons* (user-account
                    (name user)
                    (group "users")
@@ -241,13 +77,17 @@ pki " mail-domain " key  \"" (tls-priv-for mail-domain) "\""))
              %base-packages))
     (services
      (append
-      (list (service openssh-service-type
+      (list (service dhcp-client-service-type)
+			      (service openssh-service-type
                      (openssh-configuration
                       (openssh openssh-sans-x)
                       (password-authentication? #f)
                       (permit-root-login #f)
                       (authorized-keys
                        `((,user ,(local-file (string-append (getenv "HOME") "/.ssh/id_rsa.pub")))))))
+            (service git-daemon-service
+										 (git-daemon-configuration
+											(export-all? #t)))
             (simple-service 'automatic-services-restart
                             activation-service-type
                             (with-imported-modules '((gnu services herd))
@@ -264,25 +104,19 @@ pki " mail-domain " key  \"" (tls-priv-for mail-domain) "\""))
                       (jobs
                        (list #~(job "30 1 * * 1" "/opt/bin/gc.sh")
                              #~(job "30 0 * * *" "/opt/bin/backup.sh")))))
-            (service dhcp-client-service-type)
             #;
             (service opensmtpd-service-type
                      (opensmtpd-configuration
                       (config-file (plain-file "euandreh-smtpd.conf" opensmtpd-config))))
-            #;
-            (service mail-aliases-service-type
-                     `(("postmaster" "root")
-                       ("webmaster" "root")
-                       ("abuse" "root")
-                       (,certbot-alias "root")))
             (service nginx-service-type
-                     (nginx-configuration
-                      (server-blocks
-                       (append (list)
-                               static-projects-nginx-config))))
+										 (nginx-configuration
+											(server-blocks
+											 (list (nginx-server-configuration
+															(ssl-certificate     (tls-pub-for  tld))
+															(ssl-certificate-key (tls-priv-for tld)))))))
             (service certbot-service-type
                      (certbot-configuration
-                      (email (string-append certbot-alias "@" tld))
+                      (email (string-append "certbot@" tld))
                       (certificates
                        (list
                         (certificate-configuration
@@ -292,41 +126,8 @@ pki " mail-domain " key  \"" (tls-priv-for mail-domain) "\""))
                             (with-imported-modules '((gnu services herd))
                               #~(begin
                                   (use-modules (gnu services herd))
-                                  #;
                                   (execl "/var/lib/certbot/renew-certificates")
                                   (restart-service 'nginx))))
-            (service cgit-service-type
-                     (cgit-configuration
-                      (remove-suffix? #t)
-                      (root-title "EuAndreh's repositories")
-                      (root-desc "Patches welcome!")
-                      (snapshots '("tar.gz" "zip"))
-                      (clone-prefix (list (string-append "https://" git-domain)))
-                      (source-filter (file-append cgit "/lib/cgit/filters/syntax-highlighting.py"))
-                      (about-filter  (file-append cgit "/lib/cgit/filters/about-formatting.sh"))
-                      (favicon (file-append cgit "/share/cgit/favicon.ico"))
-                      (enable-commit-graph? #t)
-                      (enable-follow-links? #t)
-                      (enable-index-owner? #f)
-                      (enable-log-filecount? #t)
-                      (enable-log-linecount? #t)
-                      (enable-subject-links? #t)
-                      (enable-html-serving? #t)
-                      (enable-git-config? #t)
-                      (max-repodesc-length 120)
-                      (max-stats "year")
-                      (nocache? #t)
-                      (include
-                       (plain-file "euandreh-cgitrc"
-                                   (string-join (map (partial string-append "readme=:README")
-                                                     '("" ".txt" ".md" ".rst"))
-                                                "\n")))
-                      #;
-                      (nginx-server-configuration-list
-                       (list
-                        (nginx-server-configuration
-                         (server-name (list git-domain)))))))
-            #;
             (simple-service 'init-srv-directories
                             activation-service-type
                             #~(for-each (lambda (p)