Move sync/* to .

2 files changed, 0 insertions, 473 deletions

diff --git a/sync/tld.txt b/sync/tld.txt
deleted file mode 100644
index 1aaed8d..0000000
--- a/sync/tld.txt
+++ /dev/null
@@ -1 +0,0 @@
-arrobaponto.org
diff --git a/sync/vps.scm b/sync/vps.scm
deleted file mode 100644
index 259ec80..0000000
--- a/sync/vps.scm
+++ /dev/null
@@ -1,472 +0,0 @@
-(use-modules (guix gexp)
-             (gnu)
-             (guix)
-             ((guix build utils) #:prefix utils:)
-             ((guix modules) #:prefix modules:)
-             ((srfi srfi-1) #:prefix srfi-1:)
-       (srfi srfi-26)
-             ((ice-9 textual-ports) #:prefix textual-ports:)
-             ((ice-9 ftw) #:prefix ftw:)
-             ((ice-9 popen) #:prefix popen:)
-             ((ice-9 rdelim) #:prefix rdelim:)
-             ((ice-9 string-fun) #:prefix string-fun:))
-
-(use-package-modules ssh
-                     backup
-                     version-control)
-(use-service-modules networking
-                     ssh
-                     mcron
-                     admin
-                     mail
-                     web
-                     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)))
-
-(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))
-
-(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))
-
-
-
-;; DNS constants
-
-(define user
-  "andreh")
-
-(define tld (slurp (string-append "/home/" user "/tld.txt")))
-
-(define mail-domain-prefix "mail")
-(define mail-domain (string-append mail-domain-prefix "." tld))
-
-(define git-domain-prefix "git")
-(define git-domain (string-append git-domain-prefix "." tld))
-
-(define ci-domain-prefix "ci")
-(define ci-domain (string-append ci-domain-prefix "." tld))
-
-
-
-;; CI HTML generation from Git notes
-
-(define ci-html-beginning #"
-<!DOCTYPE html>
-<html lang="en">
-  <head>
-    <meta charset="UTF-8" />
-    <meta name="viewport"  content="width=device-width, initial-scale=1" />
-
-    <style>
-      pre {
-        display: inline;
-      }
-    </style>
-  </head>
-  <body>
-    <h1>
-      Build logs
-    </h1>"#)
-
-(define ci-html-ending
-  "</body>
-</html>")
-
-(define git-data-path "/srv/git")
-(define ci-data-path  "/srv/ci")
-
-(define (ci-data-in-repo-notes name path)
-  (utils:with-directory-excursion path
-    (let* ((out-list (-> #´git notes list´
-                         (string-fun:string-replace-substring "\n" " ")
-                         (string-split #\space)))
-           (relevant-commits (->> (srfi-1:zip out-list (iota (length out-list)))
-                                  (filter (compose odd? srfi-1:second))
-                                  (map srfi-1:first))))
-      (map (lambda (commit)
-             (let ((data (-> #´git notes --ref=refs/notes/ci-data show $commit´
-                             (string-split #\space)))
-                   (logs #´git notes --ref=refs/notes/ci-logs show $commit´)
-                   (href (format #f
-                                 "https://~a/~a/blob?id=~a"
-                                 git-domain
-                                 name
-                                 #´git notes --ref=refs/notes/ci-logs list $commit´)))
-               (list (cons #:status (srfi-1:first data))
-                     (cons #:filename (srfi-1:second data))
-                     (cons #:logs logs)
-                     (cons #:href href))))
-           relevant-commits))))
-
-(define (generate-html-for-project name)
-  (string-append
-   "<h2 id=\"" name "\">
-      <a href=\"#" name "\">
-        " name "
-      </a>
-    </h2>
-    <ul>"
-   (apply
-    string-append
-    (map (lambda (data)
-           (let ((status (if (equal? "0" (assoc-ref data #:status)) "✅" "❌"))
-                 (file (string-append name "-" (assoc-ref data #:filename)))
-                 (href (assoc-ref data #:href)))
-             (string-append
-              "<li>
-                 <a href=\"" href "\" download=" file ">
-                   " status "
-                   <pre>" file "</pre>
-                 </a>
-               </li>")))
-         (ci-data-in-repo-notes name (string-append git-data-path "/" name))))
-   "</ul>"))
-
-(define (generate-ci-html)
-  (call-with-output-file (string-append ci-data-path "/index.html")
-    (partial display
-             (string-append ci-html-beginning
-                            (apply string-append
-                                   (map generate-html-for-project
-                                        (list-directory git-data-path)))
-                            ci-html-ending))))
-
-
-
-;; OS configuration
-
-(define ssh-public-key
-  "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDF+uy407LKZAFnfFkJPRiOBzwV98qIEcKhITnLYhqfITfrJvcFVOY0/YDCrs6WHXyLdM29AoywVWsQ1qXiB7xQCwknPV8YZoCnJQcn0gvH8jbCk+C8Po0Rx846wbhL49qYolnmlhe+Uoy30j7XIJSDtPVO9d/hZqt2GPwGVJ98HLyY2ak+j4i1YkHr+mPFgnCaqCAzA374d1Bop18+YENYtMMU0k8hCsomwZny/7qNo4V8mjLxQAS8FvTuljxlthEpOM4Jsjl07yDLgE69kLvU7mmFi8EeC26e50N18Ouse82dZigtVhAMeLBhbJnQbDff4WfUBzSjpKjZPGcxoRaej3qSRbIkcMMqCOSlww6GcjRi+COvlpA4c1i4hKI15wHceoiKghDLA6jbaHfOqEMldflYl5gCVUIYzJ5XehZppH6L7PzO+L4suNs+aFjWPDZ0jqEtcyTmgTMea40p7wwz086ExnBDorbG79oDiJrWc+swJjXuVakS+fQjb3mPsCC/FgUhsxEtqiVfvLo2mphp47pOYvs64aUp3RV9muqQNuS4tEuP9V1urGTLtgPL26LEjF0oLu1ag0H+VZY5O/T9KRYvWre8IWbj/KkZYo1tJaGJyEVr0plmyzLBEy8b3Hu/6Wtq7yB0Eii60fxqFWC24nEkvs1V0cxDa+o6I2iA9w== eu@euandre.org")
-
-(define sudoers "\
-root ALL=(ALL) ALL
-%wheel ALL=NOPASSWD: ALL\n")
-
-(define certbot-alias
-  "certbot")
-
-(define letsencrypt-prefix
-  "/etc/letsencrypt/live/")
-
-(define (tls-pub-for domain)
-  (string-append letsencrypt-prefix domain "/fullchain.pem"))
-
-(define (tls-priv-for domain)
-  (string-append letsencrypt-prefix domain "/privkey.pem"))
-
-(define opensmtpd-config
-  (plain-file "euandreh-smtpd.conf" (string-append "
-listen on eth0
-# File comes from mail-aliases-service-type
-table aliases file:/etc/aliases
-accept from any domain " mail-domain " alias <aliases> deliver to maildir
-accept for local alias <aliases> deliver to maildir
-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 "www"
-        mail-domain-prefix
-  ci-domain-prefix
-        git-domain-prefix
-        "chat"
-        "meet"))
-
-(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 generate-ci-html-job
-  #~(job "*/5 * * * *"
-         #$(program-file
-            "generate-ci-html.scm"
-            (with-imported-modules (modules:source-module-closure
-                                    '((guix build utils)))
-              #~(begin
-                  (use-modules (guix build utils))
-                  (display 'generate-ci-html))))))
-
-
-(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))
-
-(define cgit-with-custom-about-formatting
-  (package
-    (inherit cgit)
-    (arguments
-      (substitute-keyword-arguments (package-arguments cgit)
-        ((#:phases phases)
-   `(modify-phases ,phases
-            (add-after unpack 'patch-about-formatting
-              (lambda _
-    (substitute* "lib/cgit/filters/about-formatting.sh"
-                  (("txt2html") "md2html"))))))))))
-
-(operating-system
-  (locale "en_US.UTF-8")
-  (timezone "America/Sao_Paulo")
-  (keyboard-layout (keyboard-layout "us"))
-  (host-name "guix-pet-server")
-  (users (cons* (user-account
-                 (name user)
-                 (group "users")
-                 (home-directory (string-append "/home/" user))
-                 (supplementary-groups '("wheel")))
-                %base-user-accounts))
-  (sudoers-file (plain-file "sudoers" sudoers))
-  (packages
-   (append (map (compose list specification->package+output symbol->string)
-                '(git
-                  nss-certs
-                  rsync))
-           %base-packages))
-  (services
-   (append
-    (list (service openssh-service-type
-                   (openssh-configuration
-                    (openssh openssh-sans-x)
-                    (password-authentication? #false)
-                    (authorized-keys
-                     `((,user ,(plain-file "id_rsa.pub" ssh-public-key))))))
-          (service mcron-service-type
-                   (mcron-configuration
-                    (jobs (list generate-ci-html-job))))
-          (simple-service 'automatic-services-restart
-                          activation-service-type
-                          (with-imported-modules '((gnu services herd))
-                            #~(begin
-                                (use-modules (gnu services herd))
-                                (restart-service 'mcron)
-        (restart-service 'nginx))))
-          (service unattended-upgrade-service-type)
-          (service dhcp-client-service-type)
-          (service opensmtpd-service-type
-                   (opensmtpd-configuration
-                    (config-file 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-nginx-config (list ci-domain) "/srv/ci"))
-      static-projects-nginx-config))))
-          (service certbot-service-type
-                   (certbot-configuration
-                    (email (string-append certbot-alias "@" tld))
-                    (certificates
-                     (list
-                      (certificate-configuration
-                       (domains tls-domains))))))
-          (simple-service 'automatic-certbot-renewal
-                          activation-service-type
-                          (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
-                    (package cgit-with-custom-about-formatting)
-                    (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
-          (nginx-server-configuration))))
-          (simple-service 'init-srv-directories
-                          activation-service-type
-                          #~(for-each (lambda (p)
-                                        (mkdir-p p)
-                                        ;; error: cmd is undefined
-                                        ;; #´chown -R $user users $p´
-          #;
-                                        (chown p #$user "users")
-          #;
-                                        (chmod p #o755))
-                                      '("/srv/http"
-                                        "/srv/git"
-                                        "/srv/ci"))))
-    %base-services))
-  (bootloader
-   (bootloader-configuration
-    (bootloader grub-bootloader)
-    (target "/dev/vda")
-    (keyboard-layout keyboard-layout)))
-  (swap-devices
-   (list (uuid "79a91c82-f3e1-4ed7-8c4e-23569f1ae0ca")))
-  (file-systems
-   (cons* (file-system
-            (mount-point "/")
-            (device
-             (uuid "fddb6a4c-8b8c-4f57-b274-5d6d33200f28"
-                   'ext4))
-            (type "ext4"))
-          %base-file-systems)))