path: root/src/guix/system.scm

(use-modules
  ((ice-9 textual-ports) #:prefix textual-ports:)
  ((srfi srfi-1) #:prefix s1:)
  ((xyz euandreh heredoc) #:prefix heredoc:)
  ((org euandre packages) #:prefix pkg:)
  ((org euandre queue) #:prefix q:)
  (gnu)
  (guix build-system trivial)
  (guix build utils)
  (guix packages)
  (guix records))
(use-package-modules
  admin
  ssh
  version-control)
(use-service-modules
  admin
  certbot
  cgit
  dns
  mail
  mcron
  networking
  security
  shepherd
  ssh
  version-control
  vpn
  web)
(heredoc:enable-syntax)


(define ipv4 "216.238.68.100")
(define ipv6 "2001:19f0:b400:1f0c:5400:04ff:fe35:8c89")
(define tld "euandre.org")
(define +tld+ tld)


(define (path s)
  ;; src/guix/system.scm + ../../../ = ./
  (string-append (dirname (dirname (dirname (current-filename)))) "/" s))

(define +users+
  `(("andreh" "EuAndreh" ("wheel") ,(path "src/keys/SSH/andreh.pub.txt"))))


(define working-dir
  (dirname (dirname (dirname (current-filename)))))


(define (str . rest)
  (apply string-append rest))

(define (fmt . rest)
  (apply format #f rest))

(define (path s)
  (str working-dir "/" s))

(define (slurp s)
  (call-with-input-file
   s
   textual-ports:get-string-all))

(define (file s)
  (slurp (path s)))

(define (script name content)
  (package
    (name name)
    (version "latest")
    (source #f)
    (build-system trivial-build-system)
    (arguments
      (list
       #:modules '((guix build utils))
       #:builder
       #~(begin
           (use-modules (guix build utils))
           (let* ((bin  (string-append %output "/bin"))
                  (prog (string-append bin "/" #$name)))
             (mkdir-p bin)
             (call-with-output-file prog
              (lambda (port)
                (display #$content port)))
             (chmod prog #o755)))))
    (home-page #f)
    (synopsis #f)
    (description #f)
    (license #f)))


(define ns (fmt "ns1.~a." tld))
(define mail (fmt "hostmaster.~a." tld))
(define dkim-selector "dkimproxyout")
(define dkim-public-key-path "/var/lib/dkimproxyout/public.key")

(define dkim-name (str dkim-selector "._domainkey"))
(define dkim-public-key
  (if (file-exists? dkim-public-key-path)
    (string-join (reverse
                  (cdr
                   (reverse
                    (cdr
                     (string-split (slurp dkim-public-key-path)
                                   #\newline)))))
                 "")
    "stub-public-key-for-building"))

(define ipv4-reverse-domain
  (str
   (string-join (reverse
                 (string-split ipv4
                               #\.))
                ".")
   ".in-addr.arpa"))

(define ipv6-reverse-domain
  (str
   (string-join (reverse
                 (map (lambda (s) (fmt "~a" s))
                      (string->list
                       (string-delete #\: ipv6))))
                ".")
   ".ip6.arpa"))

(define-zone-entries tld-zone
  ("@"         ""   "IN"   "NS"    (fmt "ns1.~a." tld))
  ("@"         ""   "IN"   "NS"    (fmt "ns2.~a." tld))
  ("ns1"       ""   "IN"   "A"     ipv4)
  ("ns1"       ""   "IN"   "AAAA"  ipv6)
  ("ns2"       ""   "IN"   "A"     ipv4)
  ("ns2"       ""   "IN"   "AAAA"  ipv6)

  ("@"         ""   "IN"   "A"     ipv4)
  ("@"         ""   "IN"   "AAAA"  ipv6)

  ("@"         ""   "IN"   "CAA"   "0 issue \"letsencrypt.org\"")
  ("@"         ""   "IN"   "CAA"   "0 issuewild \";\"")
  ("@"         ""   "IN"   "CAA"   "0 iodef \"mailto:eu@euandre.org\"")

  ("mta-sts"   ""   "IN"   "A"     ipv4)
  ("mta-sts"   ""   "IN"   "AAAA"  ipv6)
  ("_mta-sts"  ""   "IN"   "TXT"   "\"v=STSv1; id=20230314\"")
  ("@"         ""   "IN"   "MX"    (fmt "10 ~a." tld))
  ("_dmarc"    ""   "IN"   "TXT"   "\"v=DMARC1; p=quarantine\"")
  ("@"         ""   "IN"   "TXT"   (fmt "\"v=spf1 a:~a -all\"" tld))
  (dkim-name   ""   "IN"   "TXT"   (fmt "\"v=DKIM1; k=rsa; t=s; p=~a\"" dkim-public-key)))

(define-zone-entries ipv4-reverse-domain-zone
  ("@"         ""   "IN"   "PTR"   (str tld "."))
  ("@"         ""   "IN"   "NS"    (fmt "ns1.~a." tld))
  ("@"         ""   "IN"   "NS"    (fmt "ns2.~a." tld)))

(define-zone-entries ipv6-reverse-domain-zone
  ("@"         ""   "IN"   "PTR"   (str tld "."))
  ("@"         ""   "IN"   "NS"    (fmt "ns1.~a." tld))
  ("@"         ""   "IN"   "NS"    (fmt "ns2.~a." tld)))

(define zones
  (list
   (knot-zone-configuration
     (domain tld)
     (semantic-checks? #t)
     (zone
       (zone-file
         (origin tld)
         (ns ns)
         (mail mail)
         (entries tld-zone))))
   (knot-zone-configuration
     (domain ipv4-reverse-domain)
     (semantic-checks? #t)
     (zone
       (zone-file
         (origin ipv4-reverse-domain)
         (ns ns)
         (mail mail)
         (entries ipv4-reverse-domain-zone))))
   (knot-zone-configuration
     (domain ipv6-reverse-domain)
     (semantic-checks? #t)
     (zone
       (zone-file
         (origin ipv6-reverse-domain)
         (ns ns)
         (mail mail)
         (entries ipv6-reverse-domain-zone))))))


(define-record-type* <git-configuration>
  git-configuration
  make-git-configuration
  git-configuration?
  (package           git-configuration-package           (default git))
  (user              git-configuration-user              (default "git"))
  (group             git-configuration-group             (default "git"))
  (export-all?       git-configuration-export-all?       (default #f))
  (base-path         git-configuration-base-path         (default "/srv/git"))
  (user-path         git-configuration-user-path         (default #f))
  (run-in-container? git-configuration-run-in-container? (default #f))
  (container-name    git-configuration-container-name    (default "git-contaner")))

(define (git-command config)
  (match-record config <git-configuration>
      (package user group base-path run-in-container? container-name)
    (let ((bin (file-append package "/bin/git")))
      (if (not run-in-container?)
        bin
        (least-authority-wrapper
         bin
         #:user      user
         #:group     group
         #:name      container-name
         #:directory base-path
         #:preserved-environment-variables
         '()
         #:mappings
         (list
          (file-system-mapping
            (source base-path)
            (target source)
            (writable? #t))))))))

(define (git-shepherd-services config)
  (match-record config <git-configuration>
      (user group export-all? base-path user-path)
    (list
     (shepherd-service
       (provision '(git))
       (requirement '(networking))
       (start
         #~(make-forkexec-constructor
            (list #$(git-command config)
                  "daemon" "--syslog" "--reuseaddr"
                  #$@(pkg:mklist (and export-all? "--export-all"))
                  #$@(pkg:mklist (and base-path (string-append "--base-path=" base-path)))
                  #$@(pkg:mklist (and user-path (string-append "--user-path=" user-path))))
            #:user  #$user
            #:group #$group))
       (stop #~(make-kill-destructor SIGKILL))
       (documentation "")))))

(define (git-accounts config)
  (match-record config <git-configuration>
      (user group)
    (list
     (user-group
       (name group)
       (system? #t))
     (user-account
       (name user)
       (group group)
       (system? #t)
       (comment "External SSH Git service user")
       (home-directory "/srv/git")
       (shell
         (file-append git "/bin/git-shell"))))))


(define git-service-type
  (service-type
    (name 'git)
    (extensions
      (list
       (service-extension shepherd-root-service-type
                          git-shepherd-services)
       (service-extension account-service-type
                          git-accounts)
       (service-extension profile-service-type
                          (compose list git-configuration-package))))
    (default-value (git-configuration))
    (description "Better git:// service.")))


(define package-symbols
  '())

(define package-records
  (list))



(operating-system
  (locale "fr_FR.UTF-8")
  (timezone "America/Sao_Paulo")
  (host-name +tld+)
  (skeletons pkg:skeletons)
  (users (append (pkg:user-accounts +users+) %base-user-accounts))
  (packages (pkg:package-set package-symbols package-records))
  (services
    (append
     (list
      (service knot-service-type
        (knot-configuration
          (zones zones)))
      (service ntp-service-type)
      (service dhcp-client-service-type)
      (service fail2ban-service-type)
      (service openssh-service-type (q:openssh-default-configuration (pkg:users->keys +users+)))
      (service certbot-service-type (q:tld-certbot-configuration +tld+))
      (service nginx-service-type
        (nginx-configuration
          (server-blocks
            (list
             (nginx-server-configuration
               (server-name (list tld))
               (listen '("[::]:443 ssl http2" "443 ssl http2"))
               (root "/srv/www")
               (ssl-certificate     (fmt "/etc/letsencrypt/live/~a/fullchain.pem" tld))
               (ssl-certificate-key (fmt "/etc/letsencrypt/live/~a/privkey.pem"   tld))
               (locations
                 (list
                  (nginx-location-configuration
                    (uri "/git/static/")
                    (body
                      (list
                       (list "alias " cgit "/share/cgit/;"))))
                  (nginx-location-configuration
                    (uri "/git/")
                    (body
                      (list
                       (list "fastcgi_param SCRIPT_FILENAME " cgit "/lib/cgit/cgit.cgi;")
                       #"-
                         fastcgi_param PATH_INFO $uri;
                         fastcgi_param QUERY_STRING $args;
                         fastcgi_param HTTP_HOST $server_name;
                         fastcgi_pass localhost:9000;
                         rewrite /git(.*) $1 break;
                         "#)))))
               (raw-content
                 '(#"-
                     ssl_protocols TLSv1.3;
                     ssl_ciphers EECDH+AESGCM:EDH+AESGCM:AES256+EECDH:AES256+EDH;
                     ssl_prefer_server_ciphers on;
                     gzip off;  # Disable compression altogether due to BREACH
                     charset utf-8;
                     autoindex on;
                     add_header Strict-Transport-Security 'max-age=31536000; includeSubdomains' always;
                     "#)))))))
      (service cgit-service-type q:cgit-pre-configuration)
      (service pkg:syskeep-service-type)
      (service git-service-type
        (git-configuration
          (export-all? #t)))
      (simple-service 'add-wireguard-aliases hosts-service-type
        (list
         (host "10.0.0.0" "toph")
         (host "10.0.0.1" "velhinho")
         (host "10.0.0.2" "azula")))
      (service wireguard-service-type
        (wireguard-configuration
          (addresses '("10.0.0.0/32"))
          (peers
            (list
             (wireguard-peer
               (name "velhinho")
               (public-key "Mhv8KxB/QXQpNKNtqD57PoFv43TXJ1lg52PJd6TmtwI=")
               (allowed-ips '("10.0.0.1/32"))
               (keep-alive 25))
             (wireguard-peer
               (name "azula")
               (public-key "8IxSFlJoFuTzLtIkoKZH4CkUbIxd6++E0lBOin/7rT8=")
               (allowed-ips '("10.0.0.2/32"))
               (keep-alive 25))))))
      (service q:shadow-group-service-type)
      (service q:dkimproxyout-service-type)
      (service q:cyrus-sasl-service-type)
      (service q:dovecot-service-type)
      (service q:internet-postfix-service-type)
      (service mail-aliases-service-type
        '(("root"         "andreh")
          ("eu"           "andreh")
          ("mailing-list" "andreh"))))
     pkg:base-services))
  (bootloader
    (bootloader-configuration
      (bootloader grub-bootloader)
      (targets '("/dev/vda"))))
  (swap-devices
    (list
     (swap-space
       (target
         (uuid "94b47d91-3542-438a-84a9-859fe347ce09")))))
  (file-systems
    (append
     (list
      (file-system
        (mount-point "/")
        (device
          (uuid "4c36d5ad-f996-413e-a55c-c05b7e1876f2" 'btrfs))
        (type "btrfs"))
      (file-system
        (mount-point "/mnt/production")
        (needed-for-boot? #t)
        (device
          (uuid "b1a7e4a1-a8ea-48a4-ab8b-884a1b6a9c11" 'btrfs))
        (type "btrfs"))
      (file-system
        (mount-point "/mnt/backup")
        (device
          (uuid "6632849d-f180-4740-86e6-a519d43ab75a" 'btrfs))
        (type "btrfs")))
     %base-file-systems)))