commit 657d91c989384b5e128c096fc39aa3377855ddea Author: Luke Willis <lukejw@loquat.dev> Date: Sun, 10 May 2026 23:18:56 -0400 bta: Write a new bta-service-type with packwiz integration Diffstat:
| A | system/andrew.scm | | | 334 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | system/andrew/bta.scm | | | 646 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | system/andrew/ci.scm | | | 198 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
3 files changed, 1178 insertions(+), 0 deletions(-)
diff --git a/system/andrew.scm b/system/andrew.scm @@ -0,0 +1,334 @@ +(define-module (system andrew) + #:use-module (system andrew ci) + #:use-module (system andrew bta) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix modules) + #:use-module (guix git) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader grub) + #:use-module (gnu services) + #:use-module (gnu services certbot) + #:use-module (gnu services networking) + #:use-module (gnu services version-control) + #:use-module (gnu services shepherd) + #:use-module (gnu services web) + #:use-module (gnu system) + #:use-module (gnu system keyboard) + #:use-module (gnu system shadow) + #:use-module (gnu packages rsync) + #:use-module (gnu packages version-control) + #:use-module (gnu packages wget) + #:use-module (nongnu packages linux) + #:use-module (nongnu system linux-initrd) + #:use-module (mt services) + #:use-module (mt services version-control) + #:use-module (mt system) + #:use-module (mt artwork) + #:use-module (mt utils) + #:export (andrew-os)) + +;;; +;;; OS Configuration +;;; + +(define %issue " +Welcome to \"andrew\" the, first MonasTech server. +") + +(define %nftables-ruleset + (plain-file "nftables.conf" "\ +# A simple and safe firewall +table inet filter { + chain input { + type filter hook input priority 0; policy drop; + + # early drop of invalid connections + ct state invalid drop + + # allow established/related connections + ct state { established, related } accept + + # allow from loopback + iif lo accept + # drop connections to lo not coming from lo + iif != lo ip daddr 127.0.0.1/8 drop + iif != lo ip6 daddr ::1/128 drop + + # allow icmp + ip protocol icmp accept + ip6 nexthdr icmpv6 accept + + # allow ssh + tcp dport ssh accept + + # allow git + tcp dport 9418 accept + + # allow ngninx + tcp dport { 80, 443 } accept + + # allow minecraft / voice chat + th dport { 25565, 24454 } accept + + # reject everything else + reject with icmpx type port-unreachable + } + chain forward { + type filter hook forward priority 0; policy drop; + } + chain output { + type filter hook output priority 0; policy accept; + } +} +")) + +(define %mod-list + (list + (bta-mod + (name "halplibe") + (display-name "HalpLibe") + (url "https://github.com/Turnip-Labs/bta-halplibe/releases/download/v5.4.1/halplibe-5.4.1.jar") + (sha256 (base32 "0vn64nh94zx6bv060bxgjkwjmn53759glvkjy5c1h8g4qmpghsd1"))) + (bta-mod + (name "modmenu") + (display-name "Mod Menu") + (url "https://github.com/Turnip-Labs/ModMenu/releases/download/4.0.1/modmenu-bta-4.0.1.jar") + (sha256 (base32 "0yhj3xsb4gljgjvc7c4xhf9g9dgkhgia6xbsv9gybnm8dkha0cm2"))))) + +(define andrew-os + (operating-system + (host-name "andrew") + (timezone "America/New_York") ;; Located in vinthill + (locale "en_US.utf8") + + (issue %issue) + + (keyboard-layout (keyboard-layout "us")) + + (kernel linux-lts) + (initrd microcode-initrd) + (firmware (list linux-firmware)) + + (bootloader (bootloader-configuration + (bootloader grub-efi-bootloader) + (targets '("/boot/efi")) + (keyboard-layout keyboard-layout))) + + (swap-devices %mt-swap-devices) + + (file-systems %mt-file-systems) + + (users + (cons* + (user-account + (name "lukejw") + (comment "Luke Willis") + (group "users") + (home-directory "/home/lukejw") + (supplementary-groups '("wheel"))) + %base-user-accounts)) + + (packages + (cons* + rsync + %mt-base-packages)) + + (services + (append + (list (service nftables-service-type + (nftables-configuration + (ruleset %nftables-ruleset))) + (service bta-service-type + (bta-configuration + (properties `(("motd" . "MonasTech Private Server") + ("difficulty" . "3") + ("allow-flight" . "true") + ("white-list" . "true") + ("online-mode" . "false"))) + (ops '("1a68c56c-0bbc-413d-8fe1-10a2e4e04ad2")) + (mods %mod-list) + (packwiz-home "/var/www/monastech.xyz/bta") + (packwiz-url "https://monastech.xyz/bta"))) + (service update-channels-locked-service-type '()) + (service nginx-service-type + (nginx-configuration + (server-blocks + (list (nginx-server-configuration + (server-name '("monastech.xyz" "www.monastech.xyz")) + (listen '("443 ssl")) + (root "/var/www/monastech.xyz") + (ssl-certificate "/etc/dehydrated/certs/monastech.xyz/fullchain.pem") + (ssl-certificate-key "/etc/dehydrated/certs/monastech.xyz/privkey.pem")) + (nginx-server-configuration + (server-name '("git.monastech.xyz" "www.git.monastech.xyz")) + (listen '("443 ssl")) + (root "/var/www/git.monastech.xyz") + (ssl-certificate "/etc/dehydrated/certs/monastech.xyz/fullchain.pem") + (ssl-certificate-key "/etc/dehydrated/certs/monastech.xyz/privkey.pem")) + (nginx-server-configuration + (server-name '("loquat.dev" "www.loquat.dev")) + (listen '("443 ssl")) + (root "/var/www/loquat.dev") + (ssl-certificate "/etc/dehydrated/certs/loquat.dev/fullchain.pem") + (ssl-certificate-key "/etc/dehydrated/certs/loquat.dev/privkey.pem")) + (nginx-server-configuration + (server-name '("orthodox.kitchen" "www.orthodox.kitchen")) + (listen '("443 ssl")) + (root "/var/www/orthodox.kitchen") + (ssl-certificate "/etc/dehydrated/certs/orthodox.kitchen/fullchain.pem") + (ssl-certificate-key "/etc/dehydrated/certs/orthodox.kitchen/privkey.pem")) + (nginx-server-configuration + (server-name '("substitutes.monastech.xyz")) + (listen '("443 ssl")) + (ssl-certificate "/etc/dehydrated/certs/monastech.xyz/fullchain.pem") + (ssl-certificate-key "/etc/dehydrated/certs/monastech.xyz/privkey.pem") + (locations + (list (nginx-location-configuration + (uri "/") + (body (list "proxy_pass http://127.0.0.1:8080;")))))) + ;; Default HTTP server + (nginx-server-configuration + (server-name '("_")) + (listen '("80 default_server")) + (root "/var/www/monastech.xyz") + (locations + (list ;; Serve ACME challenges + (nginx-location-configuration + (uri "^~ /.well-known/acme-challenge") + (body (list "alias /var/www/dehydrated;"))) + ;; Redirect to HTTPS + (nginx-location-configuration + (uri "/") + (body (list "return 301 https://$host$request_uri;"))))))))))) + (stagit-services + (stagit-configuration + (admin-pubkey (plain-file + "lukejw.pub" + "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIEZ2qcwpwPdMmrXNrrqjqtuBw8lG9gxlAE+vwcZAHM3L lukejw@moses")) + (www-home "/var/www/git.monastech.xyz") + (clone-domain "monastech.xyz") + (logo (file-append %mt-artwork "/logo-dynamic.svg")) + (stylesheet (plain-file "stylesheet.css" "\ +:root { + --bg: #FFFCF0; + --bg-2: #F2F0E5; + --ui: #E6E4D9; + --ui-2: #DAD8CE; + --ui-3: #CECDC3; + --tx: #100F0F; + --tx-2: #6F6E69; + --ye: #AD8301; + --ye-2: #D0A215; + --cy: #24837B; + --cy-2: #3AA99F; +} + +@media (prefers-color-scheme: dark) { + :root { + --bg: #100F0F; + --bg-2: #1C1B1A; + --ui: #282726; + --ui-2: #343331; + --ui-3: #403E3C; + --tx: #CECDC3; + --tx-2: #878580; + --ye: #D0A215; + --ye-2: #AD8301; + --cy: #3AA99F; + --cy-2: #24837B; + } +} + +html { + background-color: var(--bg); + color: var(--tx); + font-family: serif; +} + +body { + width: 100%; + max-width: 72rem; + margin-inline: auto; +} + +#header { + margin-inline: 1rem; +} + +hr { + border: 0.1rem solid var(--ui); + margin-inline: 1rem; +} + +#content { + margin-inline: 1rem; +} + +a { + color: var(--cy); + text-decoration: none; +} + +a:hover { + color: var(--cy-2); + text-decoration: underline; +} + +#header img { + width: 6.75rem; + height: 4.5rem; +} + +#header h1 { + margin: 0 0 0.5rem 0; + font-size: 2rem; + font-weight: normal; + border-bottom: 2px solid var(--ui); +} + +#header .desc { + color: var(--tx-2); +} + +#header tbody tr:last-child td { + padding-top: 0.4rem; +} + +#header .url > td:nth-child(2) { + font-family: monospace; + padding: 0.2rem 0.6rem; + border-radius: 0.5rem; + background-color: var(--bg-2); +} + +#files tbody { + font-family: monospace; +} + +#files tbody > tr td:first-child { + width: 0; + white-space: nowrap; + padding-right: 1rem; +} + +#content table { + width: 100%; + border-collapse: collapse; +} + +#content td { + padding: 1rem; +} + +#content tbody tr:hover { + background: var(--bg-2); +} + +#content td { + padding: 0.3rem; +} +")))) + %mt-bishop-services)))) + +andrew-os diff --git a/system/andrew/bta.scm b/system/andrew/bta.scm @@ -0,0 +1,646 @@ +(define-module (system andrew bta) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (gnu packages admin) + #:use-module (gnu packages compression) + #:use-module (gnu packages gnupg) + #:use-module (gnu packages java) + #:use-module (gnu system shadow) + #:use-module (guix gexp) + #:use-module (guix store) + #:use-module (guix base16) + #:use-module (guix modules) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix download) + #:use-module (guix build-system copy) + #:use-module (mt utils) + #:use-module (mt packages games) + #:use-module (ice-9 match) + #:export (bta-mod + bta-mod? + bta-configuration + bta-configuration? + bta-service-type)) + +;; TODO: Grand BTA service w/ unsup setup + +;; 1. Must setup actual server service (already done) +;; 2. Must build packwiz configuration +;; 3. Must serve packwiz configuration over https +;; 4. Must build PrismLauncher instance + +(define %unsup-jar + (origin + (method url-fetch) + (uri "https://git.sleeping.town/exa/unsup/releases/download/v1.2.4/unsup-1.2.4.jar") + (sha256 + (base32 "10nl5qpzh0gm2zhajl9vfv1vakdg1f6p03z33hq8g1zsyg5960zy")))) + +(define %bta-account + (list (user-account + (name "bta") + (group "bta") + (system? #t) + (comment "BTA server user") + (home-directory "/var/lib/bta") + (shell (file-append shadow "/sbin/nologin"))) + (user-group + (name "bta") + (system? #t)))) + +(define (bta-fabric-uri name version) + (string-append + "https://github.com/Turnip-Labs/bta-fabric-instance-repo/releases/download/v" + version "/bta_fabric_" name "_" version ".zip")) + +(define %bta-version "7.3_04") + +(define %bta-fabric-instance + (origin + (method url-fetch/zipbomb) + (uri (bta-fabric-uri "instance" %bta-version)) + (sha256 + (base32 "021xd77s7vh37vssvbyx9r96h5j0dfa7dczb4sk1rv3vdgyjwh98")))) + +(define %bta-fabric-server + (origin + (method url-fetch/zipbomb) + (uri (bta-fabric-uri "server" %bta-version)) + (sha256 + (base32 "18170krqhg61zlsvh7z9c8932qwa3waxalhh7lqdjj0qyp4lc4gr")))) + +(define %bta-pack-name "Holy Cross SMP") + +;; TODO: Add more options +(define-record-type* <bta-configuration> + bta-configuration + make-bta-configuration + bta-configuration? + (jdk bta-configuration-jdk + (default openjdk17)) + (memory bta-configuration-memory + (default 4)) + (properties bta-configuration-properties + (default '())) + (ops bta-configuration-ops + (default '())) + (mods bta-configuration-mods + (default '())) + (home bta-configuration-home + (default "/var/lib/bta")) + (packwiz-home bta-configuration-packwiz-home + (default "/var/www/bta")) + (packwiz-url bta-configuration-packwiz-url + (default "/var/www/bta")) + (log-file bta-configuration-log-file + (default "/var/log/bta.log"))) + +(define-record-type* <bta-mod> + bta-mod + make-bta-mod + bta-mod? + (name bta-mod-name) + (display-name bta-mod-display-name) + (url bta-mod-url) + (sha256 bta-mod-sha256) + (optional bta-mod-optional + (default #f)) + (description bta-mod-description + (default "No description..."))) + +(define bta-activation-rewrite + (match-lambda + (($ <bta-configuration> jdk memory properties ops mods home packwiz-home packwiz-url log-file) + (let* (;; UNSUP STUFF + (unsup-ini + (mixed-text-file "unsup.ini" + "version=1\n" + "preset=minecraft\n" + "update_mmc_pack=false\n" + "source_format=packwiz\n" + "source=" packwiz-url "/pack.toml\n" + "use_envs=false" + "\n" + "[branding]\n" + "modpack_name=" "Holy Cross SMP" "\n")) + (instance-cfg + (mixed-text-file "instance.cfg" + "[General]\n" + "ConfigVersion=1.2\n" + "InstanceType=OneSix\n" + "MCLaunchMethod=LauncherPart\n" + + "iconKey=" "creeper" "\n" + + "OverrideJavaLocation=true\n" + "JavaArchitecture=64\n" + "JavaRealArchitecture=amd64\n" + "JavaSignature=794ed2737a4350c714e4adbbbee59c715cfe1e27\n" + "JavaVendor=Eclipse Adoptium\n" + "JavaVersion=21.0.2\n" + "IgnoreJavaCompatibility=true\n" + + "OverrideJavaArgs=true\n" + "JvmArgs=-javaagent:unsup.jar\n")) + (instance-zip + (computed-file + "instance.zip" + (with-imported-modules '((guix build utils)) + #~(let ((tempdir (mkdtemp "/tmp/unsup-XXXXXX")) + (ogdir (getcwd))) + (use-modules (guix build utils)) + + ;; Bootstrap w/ upstream files + (copy-recursively + #$(file-append %bta-fabric-instance "/patches") + (string-append tempdir "/patches")) + (copy-recursively + #$(file-append %bta-fabric-instance "/jarmods") + (string-append tempdir "/jarmods")) + (copy-recursively + #$(file-append %bta-fabric-instance "/libraries") + (string-append tempdir "/libraries")) + (copy-file + #$(file-append %bta-fabric-instance "/mmc-pack.json") + (string-append tempdir "/mmc-pack.json")) + + ;; Bootsrap unsup + (mkdir (string-append tempdir "/minecraft")) + (copy-file #$%unsup-jar + (string-append tempdir "/minecraft/unsup.jar")) + (copy-file #$unsup-ini + (string-append tempdir "/minecraft/unsup.ini")) + + ;; Bootstrap instance.cfg + (copy-file #$instance-cfg + (string-append tempdir "/instance.cfg")) + + ;; Build zip + (chdir tempdir) + (waitpid + (spawn #$(file-append zip "/bin/zip") + (list "zip" "-r" "-9" + #$output + ".") + #:search-path? #f)) + (chdir ogdir) + + ;; Cleanup + (delete-file-recursively tempdir))))) + ;; PACKWIZ STUFF + (mod-files (map (lambda (mod) + (origin + (method url-fetch) + (uri (bta-mod-url mod)) + (sha256 (bta-mod-sha256 mod)))) + mods)) + (mod-entries (map (lambda (mod) + (mixed-text-file + (string-append (bta-mod-name mod) ".pw.toml") + "name = \"" (bta-mod-display-name mod) "\"\n" + "filename = \"" (string-append (bta-mod-name mod) + ".jar") "\"\n" + "side = \"" "client" "\"\n" + "\n" + "[download]\n" + "url = \"" (bta-mod-url mod) "\"\n" + "hash-format = \"sha256\"\n" + "hash = \"" (bytevector->base16-string + (bta-mod-sha256 mod)) "\"\n" + "\n" + "[option]\n" + "optional = " (if (bta-mod-optional mod) + "true" + "false") "\n" + "description = \"" (bta-mod-description mod) "\"\n")) + mods)) + ;; TODO: Revise and cleanup + (packwiz-index (computed-file + "index.toml" + (with-imported-modules '((guix base16)) + (with-extensions (list guile-gcrypt) + #~(begin + (use-modules (guix base16) + (gcrypt hash)) + + (call-with-output-file + #$output + (lambda (port) + (display "hash-format = \"sha256\"\n" port) + (for-each + (lambda (entry) + (format port " +[[files]] +file = \"mods/~a\" +hash = \"~a\" +metafile = true +" + (string-drop (basename entry) 33) + (bytevector->base16-string + (file-sha256 entry)))) + '#$mod-entries)))))))) + ;; TODO: Revise and cleanup + (packwiz-pack (computed-file + "pack.toml" + (with-imported-modules '((guix base16)) + (with-extensions (list guile-gcrypt) + #~(begin + (use-modules (guix base16) + (gcrypt hash)) + + (call-with-output-file + #$output + (lambda (port) + (format port "\ +name = \"~a\" +pack-format = \"packwiz:1.1.0\" + +[index] +file = \"index.toml\" +hash-format = \"sha256\" +hash = \"~a\" +" + "Holy Cross SMP" + (bytevector->base16-string + (file-sha256 #$packwiz-index)))))))))) + ;; SERVER STUFF + (server-launcher-properties + (mixed-text-file "fabric-server-launcher.properties" + "serverJar=" + (file-append %bta-fabric-server "/server.jar") + "\n"))) + + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (define (resymlink from to) + (when (file-exists? to) + (delete-file to)) + (symlink from to)) + + (define (remkdir dir) + (when (file-exists? dir) + (delete-file-recursively dir)) + (mkdir dir)) + + (let ((user (getpwnam "bta")) + (packwiz-mod-dir + #$(string-append packwiz-home "/mods")) + (server-mod-dir + #$(string-append home "/mods")) + (server-launcher-properties + #$(string-append home "/fabric-server-launcher.properties")) + (server-properties + #$(string-append home "/server.properties")) + (ops-txt + #$(string-append home "/ops.txt"))) + ;; TODO: Finish + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + ;; Create directories + (unless (file-exists? #$packwiz-home) + (mkdir #$packwiz-home) + (chown #$packwiz-home (passwd:uid user) + (passwd:gid user))) + (unless (file-exists? #$home) + (mkdir #$home) + (chown #$home (passwd:uid user) + (passwd:gid user))) + + ;; Switch to the bta user + (setgid (passwd:gid user)) + (setuid (passwd:uid user)) + + ;; Setup packwiz + (remkdir packwiz-mod-dir) + (resymlink #$packwiz-index + #$(string-append packwiz-home "/index.toml")) + (resymlink #$packwiz-pack + #$(string-append packwiz-home "/pack.toml")) + (for-each + (lambda (mod) + (symlink mod + (string-append packwiz-mod-dir "/" + (string-drop (basename mod) 33)))) + '#$mod-entries) + + ;; Setup instance + (resymlink #$instance-zip + #$(string-append packwiz-home "/instance.zip")) + + ;; Setup server + (resymlink #$server-launcher-properties + server-launcher-properties) + + ;; Initialize server.properties + (call-with-output-file + server-properties + (lambda (port) + (for-each + (lambda (pair) + (format port "~a=~a\n" (car pair) (cdr pair))) + '#$properties))) + + ;; Initialize ops.txt + (unless (file-exists? ops-txt) + (call-with-output-file + ops-txt + (lambda (port) + (for-each + (lambda (uuid) + (format port "~a\n" uuid)) + '#$ops)))) + + ;; Symlink mods + (remkdir server-mod-dir) + (for-each + (lambda (mod) + (symlink mod + (string-append server-mod-dir "/" + (string-drop (basename mod) 33)))) + '#$mod-files) + + ;; Return to main thread + (primitive-exit 0)) + (lambda () + (primitive-exit 1)))) + (pid (waitpid pid)))))))))) + +(define bta-activation + (match-lambda + (($ <bta-configuration> jdk memory properties ops mods home packwiz-home packwiz-url log-file) + (with-imported-modules (source-module-closure + '((guix build utils) + (guix base16) + (gcrypt hash))) + #~(begin + (use-modules (guix build utils) + (guix base16) + (gcrypt hash) + (ice-9 match)) + + (let* ((user (getpwnam "bta")) + ;; Server + (server-launcher-properties + #$(string-append home "/fabric-server-launcher.properties")) + (server-properties #$(string-append home "/server.properties")) + (ops-txt #$(string-append home "/ops.txt")) + (mod-dir #$(string-append home "/mods/")) + ;; Packwiz + (packwiz-url "https://monastech.xyz/bta") + (packwiz-dir "/var/www/monastech.xyz/bta") + (packwiz-index (string-append packwiz-dir "/index.toml")) + (packwiz-pack (string-append packwiz-dir "/pack.toml")) + (packwiz-mod-dir (string-append packwiz-dir "/mods/"))) + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + ;; Create packwiz directory + (unless (file-exists? packwiz-dir) + (mkdir packwiz-dir) + (chown packwiz-dir (passwd:uid user) + (passwd:gid user))) + + ;; Switch to the bta user + (setgid (passwd:gid user)) + (setuid (passwd:uid user)) + + ;; Write to fabric-server-launcher.properties + (call-with-output-file + server-launcher-properties + (lambda (port) + (format port "serverJar=~a\n" + #$(file-append %bta-fabric-server + "/server.jar")))) + + ;; Write to server.properties + (call-with-output-file + server-properties + (lambda (port) + (for-each + (lambda (pair) + (format port "~a=~a\n" (car pair) (cdr pair))) + '#$properties))) + + ;; Initialize ops.txt + (unless (file-exists? ops-txt) + (call-with-output-file + ops-txt + (lambda (port) + (for-each + (lambda (uuid) + (format port "~a\n" uuid)) + '#$ops)))) + + ;; Reset mod folder + (if (file-exists? mod-dir) + (delete-file-recursively mod-dir)) + (mkdir mod-dir) + + ;; Reset packwiz mod folder + (if (file-exists? packwiz-mod-dir) + (delete-file-recursively packwiz-mod-dir)) + (mkdir packwiz-mod-dir) + + ;; Generate index and mod entries + (call-with-output-file + packwiz-index + (lambda (index-port) + (display "hash-format = \"sha256\"\n" index-port) + + ;; Iterate over mods + (for-each + (lambda (mod) + (let* ((mod-file-name (string-drop (basename mod) 33)) + (mod-name (string-drop-right mod-file-name 4)) + (mod-packwiz-entry (string-append mod-name + ".pw.toml")) + (mod-packwiz-entry-absolute + (string-append packwiz-mod-dir + mod-packwiz-entry))) + ;; Symlink mod into the server mod folder + (symlink mod (string-append mod-dir mod-file-name)) + + ;; Create the packwiz entry + (call-with-output-file + mod-packwiz-entry-absolute + (lambda (port) + (format port "\ +name = \"~a\" +filename = \"~a\" +side = \"client\" + +[download] +url = \"~a\" +hash-format = \"sha256\" +hash = \"~a\" + +[option] +optional = false +" + mod-name + mod-file-name + (string-append packwiz-url "/mods/" + mod-file-name) + (bytevector->base16-string + (file-sha256 mod))))) + + ;; Write the entry into the packwiz index + (format index-port " +[[files]] +file = \"~a\" +hash = \"~a\" +metafile = true +" + (string-append "mods/" mod-packwiz-entry) + (bytevector->base16-string + (file-sha256 mod-packwiz-entry-absolute))) + + ;; Serve the mod for the packwiz entry + (symlink mod (string-append packwiz-mod-dir + mod-file-name)))) + '#$mods))) + + (call-with-output-file + packwiz-pack + (lambda (port) + (format port "\ +name = \"~a\" +version = \"0.0.1\" +pack-format = \"packwiz:1.1.0\" + +[index] +file = \"index.toml\" +hash-format = \"sha256\" +hash = \"~a\" +" + #$%bta-pack-name + (bytevector->base16-string + (file-sha256 packwiz-index))))) + + ;; Create instance.zip + (let ((tempdir (mkdtemp "/tmp/unsup-XXXXXX"))) + ;; Bootstrap w/ upstream files + (copy-recursively + #$(file-append %bta-fabric-instance "/patches") + (string-append tempdir "/patches")) + (copy-recursively + #$(file-append %bta-fabric-instance "/jarmods") + (string-append tempdir "/jarmods")) + (copy-recursively + #$(file-append %bta-fabric-instance "/libraries") + (string-append tempdir "/libraries")) + (copy-file + #$(file-append %bta-fabric-instance "/mmc-pack.json") + (string-append tempdir "/mmc-pack.json")) + + ;; Create instance data + (call-with-output-file + (string-append tempdir "/instance.cfg") + (lambda (port) + (format port "\ +[General] +ConfigVersion=1.2 +InstanceType=OneSix +MCLaunchMethod=LauncherPart + +iconKey=~a + +OverrideJavaLocation=true +JavaArchitecture=64 +JavaRealArchitecture=amd64 +JavaSignature=794ed2737a4350c714e4adbbbee59c715cfe1e27 +JavaVendor=Eclipse Adoptium +JavaVersion=21.0.2 +IgnoreJavaCompatibility=true + +OverrideJavaArgs=true +JvmArgs=-javaagent:unsup.jar" + "creeper"))) + + ;; Setup unsup + (mkdir (string-append tempdir "/minecraft")) + (copy-file #$%unsup-jar + (string-append tempdir "/minecraft/unsup.jar")) + (call-with-output-file + (string-append tempdir "/minecraft/unsup.ini") + (lambda (port) + (format port "\ +version=1 +preset=minecraft +update_mmc_pack=false +source_format=packwiz +source=https://monastech.xyz/bta/pack.toml +use_envs=false + +[branding] +modpack_name=~a +" + #$%bta-pack-name))) + + ;; Export + (let ((instance-zip (string-append packwiz-dir + "/instance.zip")) + (ogdir (getcwd))) + (unless (file-exists? instance-zip) + (delete-file instance-zip)) + (chdir tempdir) + (waitpid + (spawn #$(file-append zip "/bin/zip") + (list "zip" "-r" "-9" + instance-zip + ".") + #:search-path? #f)) + (chdir ogdir)) + + ;; Cleanup + (delete-file-recursively tempdir)) + + ;; Return to main thread + (primitive-exit 0)) + (lambda () + (primitive-exit 1)))) + (pid (waitpid pid))))))))) + + +(define bta-shepherd-service + (match-lambda + (($ <bta-configuration> jdk memory properties ops mods home log-file) + (shepherd-service + (documentation "BTA server") + (provision '(bta)) + (requirement '(user-processes networking)) + (start #~(make-forkexec-constructor + (list #$(file-append jdk "/bin/java") + "-Dfabric.runtimeMappingNamespace=official" + #$(format #f "-Xmx~aG" memory) + "-jar" #$(file-append %bta-fabric-server + "/fabric-server-launch.jar") + "nogui") + #:user "bta" + #:group "bta" + #:directory #$home + #:log-file #$log-file)) + (stop #~(make-kill-destructor SIGINT)))))) + +(define bta-service-type + (service-type + (name 'bta) + (extensions + (list (service-extension account-service-type + (const %bta-account)) + (service-extension activation-service-type + bta-activation-rewrite) + (service-extension shepherd-root-service-type + (compose list bta-shepherd-service)))) + (default-value (bta-configuration)) + (description "Run a BTA server."))) diff --git a/system/andrew/ci.scm b/system/andrew/ci.scm @@ -0,0 +1,198 @@ +(define-module (system andrew ci) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (gnu packages version-control) + #:export (update-channels-locked-service-type)) + +;;; CI + +;; TODO: Integrate with the gitolite-service-type + +;; TODO: Integrate VREFs + +;; This service updates the %mt-channels-locked variable and builds all client +;; configurations using it + +(define (update-channels-locked-shepherd-service config) + (define gitolite-home "/var/lib/gitolite") + + (define code + (let ((gitolite-bin (file-append gitolite "/bin/gitolite")) + (git-bin (file-append git "/bin/git"))) + (with-imported-modules (source-module-closure '((guix build utils))) + #~(begin + (use-modules (guix build utils) + (ice-9 rdelim) + (ice-9 popen) + (ice-9 ftw) + (rnrs io ports)) + + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line) + + ;; Utility functions + (define (collect-lines port) + "Collect all lines from a port in a list" + (let loop ((line (read-line port)) + (acc '())) + (if (eof-object? line) + (begin (close-port port) + acc) + (loop (read-line port) + (cons line acc))))) + + (define (spawn* prog args search) + "Spawn a program and return success as #t or #f" + (zero? (cdr (waitpid + (spawn prog args + #:search-path? #t))))) + + (define (repo-path name) + (string-append #$gitolite-home "/repositories/" name ".git")) + + ;; Main code + (let ((ogdir (getcwd)) + (channeldir (mkdtemp "/tmp/mt-channel-XXXXXX"))) + ;; Initial setup + (unless (and (spawn* #$git-bin + (list "git" "clone" "--shared" + (repo-path "channel") + channeldir) + #f) + (spawn* "guix" + (list "guix" "pull" "-C" + (string-append channeldir + "/mt/channels.scm")) + #t) + (call-with-output-file + (string-append channeldir "/mt/channels-locked.scm") + (lambda (out) + (display "\ +(define-module (mt channels-locked) + #:use-module (guix channels) + #:export (%mt-channels-locked)) + +(define %mt-channels-locked\n" out) + (flush-output-port out) + (let ((result (waitpid + (spawn "guix" + '("guix" "describe" + "--format=channels") + #:output out)))) + (display ")\n\n%mt-channels-locked\n" out) + (flush-output-port out) + (zero? (cdr result)))))) + (display "Failed to pull / write new channels!\n" + (current-error-port)) + (delete-file-recursively channeldir) + (exit 1)) + + ;; Iterate over clients + (let ((output-pipe (pipe))) + (spawn #$gitolite-bin + '("gitolite" "list-members" "@client-repos") + #:output (cdr output-pipe) + #:search-path? #f) + (close-port (cdr output-pipe)) + + (for-each + (lambda (name) + (let* ((configdir (mkdtemp "/tmp/mt-config-XXXXXX")) + (systemdir (string-append configdir "/system/")) + (homedir (string-append configdir "/home/"))) + (if (spawn* #$git-bin + (list "git" "clone" + "--shared" + (repo-path name) + configdir) + #f) + (begin + (format #t "Building ~a's system configurations...\n" name) + (for-each + (lambda (file) + (format #t "~a: Building \"~a\"...\n" name file) + (if (spawn* "guix" + (list "guix" "system" "build" + "-L" channeldir + "-L" configdir + "--verbosity=0" + (string-append systemdir file)) + #t) + (format #t "~a: Built \"~a\"!\n" name file) + (format #t "~a: Failed to build \"~a\"!\n" name file))) + (scandir systemdir + (lambda (file) + (string-suffix? ".scm" file)))) + + (format #t "Building ~a's home configurations...\n" name) + (for-each + (lambda (file) + (format #t "~a: Building \"~a\"...\n" name file) + (if (spawn* "guix" + (list "guix" "home" "build" + "-L" channeldir + "-L" configdir + "--verbosity=0" + (string-append homedir file)) + #t) + (format #t "~a: Built \"~a\"!\n" name file) + (format #t "~a: Failed to build \"~a\"!\n" name file))) + (scandir homedir + (lambda (file) + (string-suffix? ".scm" file))))) + (format #t "Failed to clone ~a repo! Skipping...\n" name)) + + ;; Cleanup + (delete-file-recursively configdir))) + (collect-lines (car output-pipe)))) + + ;; Push changes + (chdir channeldir) + (unless (and (spawn* #$git-bin + '("git" "add" + "mt/channels-locked.scm") + #f) + (spawn* #$git-bin + '("git" "commit" + "-m" "channels: %mt-channels-locked") + #f) + (spawn* #$gitolite-bin + '("gitolite" "push") + #f)) + (display "Failed to push changes!\n" (current-error-port))) + (chdir ogdir) + + ;; Cleanup + (delete-file-recursively channeldir)))))) + + (list (shepherd-service + (provision '(update-channels-locked)) + (requirement '(user-processes networking)) + (modules '((shepherd service timer))) + (start #~(make-timer-constructor + (calendar-event #:hours '(0) #:minutes '(0) + #:days-of-week '(sunday)) + (command `(#$(program-file "update-channels-locked" code)) + ;; We need to use the user's current guix version, + ;; and the system default if there's not one yet. + #:environment-variables + `(#$(string-append "PATH=" gitolite-home "/.config/guix/current/bin" + ":" "/run/current-system/profile/bin") + #$(string-append "HOME=" gitolite-home)) + #:user "git" + #:group "git") + #:log-file "/var/log/update-channels-locked.log" + #:wait-for-termination? #t)) + (stop #~(make-timer-destructor)) + (actions (list shepherd-trigger-action))))) + +(define update-channels-locked-service-type + (service-type + (name 'update-channels-locked) + (extensions + (list (service-extension shepherd-root-service-type + update-channels-locked-shepherd-service))) + (description "Update the locked channels and build user configurations.") + (default-value '())))