mv vps/ servers/vps/

1 files changed, 0 insertions, 363 deletions

diff --git a/vps/machines.scm b/vps/machines.scm
deleted file mode 100644
index aefee7e..0000000
--- a/vps/machines.scm
+++ /dev/null
@@ -1,363 +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) ; cut utility
-             ((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)))
-
-(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 "vps/tld.txt"))
-(define host-name (slurp "vps/hostname.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))
-
-
-;; OS configuration
-
-(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 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))
-
-(define my-system
-  (operating-system
-    (timezone "America/Sao_Paulo")
-    (host-name host-name)
-    (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)
-                   ;; required for guix pull
-                  '(nss-certs))
-             %base-packages))
-    (services
-     (append
-      (list (service openssh-service-type
-                     (openssh-configuration
-                      (openssh openssh-sans-x)
-                      (password-authentication? #false)
-                      (authorized-keys
-                       `((,user ,(local-file (string-append (getenv "HOME") "/.ssh/id_rsa.pub")))))))
-            (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-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
-                      (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)
-                                          (mkdir-p p)
-                                          (chmod p #o755))
-                                        '("/srv/http"
-                                          "/srv/git"))))
-      (modify-services
-       %base-services
-       (guix-service-type
-        config => (guix-configuration
-                   (inherit config)
-                   (authorized-keys
-                    (append
-                     (list (local-file "/etc/guix/signing-key.pub"))
-                     %default-authorized-guix-keys)))))))
-    (bootloader
-     (bootloader-configuration
-      (bootloader grub-bootloader)
-      (target "/dev/vda")
-      (terminal-outputs '(console))))
-    (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))))
-
-(define my-machine
-  (machine
-    (operating-system my-system)
-    (environment managed-host-environment-type)
-    (configuration (machine-ssh-configuration
-                    (host-name tld)
-                    (system "x86_64-linux")
-                    (user user)
-                    (host-key "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIOwnnw/u8ub+kcQhnVSyNWarYGH8aesUwIy4SIprufKf")))))
-
-(list my-machine)