tribes/guix-tribes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add node management CLI and split Tribes launcher

Browse Source
This commit is contained in:
Steffen
2026-04-02 08:47:19 +02:00
parent ea249f1975
commit 71ca0a2530
7 changed files with 176 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

@@ -44,5 +44,5 @@ For pinned bootstrap usage, generate a `channels.scm` that combines upstream
Guix with this repository's current commit.
The deployment scripts default to the checked-in base-channel lock at
`pins/base-channels.sexpr`. Refresh that lock intentionally with
`pins/base-channels.sexp`. Refresh that lock intentionally with
`../guix-deploy/scripts/update-base-channels-pin`.

0
pins/base-channels.sexpr → pins/base-channels.sexp
View File

126
tribes/packages/cli.scm Normal file
View File

@@ -0,0 +1,126 @@
(define-module (tribes packages cli)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system trivial)
#:use-module (guix gexp)
#:use-module (guix packages)
#:export (tribes-command-package))
(define tribes-command-program
(program-file
"tribes"
#~(begin
(use-modules (ice-9 format)
(ice-9 ftw)
(ice-9 match)
(ice-9 posix)
(srfi srfi-1))
(define channels-file "/etc/tribes/channels.sexp")
(define host-config-file "/etc/tribes/host-config.sexp")
(define system-guix "/run/current-system/profile/bin/guix")
(define (home-directory)
(let ((entry (getpwuid (getuid))))
(if entry
(passwd:dir entry)
"/root")))
(define (pulled-guix)
(string-append (home-directory) "/.config/guix/current/bin/guix"))
(define (guix-binary)
(cond
((file-exists? (pulled-guix)) (pulled-guix))
((file-exists? system-guix) system-guix)
(else "guix")))
(define (print-usage port)
(format port "Usage: tribes <command>~%")
(format port "~%Commands:~%")
(format port " help Show this help.~%")
(format port " os status Show node update state.~%")
(format port " os update Pull channels and reconfigure the OS.~%"))
(define (require-root)
(unless (zero? (getuid))
(format (current-error-port)
"tribes os update must run as root.~%")
(exit 1)))
(define (ensure-managed-file path)
(unless (file-exists? path)
(format (current-error-port)
"missing managed file: ~a~%"
path)
(exit 1)))
(define (run command . args)
(let ((status (apply system* command args)))
(if (and (integer? status) (zero? status))
0
(if (integer? status) status 1))))
(define (os-status)
(format #t "channels: ~a~%" channels-file)
(format #t " exists: ~a~%" (file-exists? channels-file))
(format #t "host config: ~a~%" host-config-file)
(format #t " exists: ~a~%" (file-exists? host-config-file))
(format #t "system guix: ~a~%" system-guix)
(format #t " exists: ~a~%" (file-exists? system-guix))
(format #t "selected guix: ~a~%" (guix-binary))
(format #t "current system: ~a~%"
(or (false-if-exception (readlink "/run/current-system"))
"unknown"))
(exit (run (guix-binary) "describe")))
(define (os-update)
(require-root)
(ensure-managed-file channels-file)
(ensure-managed-file host-config-file)
(let ((bootstrap-guix (if (file-exists? system-guix)
system-guix
(guix-binary))))
(let ((pull-status
(run bootstrap-guix
"pull"
"--allow-downgrades"
"-C"
channels-file)))
(unless (zero? pull-status)
(exit pull-status))))
(exit (run (guix-binary)
"system"
"reconfigure"
host-config-file)))
(match (cdr (command-line))
(() (print-usage (current-output-port)))
(("help") (print-usage (current-output-port)))
(("os" "status") (os-status))
(("os" "update") (os-update))
(_
(print-usage (current-error-port))
(exit 1))))))
(define tribes-command-package
(package
(name "tribes-command")
(version "0.1")
(source #f)
(build-system trivial-build-system)
(arguments
(list
#:modules '((guix build utils))
#:builder
#~(begin
(use-modules (guix build utils))
(let ((bin-dir (string-append #$output "/bin")))
(mkdir-p bin-dir)
(copy-file #+tribes-command-program
(string-append bin-dir "/tribes"))
(chmod (string-append bin-dir "/tribes") #o555)))))
(home-page "https://git.teralink.net/tribes/guix-tribes.git")
(synopsis "Tribes node administration command")
(description
"Command-line helper for updating and inspecting a deployed Tribes node.")
(license license:asl2.0)))

13
tribes/packages/source.scm
View File

@@ -38,7 +38,7 @@
"https://git.teralink.net/tribes/tribes.git")
(define %tribes-commit
"32c64bfba5bb3bf4741e37a3297b249c4cacc76e")
"1e026a60fdabcec8b9ec0a850a03f903d02496e7")
(define %tribes-revision "1")
@@ -46,7 +46,7 @@
(git-version "0.2.0" %tribes-revision %tribes-commit))
(define %tribes-source-sha256
"08sx47qpis1h758iwmdnld9x8975wyp1fx96bmly0n723mhx3b60")
"1lqls1ngy3vpf0hh9jn44h1g9rx1hglj9ik3zi1ywcr4q01pmv68")
(define %tribes-upstream-source
(origin
@@ -283,7 +283,14 @@ using MIX-DEPS as the pre-fetched Mix dependency tree resolved from mix.lock."
(if existing-erl-flags
(setenv "ERL_FLAGS" existing-erl-flags)
(unsetenv "ERL_FLAGS")))
(invoke "mix" "deps.compile")))))
(invoke "mix" "deps.compile"))
#:install-gexp
#~(begin
(invoke "mix" "release" "--no-deps-check" "--path" out)
(let ((launcher (string-append out "/bin/" #$name))
(launcher-app (string-append out "/bin/" #$name "-app")))
(when (file-exists? launcher)
(rename-file launcher launcher-app)))))))
(define* (local-tribes-package directory
#:key

35
tribes/services/hitch.scm
View File

@@ -1,5 +1,7 @@
(define-module (tribes services hitch)
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu packages linux)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
@@ -7,6 +9,7 @@
#:use-module (guix records)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (tribes packages web)
#:export (hitch-configuration
hitch-configuration?
@@ -78,7 +81,6 @@
"ciphers = \"" ciphers "\"\n"
"user = \"" user "\"\n"
"group = \"" group "\"\n"
"pidfile = \"" pid-file "\"\n"
"ocsp-dir = \"" ocsp-dir "\"\n"
(string-concatenate
(map (lambda (line)
@@ -91,9 +93,27 @@
(mkdir-p "/var/run/hitch")
(mkdir-p #$(hitch-configuration-ocsp-dir config))))
(define (hitch-reload-procedure package)
#~(lambda _
(use-modules (ice-9 popen)
(ice-9 rdelim))
(let* ((port (open-pipe* OPEN_READ
#$(file-append procps "/bin/pidof")
"hitch"))
(line (read-line port))
(status (close-pipe port)))
(and (zero? status)
(string? line)
(not (eof-object? line))
(let ((pid (string->number
(car (string-tokenize line)))))
(and pid
(zero? (system* #$(file-append coreutils "/bin/kill")
"-HUP"
(number->string pid)))))))))
(define (hitch-shepherd-services config)
(let ((config-file (hitch-config-file config))
(pid-file (hitch-configuration-pid-file config))
(package (hitch-configuration-package config)))
(list
(shepherd-service
@@ -103,22 +123,15 @@
(start
#~(make-forkexec-constructor
(list #$(file-append package "/sbin/hitch")
"--daemon"
"--config"
#$config-file)
#:pid-file #$pid-file))
#$config-file)))
(stop #~(make-kill-destructor))
(actions
(list
(shepherd-action
(name 'reload)
(documentation "Reload Hitch certificates and listeners.")
(procedure
#~(lambda _
(use-modules (ice-9 posix))
(let ((pid (call-with-input-file #$pid-file read)))
(kill pid SIGHUP)
#t))))))))))
(procedure (hitch-reload-procedure package)))))))))
(define hitch-service-type
(service-type

15
tribes/services/tribes.scm
View File

@@ -13,6 +13,7 @@
#:use-module (guix records)
#:use-module (ice-9 match)
#:use-module (srfi srfi-13)
#:use-module (tribes packages cli)
#:use-module (tribes packages terminals)
#:export (tribes-configuration
tribes-configuration?
@@ -241,8 +242,8 @@
(setenv "RELEASE_COOKIE" (read-secret release-cookie-file))
#$@env-setters
(apply execl
#$(file-append package "/bin/tribes")
"tribes"
#$(file-append package "/bin/tribes-app")
"tribes-app"
(cons #$command '#$args)))))
(define (tribes-activation config)
@@ -306,8 +307,16 @@
(define (tribes-profile-packages config)
(match (tribes-configuration-package config)
(#f (list rsync ripgrep fd tmux neovim btop ghostty-terminfo))
(#f (list tribes-command-package
rsync
ripgrep
fd
tmux
neovim
btop
ghostty-terminfo))
(package (list package
tribes-command-package
rsync
ripgrep
fd

8
tribes/services/vinyl.scm
View File

@@ -75,8 +75,7 @@
(match config
(($ <vinyl-configuration> package name backend vcl listen storage
parameters extra-options)
(let ((state-dir (vinyl-state-directory name))
(pid-file (string-append (vinyl-state-directory name) "/_.pid")))
(let ((state-dir (vinyl-state-directory name)))
(list
(shepherd-service
(documentation (string-append "Run the Vinyl cache service (" name ")."))
@@ -85,9 +84,9 @@
(start
#~(make-forkexec-constructor
(list #$(file-append package "/sbin/vinyld")
"-F"
"-n" #$state-dir
"-i" #$name
"-P" #$pid-file
#$@(if vcl
#~("-f" #$vcl)
#~("-b" #$backend))
@@ -103,8 +102,7 @@
(car parameter)
(cdr parameter))))
parameters)
#$@extra-options)
#:pid-file #$pid-file))
#$@extra-options)))
(stop #~(make-kill-destructor))))))))
configs))