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

Compare commits

merge into: tribes/guix-tribes:supertest-dev
Branches Tags
tribes/guix-tribes:master tribes/guix-tribes:kexec-installer tribes/guix-tribes:supertest-dev tribes/guix-tribes:supertest-dev-cluster-pubsub-linear tribes/guix-tribes:fix/compile-bundled-tribes-ui tribes/guix-tribes:keyring
..
pull from: tribes/guix-tribes:fix/compile-bundled-tribes-ui
Branches Tags
tribes/guix-tribes:kexec-installer tribes/guix-tribes:master tribes/guix-tribes:supertest-dev tribes/guix-tribes:supertest-dev-cluster-pubsub-linear tribes/guix-tribes:fix/compile-bundled-tribes-ui tribes/guix-tribes:keyring

12 Commits
supertest-dev .. fix/compile-bundled-tribes-ui

Author SHA1 Message Date
self 76985222e7 feat: build channel plugins in substitute baseline 2026-05-02 23:42:58 +02:00
self 5ecd1fbffe fix: compile bundled tribes_ui plugin 
Compile the in-tree tribes_ui Mix project during the Tribes release build and install its ebin output into the packaged plugin directory so the runtime plugin loader can load the entry module.
 2026-05-02 22:24:17 +02:00
self 05c493bcf9 test: avoid running guile suites on import 2026-05-02 21:27:57 +02:00
self 29502781d8 chore: Bump tribes 2026-05-02 20:25:40 +02:00
self e13c136c09 test: harden local-control worker state 2026-05-02 19:39:28 +02:00
self 8849107168 fix: resolve herd for rollback migrations 2026-05-01 16:50:07 +02:00
self 39b1ed800a fix: skip no-op pulls and stabilize generation diagnostics 2026-05-01 16:42:42 +02:00
self 5a348e7c54 fix: run plugin rollback migrations 2026-05-01 15:30:58 +02:00
self 2484fe208e fix: skip wx-dependent OTP apps 2026-05-01 12:51:25 +02:00
self 2932ca1e95 fix: disable Erlang wx application 
Use OTP's supported --without-wx configure flag instead of --disable-wx so the wx application is actually excluded from the lean build baseline.
 2026-04-30 17:47:48 +02:00
self c471473a54 fix: establish lean plugin build baseline 
Disable wx in the OTP 28 package used by Tribes builds and route Mix/Rebar through the matching Rebar package so server builds do not pull in the wx/GUI dependency graph.

Make plugin builds closer to the host build foundation by avoiding Node unless assets are built and vendoring libsecp256k1 for hermetic NIF compilation. Add diffutils for secp256k1 configure checks.
 2026-04-30 17:06:07 +02:00
self ebe790f2a0 feat: introduce supertest plugin 
Add the supertest fixture plugin to the Guix plugin registry so rollout preview can resolve the plugin name from the baseline channel while development continues on the signed supertest-dev branch.
 2026-04-30 13:13:01 +02:00
89 changed files with 1233 additions and 10438 deletions
Expand all files Collapse all files
.gitea/workflows/pinned-e2e.yml
-110
View File
@@ -1,110 +0,0 @@
name: Pinned Docker E2E
on:
push:
branches: [master]
workflow_dispatch:
concurrency:
group: pinned-docker-e2e-${{ github.ref }}
cancel-in-progress: true
jobs:
pinned-docker-e2e:
if: ${{ github.event_name == 'workflow_dispatch' || github.actor == 'self' }}
runs-on: nix-host
timeout-minutes: 90
env:
GUIX_SUBSTITUTE_GRACE_SECONDS: "1800"
TRIBES_DOCKER_MIRROR_URL: https://mirror.tribe-one.org/tribes-1
TRIBES_DOCKER_SYSTEM: x86_64-linux
NIX_REMOTE: daemon
NIX_CONFIG: |
experimental-features = nix-command flakes
PATH: /root/.nix-profile/bin:/run/current-system/sw/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin
steps:
- uses: actions/checkout@v4
- name: Probe host Nix
run: |
nix --version
nix store info --store daemon
nix config show | grep -E 'sandbox|experimental-features|substituters' || true
- name: Install devenv
run: nix profile add nixpkgs#devenv
- name: Wait for Guix substitute/image builder
run: sleep "$GUIX_SUBSTITUTE_GRACE_SECONDS"
- name: Download pinned debug Docker image
run: |
set -euo pipefail
commit="$(git rev-parse HEAD)"
image="tribes-debug-docker-${TRIBES_DOCKER_SYSTEM}-${commit}.tar.gz"
base="${TRIBES_DOCKER_MIRROR_URL%/}"
download() {
output="$1"
url="$2"
for attempt in $(seq 1 12); do
if curl --fail --location --output "$output" "$url"; then
return 0
fi
echo "download failed (attempt ${attempt}/12): $url" >&2
sleep 15
done
return 1
}
download "$image" "$base/$image"
download "$image.sha256" "$base/$image.sha256"
sha256sum -c "$image.sha256"
loaded_image="$(docker load < "$image" | awk -F': ' '/Loaded image:/ { print $2; exit }')"
echo "TRIBES_IMAGE=${loaded_image}" >> "$GITHUB_ENV"
- name: Check out pinned Tribes e2e harness
run: |
set -euo pipefail
tribes_commit="$(awk '
/\(define %tribes-commit/ { in_commit = 1; next }
in_commit && match($0, /"[0-9a-f]{40}"/) {
print substr($0, RSTART + 1, 40)
exit
}
' tribes/packages/source.scm)"
if [ -z "$tribes_commit" ]; then
echo "failed to parse %tribes-commit" >&2
exit 1
fi
rm -rf ../tribes-e2e
git clone https://git.teralink.net/tribes/tribes.git ../tribes-e2e
git -C ../tribes-e2e checkout "$tribes_commit"
- name: Run core Docker e2e
run: |
set -euo pipefail
cd ../tribes-e2e
devenv shell -- bash -c '
set -euo pipefail
mix local.hex --force
mix local.rebar --force
mix deps.get
env \
SKIP_BUILD=1 \
TRIBES_IMAGE="$TRIBES_IMAGE" \
TRIBES_E2E_WITHOUT_SUPERTEST=1 \
scripts/run_e2e.sh --without-supertest
'
.guix-authorizations
+1 -3
View File
@@ -5,6 +5,4 @@
(version 0)
(("6688 9153 C51C 4613 A493 A525 2F0D FD14 EF99 DAC3"
(name "steffen")) ("F29B A6DA 96E5 EC29 FDDE D994 8F4F 75B3 B19D 4784"
(name "tribes-supertest-dev"))
))
(name "steffen"))))
.supertest-dev-sync.json
-7
View File
@@ -1,7 +0,0 @@
{
"mode" : "tree-sync",
"previous_dev_commit" : "593745da5e4135abc63956442e853dd2643e46ae",
"source_branch" : "origin/master",
"source_commit" : "54f23bc863ebef8173faf2aaf21801050e09fb53",
"synced_at" : "2026-06-09T07:43:46Z"
}
README.md
+53 -108
View File
@@ -1,120 +1,65 @@
# Guix Tribes Channel
## NBDE Channel
This repository is the Guix channel for Tribes OS. It contains the package,
service, system, installer, deployment, and substitute-builder definitions used
to build and operate Tribes nodes.
This repository provides the Guix-side pieces for network-bound disk
encryption:
## Contents
- `nbde/packages/crypto.scm`
Package definitions for `luksmeta`, `tang`, and `clevis`.
- `nbde/services/tang.scm`
A standalone Tang service for Guix systems.
- `nbde/system/mapped-devices.scm`
A Clevis-backed mapped-device kind with manual `cryptsetup` fallback.
- `nbde/system/initrd.scm`
A helper around `raw-initrd` for early-boot Clevis support.
- `examples/phase0-system.scm`
Minimal reference system using the Clevis-backed mapped-device kind and
custom initrd.
Network-bound disk encryption (NBDE):
- `nbde/packages/crypto.scm`: package definitions for `luksmeta`, `tang`, and
`clevis`.
- `nbde/services/tang.scm`: standalone Tang service for Guix systems.
- `nbde/system/mapped-devices.scm`: Clevis-backed mapped-device kind with manual
`cryptsetup` fallback.
- `nbde/system/initrd.scm`: early-boot Clevis support around `raw-initrd`.
- `docs/nbde.md`: operational notes for LUKS headers, initrd, Tang, and
`/boot/nbde/local-boot.key`.
Tribes packages and systems:
- `tribes/packages/devtools.scm` and `tribes/packages/node.scm`: shared tooling
package definitions used by repo-local Guix development manifests.
- `tribes/packages/source.scm`: source-built Tribes package producing a
production release from pinned source plus vendored Mix/npm dependency FODs.
- `tribes/plugins/*.scm`: external plugin package definitions and plugin
metadata.
- `tribes/services/*.scm`: Shepherd services for Tribes and supporting runtime
components.
- `tribes/system/node.scm`: node operating-system constructor.
- `tribes/system/installer.scm`: installer-facing Tribes OS constructor.
- `manifests/substitutes/*.scm` and `tribes/ci/substitutes.scm`: substitute
builder manifests and CI targets.
Deployment and diagnostics:
- `tribes/deploy/*.scm`: deployment helper API and worker/operation support used
by Legion.
- `tribes/diagnostics/*.scm`: diagnostics helpers, including system generation
comparison.
- `scripts/build-kexec-image`: builds the Legion kexec installer image.
- `scripts/build-tribes-docker-image`: builds the pinned Tribes debug Docker
image.
## Pin maintenance
Refresh the upstream Guix channel pin intentionally with:
```sh
./scripts/update-base-channels-pin
```
The script updates `pins/base-channels.sexp` and syncs the Guix entry in
`pins/legion-channels.sexp`. It auto-detects whether the current pin uses the
local `guix-fork` channel or the mirrored official Guix channel, uses the
matching sibling checkout head by default (`../guix-fork` or `../guix`), accepts
`--commit COMMIT`, and can switch back to the mirrored official channel with
`--official`.
After changing the base channel pin, run Legion's generator in `../legion_kk`:
```sh
npm run generate:guix-base-channel
```
Refresh the Tribes and external plugin source pins with:
```sh
./scripts/update-tribes-and-plugin-pins
```
By default, the pin update scripts use local `guix` for hashing and fixed-output
builds. If the local host is not suitable for Guix networked fixed-output builds,
run them explicitly on an SSH build host:
```sh
./scripts/update-tribes-and-plugin-pins --build-host HOST
```
Use `--commit` to commit the affected pin files after a successful refresh:
```sh
./scripts/update-tribes-and-plugin-pins --commit
```
The combined script updates:
It now also carries the first Tribes deployment substrate:
- `tribes/packages/release.scm`
A deployment-bridge package wrapper for a prebuilt Tribes release tree.
- `tribes/packages/source.scm`
- `tribes/plugins/sender.scm`
- `tribes/plugins/aether.scm`
- `tribes/plugins/supertest.scm`
- `tribes/plugins/kobold.scm`
- `tribes/plugins/trust.scm`
A real source-built Tribes package that produces a production release from
vendored Mix and npm dependency trees plus local Parrhesia source.
Local-source builds accept hash overrides via `TRIBES_MIX_DEPS_SHA256`,
`TRIBES_RAW_MIX_DEPS_SHA256`, and `TRIBES_NPM_DEPS_SHA256`.
- `tribes/services/tribes.scm`
Shepherd service, runtime environment wiring, and account/activation setup
for a Tribes node.
- `tribes/system/node.scm`
A higher-level service bundle that wires PostgreSQL plus the Tribes service.
- `tribes/system/installer.scm`
Installer-facing OS constructor for NBDE-installed Tribes nodes.
- `nbde/system/installed-base.scm`
Shared base installed-system constructor used by both the minimal NBDE flow
and the Tribes-specific installer path.
For one-off updates, use `scripts/update-tribes-pin` or
`scripts/update-plugin-pin --help` directly.
Current development status:
## Channel files
Checked-in channel files serve different roles:
- `pins/base-channels.sexp`: upstream Guix pin only; used for `guix pull -C` and
related bootstrap tooling.
- `pins/legion-channels.sexp`: Legion/build-host default channel set containing
the pinned upstream Guix channel plus default `tribes` channel metadata.
- The `kexec-installer` branch selects the default kexec installer source commit.
1. `luksmeta`, `tang`, and `clevis` build successfully on `pguix`.
2. A disposable Tang + LUKS smoke test passes.
3. A QEMU Phase-0 system with encrypted root now boots unattended through
Clevis/Tang and reaches a login prompt.
For pinned bootstrap usage, generate a `channels.scm` that combines the pinned
upstream Guix channel with this repository's current commit.
## Current development status
Two checked-in channel files serve different purposes:
- NBDE packages and the disposable Tang + LUKS smoke path are working.
- The QEMU Phase-0 encrypted-root system boots unattended through Clevis/Tang and
reaches a login prompt.
- The active Legion kexec image definition is based on
`examples/build-host-kexec-installer.scm` and
`nbde/system/build-host-kexec-installer.scm`.
- Tribes source, plugin, node, installer, Docker debug image, and substitute
manifest definitions are maintained in this channel.
- `pins/base-channels.sexp`: upstream Guix pin only, used for `guix pull -C`
and related bootstrap tooling
- `pins/legion-channels.sexp`: Legion/builder default channel set, containing
the pinned upstream Guix channel plus the default `tribes` channel metadata
Refresh the upstream Guix pin intentionally with
`./scripts/update-base-channels-pin`, then update `pins/legion-channels.sexp`
to keep its `guix` entry aligned.
The current Legion kexec image path is based on:
- `examples/build-host-kexec-installer.scm`
- `nbde/system/build-host-kexec-installer.scm`
That build-host installer is the active kexec image definition used for
Legion deployment bootstrapping.
docs/LOCAL_CONTROL_API.md
+9 -116
View File
@@ -12,7 +12,6 @@ its own host:
- **rollback** to a retained store path or, failing that, rebuild from a
plan and switch.
- **abort** an in-flight job.
- discover channel update candidates from Guix's existing Git checkouts.
- inspect **status** and **generations**.
This document specifies the wire schema. The BEAM client at
@@ -77,9 +76,7 @@ Snapshot fields:
### `GET /v1/deployment/generations`
Returns the current system channel provenance plus the list of recorded generations in newest-first order. The top-level `current_channels` field is parsed from `/run/current-system/channels.scm` when present and lets callers identify the initial installed channel pins before local-control has prepared its first generation.
Each generation entry:
Returns the list of recorded generations in newest-first order. Each entry:
```json
{
@@ -89,101 +86,10 @@ Each generation entry:
"status": "active" | "ready" | "superseded",
"gc_pinned": true,
"built_at": "2026-04-25T13:01:02Z",
"activated_at": "2026-04-25T13:01:42Z",
"channels": [
{
"channel_id": "guix-tribes",
"name": "tribes",
"url": "https://git.example.test/tribes/guix-tribes.git",
"branch": "master",
"commit": "abc123...",
"position": 10
}
]
"activated_at": "2026-04-25T13:01:42Z"
}
```
`channels` is present for generations prepared by local-control from a plan
that included `resolved_channels`. After `guix pull` succeeds, local-control
records the pulled profile's `guix describe --format=json` commit for each
matching channel, so branch-based plans become exact generation pins. Active
generation `channels` are the preferred source for the currently installed
channel commit; callers can fall back to top-level `current_channels` for the
initial non-local-control install.
### `POST /v1/channels/updates`
Synchronous. Discovers update candidates for configured channels by using the
Guix channel Git checkouts under `$XDG_CACHE_HOME/guix/checkouts` or
`$HOME/.cache/guix/checkouts`. The endpoint does not maintain its own checkout
or update database; it locates the checkout whose `remote.origin.url` matches
the requested channel URL, runs `git fetch --tags --prune origin`, and inspects
Git refs directly.
Body:
```json
{
"mode": "semver_tags",
"limit": 20,
"channels": [
{
"id": "...",
"name": "tribes",
"url": "https://git.example.test/tribes/guix-tribes.git",
"branch": "master",
"current_commit": "abc123..."
}
]
}
```
Response:
```json
{
"schemaVersion": "1",
"ok": true,
"mode": "semver_tags",
"channels": [
{
"id": "...",
"name": "tribes",
"url": "https://git.example.test/tribes/guix-tribes.git",
"branch": "master",
"ok": true,
"current_commit": "abc123...",
"branch_head": "def456...",
"candidates": [
{
"tag": "v1.2.3",
"commit": "def456...",
"short_commit": "def4567",
"subject": "release 1.2.3",
"message": "release 1.2.3\n",
"committed_at": "2026-06-07T10:00:00+00:00"
}
]
}
]
}
```
Supported modes:
- `semver_tags` — default. Candidates are tags matching `vMAJOR.MINOR.PATCH`
with optional prerelease/build suffixes, reachable from the configured branch
head, and descendants of `current_commit` when one is provided.
- `commits` — advanced mode. Candidates are recent branch commits after
`current_commit` when it is an ancestor of the branch head, otherwise recent
commits from the branch head.
Guix channel authentication remains enforced later by `deployment/prepare`; this endpoint is discovery only.
Per-channel failures are returned inline with `ok: false` and an error code,
e.g. `checkout_not_found`, `fetch_failed`, `branch_not_found`, or
`unsupported_mode`.
### `POST /v1/deployment/resolve`
Synchronous. Body: a `SystemTarget` JSON object. Response:
@@ -207,12 +113,9 @@ Asynchronous. Body: a plan object containing `plan_hash` and
plan is already in flight.
- `400` on validation error.
The job pulls channels, runs `guix system build --root=...`, pre-realizes the
target system closure and the store inputs needed for the post-switch Shepherd
service-definition upgrade, registers the resulting GC root, and records a
`ready` generation. Keeping this work in `prepare` means missing substitutes or
unexpectedly large local builds fail before the system profile is switched. The
final snapshot is visible at `GET /v1/deployment/status`.
The job pulls channels, runs `guix system build --root=...`, registers the
resulting GC root, and records a `ready` generation. The final snapshot is
visible at `GET /v1/deployment/status`.
### `POST /v1/deployment/commit`
@@ -223,16 +126,12 @@ Asynchronous. Body: `{ "plan_hash": "..." }`.
Shepherd service-definition upgrade step inside the pulled/current Guix
profile used for the prepare build. Activation runs with `GUIX_NEW_SYSTEM`
set to the selected generation so `/run/current-system` follows the
profile, and the NBDE boot-store activation hook copies GRUB-referenced
`/gnu/store` items into `/boot` for nodes whose real store is on encrypted
root. Like upstream `guix system reconfigure`, this does not imply that
every already-running service process was restarted. Tribes may then
profile. Like upstream `guix system reconfigure`, this does not imply
that every already-running service process was restarted. Tribes may then
schedule an asynchronous `tribes` service restart as part of higher-level
rollout convergence, while `tribes-local-control` self-update remains a
separate deferred concern. On later boots, `tribes-boot-start` starts the
app only after Legion-managed secret files exist, keeping the first
secrets-free boot quiet while allowing reboot recovery. On success the
snapshot reaches `phase: "active"` with `status: "completed"`.
separate deferred concern. On success the snapshot reaches `phase:
"active"` with `status: "completed"`.
- `409` if no generation is prepared for that `plan_hash`. The snapshot's
error code is `generation_not_prepared`.
- `409 busy` if another job is in flight.
@@ -284,8 +183,6 @@ Every failed operation returns a `code` matching one of these tokens:
from the channel URL.
- `missing_capability` — a plugin requires a capability that no other
plugin provides.
- `host_capability_missing` — the pinned host and built-in plugin manifests
have an unsatisfied capability contract.
- `capability_cycle` — the plugin capability graph contains a cycle.
- `duplicate_plugin` — the system target lists the same plugin twice.
- `manifest_invalid` — a requested plugin name is unknown to the channel
@@ -295,10 +192,6 @@ Every failed operation returns a `code` matching one of these tokens:
- `migration_target_conflict` — two plugins disagree about a migration
target version.
- `build_failed` — `guix system build` returned non-zero.
- `system_closure_preload_failed` — the prepared system's referenced store
closure could not be realized before switching.
- `service_upgrade_preload_failed` — the post-switch Shepherd
service-definition upgrade inputs could not be realized before switching.
- `switch_failed` — `guix system switch-generation` returned non-zero.
- `rollback_infeasible` — the broker cannot reach the requested store
path by either retained generation or rebuild.
docs/nbde.md
-95
View File
@@ -1,95 +0,0 @@
# NBDE boot policy
This document describes the Guix-side NBDE boot model used by Tribes nodes.
## Storage locations
NBDE state is split across three places:
- The LUKS header stores unlock methods: recovery keyslots, disposable local
boot keyslots, and Clevis/Tang bindings.
- The initrd stores generic unlock logic and helper programs. It must not store
node-local boot key material.
- `/boot/nbde/local-boot.key` stores the disposable local boot key when a node
is allowed to unlock itself without Tang peers.
Tang peer URLs and quorum settings are Clevis metadata in the LUKS header. They
are not baked into the initrd.
## Boot partition key
The initrd is built with generic logic to find the boot partition by UUID, mount
it read-only, and try `nbde/local-boot.key` before falling back to Clevis/Tang
and then interactive `cryptsetup`.
The key path exposed in system facts is:
```json
{
"localBootKeyFile": "/boot/nbde/local-boot.key"
}
```
The key bytes are not imported with `local-file`, so changing the local boot key
does not require a Guix system rebuild or a new initrd generation. Only the
fixed initrd reader logic is part of the system generation.
Legion currently creates `/boot` as an ext4 filesystem for both BIOS and EFI
nodes. EFI nodes also have a vfat `/boot/efi` partition, but the NBDE local boot
key does not live there.
## Unlock methods
Every managed NBDE node has a durable recovery secret controlled by the
management layer. That secret is used for administrative LUKS operations such as
adding local boot keys and binding Clevis pins.
The local boot key is different:
- it is generated when degraded local unlock is needed,
- it is stored only on the node under `/boot/nbde/local-boot.key`,
- it is not stored in Guix store items,
- it is not stored in Legion state,
- it only matters while the matching LUKS keyslot exists.
## State transitions
When entering degraded local-key mode:
1. Generate a fresh local boot key.
2. Write it to `/boot/nbde/local-boot.key`.
3. Add it as a LUKS keyslot using the durable recovery secret.
4. Remove obsolete Clevis bindings.
When leaving degraded mode:
1. Add the desired Clevis/Tang or Clevis SSS quorum binding.
2. Remove obsolete Clevis bindings after the new binding succeeds.
3. Remove the local boot keyslot with `cryptsetup luksRemoveKey`.
4. Best-effort overwrite `/boot/nbde/local-boot.key`, sync, and unlink it.
The LUKS header is the source of truth. If the local keyslot was removed
successfully, a leftover file under `/boot/nbde` is no longer an unlock secret.
Overwriting before unlink is hygiene for cloud block devices and ext4, not a
cryptographic erasure guarantee.
## Threat model
Without Secure Boot, measured boot, or another trusted boot chain, an
unencrypted `/boot` partition is readable by an attacker with disk access. A
local key baked into an initrd on `/boot` and a local key stored as a separate
file on `/boot` therefore have the same practical confidentiality level.
The `/boot/nbde/local-boot.key` model is preferred because it keeps key rotation
out of Guix system generation rebuilds and avoids copying secret bytes through
the Guix store and boot-store staging paths.
## Boot-store staging
The boot-store staging service remains necessary for kernel, initrd, and GRUB
store references. GRUB can read `/boot` before the encrypted root is unlocked,
but it cannot read `/gnu/store` on the encrypted root.
Local boot key material is intentionally outside that mechanism. The initrd
reader is staged as part of the normal system generation; the mutable key file
is managed directly under `/boot/nbde`.
examples/legion-host-config.json
+2 -2
View File
@@ -17,6 +17,7 @@
"syncTlsKeyFile": "/var/lib/tribes/secrets/sync/node-key.pem",
"syncTlsCaCertFile": "/var/lib/tribes/secrets/sync/ca.pem",
"adminPubkeys": [],
"syncOverlapSeconds": 300,
"databaseUser": "tribes",
"databaseName": "tribes",
"parrhesiaDatabaseName": "parrhesia",
@@ -24,8 +25,7 @@
"secretKeyBaseFile": "/var/lib/tribes/secrets/secret_key_base",
"tokenSigningSecretFile": "/var/lib/tribes/secrets/token_signing_secret",
"releaseCookieFile": "/var/lib/tribes/secrets/release_cookie",
"releaseDistribution": "name",
"releaseNode": "tribes@127.0.0.1",
"releaseDistribution": "none",
"extraEnvironmentVariables": [
"TRIBES_BOOTSTRAP_FILE=/etc/tribes/bootstrap.json"
],
manifests/packs/sender-runtime.scm
-18
View File
@@ -1,18 +0,0 @@
(define-module (manifests packs sender-runtime)
#:use-module (gnu packages admin)
#:use-module (gnu packages monitoring)
#:use-module (gnu packages nss)
#:use-module (guix profiles)
#:use-module (tribes packages monitoring)
#:use-module (tribes packages sender-runtime)
#:use-module (tribes packages web))
(packages->manifest
(list tribes-sender-runtime
sender-ffmpeg
vinyl
vinyl-exporter
prometheus-node-exporter
victoriametrics
shepherd
nss-certs))
manifests/substitutes/base.scm
+11 -16
View File
@@ -1,11 +1,9 @@
(define-module (manifests substitutes base)
#:use-module (gnu packages)
#:use-module (gnu packages elixir)
#:use-module (gnu packages erlang)
#:use-module (guix profiles)
#:use-module (nbde packages crypto)
#:use-module (tribes packages terminals)
#:export (base-manifest))
#:use-module (tribes packages otp)
#:use-module (tribes packages terminals))
(define %base-specifications
'("bash-minimal"
@@ -35,15 +33,12 @@
"parted"
"util-linux"))
(define base-manifest
(packages->manifest
(append (map specification->package %base-specifications)
(list clevis
tang
luksmeta
erlang
elixir
elixir-hex
ghostty-terminfo))))
base-manifest
(packages->manifest
(append (map specification->package %base-specifications)
(list clevis
tang
luksmeta
erlang-28
elixir-otp28
elixir-hex-otp28
ghostty-terminfo)))
manifests/substitutes/installer.scm
+5 -9
View File
@@ -1,8 +1,7 @@
(define-module (manifests substitutes installer)
#:use-module (gnu packages)
#:use-module (guix profiles)
#:use-module (nbde packages crypto)
#:export (installer-manifest))
#:use-module (nbde packages crypto))
(define %installer-specifications
'("bash-minimal"
@@ -39,10 +38,7 @@
"parted"
"util-linux"))
(define installer-manifest
(packages->manifest
(append (map specification->package %installer-specifications)
(list clevis
luksmeta))))
installer-manifest
(packages->manifest
(append (map specification->package %installer-specifications)
(list clevis
luksmeta)))
manifests/substitutes/tribes-node.scm
+7 -18
View File
@@ -1,16 +1,11 @@
(define-module (manifests substitutes tribes-node)
#:use-module (gnu packages)
#:use-module (gnu packages elixir)
#:use-module (gnu packages erlang)
#:use-module (gnu packages monitoring)
#:use-module (guix profiles)
#:use-module (tribes packages monitoring)
#:use-module (tribes packages otp)
#:use-module (tribes packages source)
#:use-module (tribes packages terminals)
#:use-module (tribes packages web)
#:use-module (tribes plugins registry)
#:export (tribes-node-manifest
make-tribes-node-manifest))
#:use-module (tribes plugins registry))
(define %tribes-node-specifications
'("nss-certs"
@@ -41,20 +36,14 @@
(packages->manifest
(append
(map specification->package %tribes-node-specifications)
(list erlang
elixir
elixir-hex
(list erlang-28
elixir-otp28
elixir-hex-otp28
ghostty-terminfo
haproxy
hitch
vinyl
lego
prometheus-node-exporter
victoriametrics
vinyl-exporter
(tribes-node-package))
(guix-tribes-plugin-substitute-packages))))
(define tribes-node-manifest
(make-tribes-node-manifest))
tribes-node-manifest
(make-tribes-node-manifest)
nbde/packages/crypto.scm
+1
View File
@@ -18,6 +18,7 @@
#:use-module (gnu packages hardware)
#:use-module (gnu packages jose)
#:use-module (gnu packages linux)
#:use-module (gnu packages ninja)
#:use-module (gnu packages networking)
#:use-module (gnu packages password-utils)
#:use-module (gnu packages pkg-config)
nbde/services/tang.scm
+1 -2
View File
@@ -46,8 +46,7 @@
"-l"
"-p" #$(number->string
(tang-configuration-port config))
#$(tang-configuration-key-directory config))
#:log-file "/var/log/tang.log"))
#$(tang-configuration-key-directory config))))
(stop #~(make-kill-destructor))
(respawn? #f))))
nbde/system/boot-store.scm
+40 -78
View File
@@ -1,87 +1,49 @@
(define-module (nbde system boot-store)
#:use-module (gnu services)
#:use-module (guix build utils)
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-14)
#:export (boot-store-staging-service
grub-config-store-references
stage-boot-store-references!))
(define %store-reference-rx
(make-regexp "/gnu/store/[^\" )\n\r]*"))
(define (trim-store-reference ref)
(string-trim-right ref (char-set #\; #\, #\))))
(define (line-store-references line)
(let loop ((start 0)
(refs '()))
(let ((match (regexp-exec %store-reference-rx line start)))
(if match
(loop (match:end match)
(cons (trim-store-reference (match:substring match 0)) refs))
(reverse refs)))))
(define (grub-config-store-references grub-cfg)
"Return unique /gnu/store references mentioned by GRUB-CFG."
(call-with-input-file grub-cfg
(lambda (port)
(let loop ((line (read-line port 'concat))
(refs '()))
(if (eof-object? line)
(delete-duplicates (reverse refs))
(loop (read-line port 'concat)
(append (reverse (line-store-references line)) refs)))))))
(define (delete-file-or-directory-recursively path)
(when (file-exists? path)
(if (file-is-directory? path)
(begin
(for-each make-file-writable
(find-files path (lambda (_file stat)
(eq? 'directory (stat:type stat)))
#:directories? #t))
(delete-file-recursively path))
(begin
(make-file-writable path)
(delete-file path)))))
(define* (stage-boot-store-references! boot-mount grub-cfg)
"Copy every /gnu/store item referenced by GRUB-CFG below BOOT-MOUNT.
This is needed when the real store lives on the encrypted root device: GRUB can
read /boot before the initrd unlocks root, but it cannot read root's
/gnu/store."
(for-each
(lambda (ref)
(unless (file-exists? ref)
(error "GRUB store reference does not exist" ref))
(let ((target (string-append boot-mount ref)))
(mkdir-p (dirname target))
(delete-file-or-directory-recursively target)
(if (file-is-directory? ref)
(copy-recursively ref target
#:log (%make-void-port "w")
#:keep-mtime? #t
#:keep-permissions? #t)
(copy-file ref target))))
(grub-config-store-references grub-cfg)))
#:export (boot-store-staging-service))
(define (boot-store-staging-gexp)
(with-imported-modules (source-module-closure
'((nbde system boot-store)))
(with-imported-modules '((guix build utils)
(ice-9 regex)
(ice-9 rdelim)
(srfi srfi-1))
#~(begin
(use-modules (nbde system boot-store))
(let ((grub-cfg "/boot/grub/grub.cfg")
(boot-mount "/boot"))
(when (and (file-exists? boot-mount)
(file-exists? grub-cfg))
(stage-boot-store-references! boot-mount grub-cfg))))))
(use-modules (guix build utils)
(ice-9 regex)
(ice-9 rdelim)
(srfi srfi-1))
(define grub-cfg "/boot/grub/grub.cfg")
(define boot-mount "/boot")
(define store-ref-rx (make-regexp "/gnu/store/[^\" )]*"))
(define (store-refs file)
(call-with-input-file file
(lambda (port)
(let loop ((line (read-line port 'concat))
(refs '()))
(if (eof-object? line)
(delete-duplicates (reverse refs))
(let ((match (regexp-exec store-ref-rx line)))
(loop (read-line port 'concat)
(if match
(cons (match:substring match 0) refs)
refs))))))))
(define (stage-ref ref)
(let ((target (string-append boot-mount ref)))
(mkdir-p (dirname target))
(if (file-is-directory? ref)
(begin
(mkdir-p target)
(copy-recursively ref target))
(copy-file ref target))))
(when (and (file-exists? "/boot")
(file-exists? grub-cfg))
(for-each stage-ref
(filter file-exists? (store-refs grub-cfg)))))))
(define (boot-store-staging-service)
(simple-service 'stage-grub-visible-store-items
nbde/system/build-host-kexec-installer.scm
-2
View File
@@ -14,7 +14,6 @@
#:use-module (guix gexp)
#:use-module (nbde packages crypto)
#:use-module (nbde system kexec-initrd)
#:use-module (tribes packages kernel)
#:export (build-host-kexec-installer-os))
(define %build-host-kexec-shell-packages
@@ -78,7 +77,6 @@
(timezone "Etc/UTC")
(locale "en_US.UTF-8")
(keyboard-layout (keyboard-layout "us"))
(kernel tribes-linux)
(label "Guix build-host kexec installer")
(initrd-modules %build-host-kexec-initrd-modules)
(initrd kexec-installer-initrd)
nbde/system/build-host.scm
-3
View File
@@ -3,7 +3,6 @@
#:use-module (gnu packages)
#:use-module (gnu system linux-initrd)
#:use-module (nbde system installed-base)
#:use-module (tribes packages kernel)
#:export (nbde-build-host-operating-system))
(define %build-host-packages
@@ -26,7 +25,6 @@
authorized-keys-file
(timezone "Etc/UTC")
(locale "en_US.UTF-8")
(kernel tribes-linux)
(kernel-arguments
(list "console=tty0"
"console=ttyS0,115200n8"))
@@ -52,7 +50,6 @@ Clevis-specific runtime pieces."
#:authorized-keys-file authorized-keys-file
#:timezone timezone
#:locale locale
#:kernel kernel
#:kernel-arguments kernel-arguments
#:extra-services extra-services))
(packages
nbde/system/installed-base.scm
+3 -27
View File
@@ -5,9 +5,6 @@
#:use-module (gnu services networking)
#:use-module (gnu services ssh)
#:use-module (guix gexp)
#:use-module (nbde system boot-store)
#:use-module (tribes packages kernel)
#:use-module (tribes services logging)
#:export (nbde-installed-operating-system))
(define %tribe-one-guix-substitute-url
@@ -18,24 +15,6 @@
"guix.tribe-one.org-signing-key.pub"
"(public-key \n (ecc \n (curve Ed25519)\n (q #7F0B2300CC4BDA2520DB462BCAD45107E7C874E0E09DC8EF429B145C8A52B306#)\n )\n )\n"))
(define %nbde-initrd-modules
'("bnxt_en"
"ena"
"e1000e"
"i40e"
"ice"
"igb"
"igc"
"ixgbe"
"mlx4_core"
"mlx4_en"
"mlx5_core"
"nvme"
"r8169"
"sd_mod"
"tg3"
"virtio_scsi"))
(define* (nbde-installed-operating-system #:key
host-name
bootloader
@@ -46,12 +25,11 @@
authorized-keys-file
(timezone "Etc/UTC")
(locale "en_US.UTF-8")
(kernel tribes-linux)
(kernel-arguments
(list "console=tty0"
"console=ttyS0,115200n8"))
(initrd-modules
(append %nbde-initrd-modules
(append '("nvme" "sd_mod" "virtio_scsi")
%base-initrd-modules))
(extra-services '()))
"Return a base installed Guix system for the NBDE flow, parameterized by the
@@ -61,7 +39,6 @@ runtime-discovered boot and filesystem values from the installer."
(timezone timezone)
(locale locale)
(keyboard-layout (keyboard-layout "us"))
(kernel kernel)
(kernel-arguments kernel-arguments)
(initrd-modules initrd-modules)
(initrd initrd)
@@ -71,8 +48,7 @@ runtime-discovered boot and filesystem values from the installer."
(services
(append
extra-services
(list (boot-store-staging-service)
(service dhcpcd-service-type)
(list (service dhcpcd-service-type)
(service elogind-service-type)
(service agetty-service-type
(agetty-configuration
@@ -90,4 +66,4 @@ runtime-discovered boot and filesystem values from the installer."
(guix-extension
(authorized-keys (list %tribe-one-guix-signing-key))
(substitute-urls (list %tribe-one-guix-substitute-url)))))
(tribes-base-services)))))
%base-services))))
nbde/system/mapped-devices.scm
+10 -78
View File
@@ -13,31 +13,20 @@
#:key
(clevis-package clevis)
key-file
boot-key-file
boot-device-uuid
(boot-file-system-type "ext4")
allow-discards?
(extra-options '()))
"Return a gexp that unlocks SOURCE with a boot key file, Clevis, or an
interactive cryptsetup fallback. BOOT-KEY-FILE is relative to the boot
partition and is read at boot time, not baked into the initrd."
"Return a gexp that first tries to unlock SOURCE using Clevis and falls back
to interactive cryptsetup when that fails. The fallback path intentionally
keeps a manual recovery slot available."
(with-imported-modules (source-module-closure
'((gnu build file-systems)
(guix build syscalls)
(guix build utils)))
(match targets
((target)
#~(let ((source #$(if (uuid? source)
(uuid-bytevector source)
source))
(keyfile #$key-file)
(boot-key-file #$boot-key-file)
(boot-source #$(and boot-device-uuid
(if (uuid? boot-device-uuid)
(uuid-bytevector boot-device-uuid)
boot-device-uuid)))
(boot-file-system-type #$boot-file-system-type)
(boot-mount "/run/nbde-boot"))
(keyfile #$key-file))
(mkdir-p "/run/cryptsetup/")
(let* ((partition
@@ -71,65 +60,7 @@ partition and is read at boot time, not baked into the initrd."
'())
'#$extra-options
(list partition #$target))))
(define (try-key-file path label)
(and path
(file-exists? path)
(begin
(format #t "nbde: trying ~a key file for ~a -> ~a~%"
label partition #$target)
(force-output)
(zero? (apply system*/tty cryptsetup-bin
"--key-file" path
cryptsetup-flags)))))
(define (resolve-boot-partition)
(and boot-source
(or (let loop ((tries-left 20))
(and (positive? tries-left)
(or (find-partition-by-uuid boot-source)
(begin
(format #t "nbde: waiting for boot partition (~a tries left)~%"
tries-left)
(force-output)
(sleep 1)
(loop (- tries-left 1))))))
(begin
(format #t "nbde: boot partition not found~%")
(force-output)
#f))))
(define (try-boot-key-file)
(and boot-key-file
boot-source
(let ((boot-partition (resolve-boot-partition))
(mounted? #f))
(and boot-partition
(catch #t
(lambda ()
(dynamic-wind
(lambda ()
(mkdir-p boot-mount)
(mount boot-partition boot-mount
boot-file-system-type MS_RDONLY)
(set! mounted? #t))
(lambda ()
(let ((path (string-append boot-mount "/"
boot-key-file)))
(try-key-file path "boot")))
(lambda ()
(when mounted?
(catch #t
(lambda () (umount boot-mount))
(lambda _ #f))))))
(lambda args
(format #t "nbde: failed to read boot key file: ~a~%"
args)
(force-output)
#f))))))
(or (try-boot-key-file)
(try-key-file keyfile "embedded")
(zero? (system* shell-bin "-c"
(or (zero? (system* shell-bin "-c"
(string-append
"attempt=0; "
"while :; do "
@@ -149,6 +80,10 @@ partition and is read at boot time, not baked into the initrd."
"fi; "
"sleep 2; "
"done")))
(and keyfile
(zero? (apply system*/tty cryptsetup-bin
"--key-file" keyfile
cryptsetup-flags)))
(zero? (apply system*/tty cryptsetup-bin
cryptsetup-flags)))))))))
@@ -164,9 +99,6 @@ partition and is read at boot time, not baked into the initrd."
(close close-clevis-luks-device)
(modules '((rnrs bytevectors)
((gnu build file-systems)
#:select (find-partition-by-luks-uuid find-partition-by-uuid
system*/tty))
((guix build syscalls)
#:select (MS_RDONLY))
#:select (find-partition-by-luks-uuid system*/tty))
((guix build utils)
#:select (mkdir-p))))))
pins/base-channels.sexp
+4 -4
View File
@@ -1,12 +1,12 @@
(list (channel
(name 'guix)
(url "https://git.teralink.net/tribes/guix-fork.git")
(branch "refactor/substituter-trace-framing")
;; guix-fork refactor/substituter-trace-framing
(branch "master")
;; guix-fork master
(commit
"8514f9c1a98468c044e8b5f65e4a90d097a63a47")
"906f6b2d3a4f9f80c5ad6f9e5f6369706a1a301d")
(introduction
(make-channel-introduction
"093f27dde01cdbda68f2ec4b81e5a34ae180aab9"
"6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90"
(openpgp-fingerprint
"6688 9153 C51C 4613 A493 A525 2F0D FD14 EF99 DAC3")))))
pins/legion-channels.sexp
+4 -4
View File
@@ -2,13 +2,13 @@
(channel
(name 'guix)
(url "https://git.teralink.net/tribes/guix-fork.git")
(branch "refactor/substituter-trace-framing")
;; guix-fork refactor/substituter-trace-framing
(branch "master")
;; guix-fork master
(commit
"8514f9c1a98468c044e8b5f65e4a90d097a63a47")
"906f6b2d3a4f9f80c5ad6f9e5f6369706a1a301d")
(introduction
(make-channel-introduction
"093f27dde01cdbda68f2ec4b81e5a34ae180aab9"
"6f9c3cd1761f0a3f8b70223cb0e0f47e29582d90"
(openpgp-fingerprint
"6688 9153 C51C 4613 A493 A525 2F0D FD14 EF99 DAC3"))))
(channel
scripts/build-kexec-image
-277
View File
@@ -1,277 +0,0 @@
#!/bin/sh
set -eu
usage() {
cat <<'EOF'
Usage: scripts/build-kexec-image [options]
Build a Guix kexec installer tarball from this guix-tribes checkout.
Options:
--channels=PATH Guix channels file for time-machine
--output=PATH Output tarball path, or - for stdout
--gzip-level=N gzip level for final tarball (default: 4)
-h, --help Show this help
EOF
}
script_dir=$(CDPATH= cd -- "$(dirname "$0")" && pwd)
root_dir=$(CDPATH= cd -- "$script_dir/.." && pwd)
channels=
output=
gzip_level="${NBDE_KEXEC_GZIP_LEVEL:-4}"
for arg in "$@"; do
case "$arg" in
--channels=*)
channels=${arg#*=}
;;
--output=*)
output=${arg#*=}
;;
--gzip-level=*)
gzip_level=${arg#*=}
;;
-h|--help)
usage
exit 0
;;
*)
echo "unknown argument: $arg" >&2
usage >&2
exit 2
;;
esac
done
[ -n "$channels" ] || {
echo "missing required --channels=PATH" >&2
usage >&2
exit 2
}
[ -n "$output" ] || {
echo "missing required --output=PATH" >&2
usage >&2
exit 2
}
load_guix_env() {
for profile in \
"$HOME/.config/guix/current/etc/profile" \
"$HOME/.guix-profile/etc/profile" \
/run/current-system/profile/etc/profile
do
[ -r "$profile" ] || continue
# shellcheck disable=SC1090
. "$profile"
done
}
require_tool() {
command -v "$1" >/dev/null 2>&1 || {
echo "$1 command not found" >&2
exit 1
}
}
require_file() {
path=$1
label=$2
[ -e "$path" ] || {
echo "$label not found: $path" >&2
exit 1
}
}
require_store_dir() {
path=$1
label=$2
case "$path" in
/gnu/store/*) ;;
*)
echo "$label did not produce a /gnu/store path: ${path:-<empty>}" >&2
exit 1
;;
esac
[ -d "$path" ] || {
echo "$label store path does not exist: $path" >&2
exit 1
}
}
log() {
echo "$*" >&2
}
load_guix_env
require_tool guix
require_tool guile
require_tool mksquashfs
require_file "$channels" "channels file"
require_file "$script_dir/kexec-run" "kexec runner"
require_file "$root_dir/examples/build-host-kexec-installer.scm" "system file"
tmp=$(mktemp -d /tmp/guix-kexec-image.XXXXXX)
system_build_stdout="$tmp/system-build.stdout"
static_kexec_stdout="$tmp/static-kexec.stdout"
closure_paths="$tmp/closure-paths"
cleanup() {
chmod -R u+w "$tmp" >/dev/null 2>&1 || true
rm -rf "$tmp"
}
trap cleanup EXIT INT TERM
log "building kexec installer system"
if ! guix time-machine -C "$channels" -- system build -L "$root_dir" \
"$root_dir/examples/build-host-kexec-installer.scm" >"$system_build_stdout"; then
[ ! -s "$system_build_stdout" ] || cat "$system_build_stdout" >&2
echo "failed to build kexec installer system" >&2
exit 1
fi
system=$(tail -n 1 "$system_build_stdout")
require_store_dir "$system" "kexec installer system"
require_file "$system/parameters" "kexec installer system parameters"
require_file "$system/boot" "kexec installer system boot directory"
log "building static kexec-tools"
if ! guix time-machine -C "$channels" -- build -e '(begin
(use-modules (gnu packages linux)
(guix build-system gnu))
(static-package kexec-tools))' >"$static_kexec_stdout"; then
[ ! -s "$static_kexec_stdout" ] || cat "$static_kexec_stdout" >&2
echo "failed to build static kexec-tools" >&2
exit 1
fi
static_kexec=$(tail -n 1 "$static_kexec_stdout")
require_store_dir "$static_kexec" "static kexec-tools"
require_file "$static_kexec/sbin/kexec" "static kexec binary"
guile -s /dev/stdin -- "$system" >"$tmp/metadata" <<'GUILE'
(use-modules (ice-9 match)
(srfi srfi-1)
(srfi srfi-13))
(define (field name fields)
(match (assoc name fields)
((_ value) value)
(_ (error "missing boot parameter field" name))))
(let* ((system (last (command-line)))
(sexp (call-with-input-file
(string-append system "/parameters")
read)))
(match sexp
(('boot-parameters fields ...)
(let* ((kernel (field 'kernel fields))
(initrd (field 'initrd fields))
(root (field 'root-device fields))
(args (field 'kernel-arguments fields))
(boot-link (string-append system "/boot"))
(boot-path (canonicalize-path boot-link))
(boot-args
(append
(cond
((equal? root "tmpfs")
'("rootfstype=tmpfs"))
((and (string? root) (not (string=? root "none")))
(list (string-append "root=" root)))
(else
'()))
(list (string-append "gnu.system=" system)
(string-append "gnu.load=" boot-path))
args)))
(display kernel)
(newline)
(display initrd)
(newline)
(display boot-path)
(newline)
(display (string-join boot-args " "))
(newline)))
(_
(error "unrecognized boot parameters file" sexp))))
GUILE
kernel=$(sed -n '1p' "$tmp/metadata")
initrd=$(sed -n '2p' "$tmp/metadata")
boot_path=$(sed -n '3p' "$tmp/metadata")
cmdline=$(sed -n '4p' "$tmp/metadata")
boot_refs=$(guix gc --references "$boot_path")
store_item_root() {
case "$1" in
/gnu/store/*)
printf '%s\n' "$1" | sed 's#^\(/gnu/store/[^/]*\).*#\1#'
;;
*)
echo "not a store item: $1" >&2
exit 1
;;
esac
}
initrd_store=$(store_item_root "$initrd")
parameters_store=$(store_item_root "$(readlink -f "$system/parameters")")
system_refs="$tmp/system-refs"
guix gc --references "$system" \
| while IFS= read -r ref; do
case "$ref" in
"$initrd_store"|"$parameters_store")
log "excluding already-copied boot artifact from embedded store: $ref"
;;
*)
printf '%s\n' "$ref"
;;
esac
done >"$system_refs"
mkdir -p "$tmp/kexec"
cp "$kernel" "$tmp/kexec/bzImage"
cp "$initrd" "$tmp/kexec/initrd"
chmod 644 "$tmp/kexec/initrd"
cp "$static_kexec/sbin/kexec" "$tmp/kexec/kexec-static"
chmod 755 "$tmp/kexec/kexec-static"
cp "$script_dir/kexec-run" "$tmp/kexec/run"
chmod 755 "$tmp/kexec/run"
printf '%s\n' "$cmdline" >"$tmp/kexec/cmdline"
{
printf '%s\n' "$system" "$boot_path"
printf '%s\n' $boot_refs
cat "$system_refs"
guix gc --requisites "$boot_path" $boot_refs $(cat "$system_refs")
} | sort -u >"$closure_paths"
squashfs_root="$tmp/squashfs-root"
mkdir -p "$squashfs_root"
while IFS= read -r path; do
[ -n "$path" ] || continue
cp -a "$path" "$squashfs_root/$(basename "$path")"
done <"$closure_paths"
log "packing Guix store closure into initrd"
mksquashfs "$squashfs_root" "$tmp/kexec/gnu-store.squashfs" \
-comp gzip -Xcompression-level 9 -no-xattrs -noappend >&2
squashfs_cpio="$tmp/squashfs-cpio"
mkdir -p "$squashfs_cpio"
cp "$tmp/kexec/gnu-store.squashfs" "$squashfs_cpio/gnu-store.squashfs"
( cd "$squashfs_cpio" && printf 'gnu-store.squashfs' | cpio -o -H newc | gzip -9 ) \
>> "$tmp/kexec/initrd"
rm "$tmp/kexec/gnu-store.squashfs"
log "writing kexec installer tarball"
case "$output" in
-)
GZIP="-$gzip_level" tar -C "$tmp" -czf - kexec
;;
*)
mkdir -p "$(dirname "$output")"
GZIP="-$gzip_level" tar -C "$tmp" -czf "$output" kexec
;;
esac
scripts/build-sender-runtime-pack
-70
View File
@@ -1,70 +0,0 @@
#!/bin/sh
set -eu
usage() {
cat <<'EOF'
Usage: scripts/build-sender-runtime-pack [options]
Build the external Tribes Sender runtime Guix pack from this checkout.
Options:
--guix=PATH Guix command to use (default: guix)
--output=PATH Copy resulting .tar.zst pack to PATH
-h, --help Show this help
EOF
}
script_dir=$(CDPATH= cd -- "$(dirname "$0")" && pwd)
root_dir=$(CDPATH= cd -- "$script_dir/.." && pwd)
guix_bin=${GUIX:-guix}
output=
for arg in "$@"; do
case "$arg" in
--guix=*)
guix_bin=${arg#*=}
;;
--output=*)
output=${arg#*=}
;;
-h|--help)
usage
exit 0
;;
*)
echo "unknown argument: $arg" >&2
usage >&2
exit 2
;;
esac
done
command -v "$guix_bin" >/dev/null 2>&1 || {
echo "guix command not found: $guix_bin" >&2
exit 1
}
pack_path=$("$guix_bin" pack \
-L "$root_dir" \
-f tarball \
-C zstd \
--save-provenance \
-S /opt/tribes-sender-runtime/bin=bin \
-S /opt/tribes-sender-runtime/sbin=sbin \
-S /opt/tribes-sender-runtime/share=share \
-m "$root_dir/manifests/packs/sender-runtime.scm" | tail -n 1)
case "$pack_path" in
/gnu/store/*) ;;
*)
echo "guix pack did not produce a /gnu/store path: ${pack_path:-<empty>}" >&2
exit 1
;;
esac
if [ -n "$output" ]; then
cp "$pack_path" "$output"
printf '%s\n' "$output"
else
printf '%s\n' "$pack_path"
fi
scripts/build-tribes-docker-image
-73
View File
@@ -1,73 +0,0 @@
#!/bin/sh
set -eu
usage() {
cat <<'EOF'
Usage: scripts/build-tribes-docker-image [options]
Build the pinned debug Tribes Docker image from this guix-tribes checkout.
Options:
--guix=PATH Guix command to use (default: guix)
--image-tag=TAG Docker image tag (default: tribes-guix-debug:latest)
--output=PATH Copy resulting image tarball to PATH
-h, --help Show this help
EOF
}
script_dir=$(CDPATH= cd -- "$(dirname "$0")" && pwd)
root_dir=$(CDPATH= cd -- "$script_dir/.." && pwd)
guix_bin=${GUIX:-guix}
image_tag=tribes-guix-debug:latest
output=
for arg in "$@"; do
case "$arg" in
--guix=*)
guix_bin=${arg#*=}
;;
--image-tag=*)
image_tag=${arg#*=}
;;
--output=*)
output=${arg#*=}
;;
-h|--help)
usage
exit 0
;;
*)
echo "unknown argument: $arg" >&2
usage >&2
exit 2
;;
esac
done
command -v "$guix_bin" >/dev/null 2>&1 || {
echo "guix command not found: $guix_bin" >&2
exit 1
}
image_path=$("$guix_bin" pack \
-L "$root_dir" \
-f docker \
--image-tag="$image_tag" \
-S /bin=bin \
--entry-point=/bin/tribes \
-e '(@ (tribes packages docker) tribes-debug-docker-package)' | tail -n 1)
case "$image_path" in
/gnu/store/*) ;;
*)
echo "guix pack did not produce a /gnu/store path: ${image_path:-<empty>}" >&2
exit 1
;;
esac
if [ -n "$output" ]; then
cp "$image_path" "$output"
printf '%s\n' "$output"
else
printf '%s\n' "$image_path"
fi
scripts/kexec-run
-67
View File
@@ -1,67 +0,0 @@
#!/bin/sh
set -eu
script_dir=$(CDPATH= cd -- "$(dirname "$0")" && pwd)
kernel="$script_dir/bzImage"
initrd="$script_dir/initrd"
cmdline=$(tr '\n' ' ' < "$script_dir/cmdline" | sed 's/[[:space:]]\+/ /g; s/^ //; s/ $//')
extra_args="${KEXEC_KERNEL_APPEND:-}"
extra_initrd="${KEXEC_EXTRA_INITRD:-}"
tmp_initrd=
execute_delay="${KEXEC_EXEC_DELAY:-3}"
cleanup() {
[ -n "${tmp_initrd:-}" ] && rm -f "$tmp_initrd"
}
trap cleanup EXIT INT TERM
[ -r "$kernel" ] || {
echo "missing kernel image: $kernel" >&2
exit 1
}
[ -r "$initrd" ] || {
echo "missing initrd image: $initrd" >&2
exit 1
}
if [ -n "$extra_initrd" ]; then
[ -r "$extra_initrd" ] || {
echo "extra initrd is not readable: $extra_initrd" >&2
exit 1
}
tmp_initrd=$(mktemp "${TMPDIR:-/tmp}/guix-kexec-initrd.XXXXXX")
cat "$initrd" "$extra_initrd" >"$tmp_initrd"
initrd="$tmp_initrd"
fi
if [ -n "$extra_args" ]; then
cmdline="$cmdline $extra_args"
fi
if [ -n "${KEXEC_BIN:-}" ]; then
kexec_bin="$KEXEC_BIN"
elif [ -x "$script_dir/kexec-static" ]; then
kexec_bin="$script_dir/kexec-static"
elif command -v kexec >/dev/null 2>&1; then
kexec_bin=$(command -v kexec)
else
echo "kexec binary not found and no bundled fallback present" >&2
exit 1
fi
kexec_load_flags=
if printf '%s\n' "6.1" "$(uname -r)" | sort -c -V 2>/dev/null; then
kexec_load_flags="--kexec-syscall-auto"
fi
echo "kexec: loading $kernel"
echo "kexec: initrd=$initrd ($(wc -c < "$initrd") bytes)"
"$kexec_bin" --load "$kernel" $kexec_load_flags --initrd="$initrd" --command-line="$cmdline" --no-checks
echo "machine will boot into guix in ${execute_delay}s"
if [ -e /dev/kmsg ]; then
exec >/dev/kmsg 2>&1
else
exec >/dev/null 2>&1
fi
nohup sh -c "sleep '$execute_delay' && exec '$kexec_bin' -e" &
scripts/update-base-channels-pin
+8 -197
View File
@@ -3,205 +3,16 @@ set -eu
script_dir=$(CDPATH= cd -- "$(dirname "$0")" && pwd)
root_dir=$(CDPATH= cd -- "$script_dir/.." && pwd)
base_output="${NBDE_BASE_CHANNELS_OUTPUT:-$root_dir/pins/base-channels.sexp}"
legion_output="${NBDE_LEGION_CHANNELS_OUTPUT:-$root_dir/pins/legion-channels.sexp}"
output="${1:-$root_dir/pins/base-channels.sexp}"
channels_source_host="${NBDE_GUIX_CHANNELS_SOURCE_HOST:-pguix}"
fork_url="https://git.teralink.net/tribes/guix-fork.git"
fork_branch="refactor/substituter-trace-framing"
fork_introduction_commit="093f27dde01cdbda68f2ec4b81e5a34ae180aab9"
fork_introduction_signer="6688 9153 C51C 4613 A493 A525 2F0D FD14 EF99 DAC3"
fork_checkout="$root_dir/../guix-fork"
fork_comment="guix-fork refactor/substituter-trace-framing"
mkdir -p "$(dirname "$output")"
official_url="https://git.teralink.net/tribes/guix.git"
official_branch="master"
official_introduction_commit="9edb3f66fd807b096b48283debdcddccfea34bad"
official_introduction_signer="BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA"
official_checkout="$root_dir/../guix"
official_comment="guix master"
usage() {
cat <<EOF
Usage: $(basename "$0") [--fork|--official] [--commit COMMIT]
Refreshes $base_output and syncs the Guix entry in $legion_output.
Defaults to the current channel kind from pins/base-channels.sexp and uses the
matching sibling checkout HEAD (../guix-fork or ../guix) when available.
EOF
}
is_full_commit() {
printf '%s\n' "$1" | grep -Eq '^[0-9a-f]{40}$'
}
current_channel_kind() {
current_url=$(perl -0ne 'if (/\(name \x27guix\)[\s\S]*?\(url "([^"]+)"\)/s) { print $1; exit 0 } exit 1' "$base_output")
case "$current_url" in
"$fork_url")
printf '%s\n' fork
;;
"$official_url")
printf '%s\n' official
;;
*)
echo "Unsupported Guix channel URL in $base_output: $current_url" >&2
exit 1
;;
esac
}
checkout_head() {
checkout=$1
if [ -d "$checkout/.git" ]; then
git -C "$checkout" rev-parse HEAD
return 0
fi
return 1
}
remote_branch_head() {
git ls-remote "$1" "refs/heads/$2" | awk 'NR == 1 { print $1 }'
}
channel_kind=
commit_override=
while [ "$#" -gt 0 ]; do
case "$1" in
--fork)
channel_kind=fork
;;
--official)
channel_kind=official
;;
--commit)
shift
[ "$#" -gt 0 ] || {
echo "Missing value for --commit" >&2
usage >&2
exit 2
}
commit_override=$1
;;
-h|--help)
usage
exit 0
;;
*)
if [ -z "$commit_override" ]; then
commit_override=$1
else
echo "Unexpected argument: $1" >&2
usage >&2
exit 2
fi
;;
esac
shift
done
[ -n "$channel_kind" ] || channel_kind=$(current_channel_kind)
case "$channel_kind" in
fork)
channel_url=$fork_url
channel_branch=$fork_branch
channel_introduction_commit=$fork_introduction_commit
channel_introduction_signer=$fork_introduction_signer
channel_checkout=$fork_checkout
channel_comment=$fork_comment
;;
official)
channel_url=$official_url
channel_branch=$official_branch
channel_introduction_commit=$official_introduction_commit
channel_introduction_signer=$official_introduction_signer
channel_checkout=$official_checkout
channel_comment=$official_comment
;;
*)
echo "Unsupported channel kind: $channel_kind" >&2
exit 1
;;
esac
commit_source=
if [ -n "$commit_override" ]; then
if [ -d "$channel_checkout/.git" ]; then
commit=$(git -C "$channel_checkout" rev-parse "$commit_override^{commit}" 2>/dev/null || true)
else
commit=
fi
[ -n "$commit" ] || commit=$commit_override
commit_source="override"
if command -v guix >/dev/null 2>&1; then
guix describe -f channels >"$output"
else
commit=$(checkout_head "$channel_checkout" || true)
if [ -n "$commit" ]; then
commit_source=$channel_checkout
else
commit=$(remote_branch_head "$channel_url" "$channel_branch")
commit_source="$channel_url#$channel_branch"
fi
ssh -o BatchMode=yes -o ConnectTimeout=10 \
"$channels_source_host" 'guix describe -f channels' >"$output"
fi
is_full_commit "$commit" || {
echo "Expected a full 40-character commit, got: $commit" >&2
exit 1
}
mkdir -p "$(dirname "$base_output")" "$(dirname "$legion_output")"
cat >"$base_output" <<EOF
(list (channel
(name 'guix)
(url "$channel_url")
(branch "$channel_branch")
;; $channel_comment
(commit
"$commit")
(introduction
(make-channel-introduction
"$channel_introduction_commit"
(openpgp-fingerprint
"$channel_introduction_signer")))))
EOF
new_guix_block=$(cat <<EOF
(channel
(name 'guix)
(url "$channel_url")
(branch "$channel_branch")
;; $channel_comment
(commit
"$commit")
(introduction
(make-channel-introduction
"$channel_introduction_commit"
(openpgp-fingerprint
"$channel_introduction_signer"))))
EOF
)
tmp_output=$(mktemp "${TMPDIR:-/tmp}/update-base-channels-pin.XXXXXX")
trap 'rm -f "$tmp_output"' EXIT HUP INT TERM
NEW_GUIX_BLOCK=$new_guix_block perl -0pe '
BEGIN { $changed = 0 }
$changed = s{\A\(list\s*\n \(channel\b[\s\S]*?\)\)\n(?= \(channel\b)}{"(list\n$ENV{NEW_GUIX_BLOCK}\n"}se;
END { exit($changed ? 0 : 1) }
' "$legion_output" >"$tmp_output" || {
echo "Failed to sync the Guix entry in $legion_output" >&2
exit 1
}
mv "$tmp_output" "$legion_output"
rm -f "$tmp_output"
trap - EXIT HUP INT TERM
printf 'Updated %s\n' "$base_output"
printf 'Synced %s\n' "$legion_output"
printf 'Channel: %s\n' "$channel_kind"
printf 'Commit: %s\n' "$commit"
printf 'Source: %s\n' "$commit_source"
printf '\nRun Legion pin refresh next:\n'
printf ' cd %s && npm run generate:guix-base-channel\n' "$root_dir/../legion_kk"
printf '%s\n' "$output"
scripts/update-plugin-pin
+134 -210
View File
@@ -8,7 +8,9 @@ use File::Basename qw(dirname);
use File::Spec;
use File::Temp qw(tempdir tempfile);
use Getopt::Long qw(GetOptionsFromArray);
use IPC::Open3 qw(open3);
use JSON::PP qw(decode_json encode_json);
use Symbol qw(gensym);
sub usage {
print <<'EOF';
@@ -16,9 +18,9 @@ Usage: update-plugin-pin [options] plugin [rev]
Pin a Tribes external plugin and refresh fixed-output hashes.
PLUGIN is the plugin slug. REV defaults to "master" resolved from the
PLUGIN is the manifest/plugin name. REV defaults to "master" resolved from the
plugin checkout. The plugin manifest.json is the source of truth for plugin
id, slug, version, provides, and requires metadata. By default the script expects
name, version, provides, and requires metadata. By default the script expects
the plugin checkout at ../tribes-plugin-$PLUGIN and the Guix plugin file at
tribes/plugins/$PLUGIN.scm relative to the guix-tribes checkout.
@@ -27,11 +29,9 @@ Options:
--plugin-file PATH Guix plugin definition file to update
--tribes-repo PATH Local Tribes git checkout used for the host plugin API
--tribes-rev REV Tribes commit/rev for host API hashing (default: current guix-tribes pin)
--guix-repo PATH Local guix-tribes checkout
--build-host HOST SSH host used for Guix builds and hashing
-h, --help Show this help
Hashing and Guix builds run with local `guix` unless --build-host is provided.
--guix-repo PATH Local guix-tribes checkout
--pguix-host HOST SSH host used for Guix builds and hashing
-h, --help Show this help
EOF
}
@@ -71,28 +71,14 @@ sub require_tool {
sub run_capture {
my (@cmd) = @_;
my ($fh, $path) = tempfile('command-output.XXXXXX', TMPDIR => 1);
my $pid = fork();
defined $pid or fail("Failed to fork for @cmd: $!");
if ($pid == 0) {
open STDOUT, '>&', $fh or die "Failed to redirect stdout: $!\n";
open STDERR, '>&', $fh or die "Failed to redirect stderr: $!\n";
exec @cmd or die "Failed to exec $cmd[0]: $!\n";
}
close $fh or fail("Failed to close $path: $!");
waitpid($pid, 0);
my $wait_status = $?;
my $status = $wait_status == -1 ? 255 : ($wait_status & 127 ? 128 + ($wait_status & 127) : $wait_status >> 8);
open my $out, '<', $path or fail("Failed to read $path: $!");
my $err = gensym();
my $pid = open3(undef, my $out, $err, @cmd);
local $/;
my $output = <$out> // '';
close $out or fail("Failed to close $path: $!");
unlink $path;
my $stdout = <$out> // '';
my $stderr = <$err> // '';
waitpid($pid, 0);
my $output = $stdout . $stderr;
my $status = $? >> 8;
return ($status, $output);
}
@@ -119,17 +105,60 @@ sub replace_once {
$count == 1 or fail("failed to update $label");
}
sub replace_all {
my ($text_ref, $pattern, $replacement, $label) = @_;
my $count = ($$text_ref =~ s/$pattern/$replacement/sg);
$count >= 1 or fail("failed to update $label");
sub update_plugin_definition_header {
my ($text_ref, $plugin_name, $package_name, $version) = @_;
my @lines = split /\n/, $$text_ref, -1;
my ($definition_start, $name_index, $version_index);
for my $i (0 .. $#lines) {
if (!defined $definition_start) {
if ($lines[$i] =~ /\(tribes-plugin-definition\b/) {
$definition_start = $i;
}
next;
}
if (!defined $name_index) {
if ($lines[$i] =~ /^\s*\(name "\Q$plugin_name\E"\)$/) {
$name_index = $i;
}
next;
}
if ($lines[$i] =~ /^\s*\(package-name "[^"]+"\)$/) {
next;
}
if ($lines[$i] =~ /^\s*\(version "[^"]+"\)$/) {
$version_index = $i;
last;
}
last if $lines[$i] =~ /^\s*\(/;
}
defined $name_index && defined $version_index
or fail('failed to update plugin definition version');
my ($indent) = ($lines[$version_index] =~ /^(\s*)/);
splice(
@lines,
$name_index + 1,
$version_index - $name_index,
qq(${indent}(package-name "$package_name")),
qq(${indent}(version "$version")),
);
$$text_ref = join("\n", @lines);
}
my $local_tmp = '';
my $remote_tmp = '';
my @argv = @ARGV;
my %opts;
my %opts = (
pguix_host => 'pguix',
);
GetOptionsFromArray(
\@argv,
@@ -137,9 +166,9 @@ GetOptionsFromArray(
'plugin-file=s' => \$opts{plugin_file},
'tribes-repo=s' => \$opts{tribes_repo},
'tribes-rev=s' => \$opts{tribes_rev},
'guix-repo=s' => \$opts{guix_repo},
'build-host=s' => \$opts{build_host},
'h|help' => \$opts{help},
'guix-repo=s' => \$opts{guix_repo},
'pguix-host=s' => \$opts{pguix_host},
'h|help' => \$opts{help},
) or do {
usage();
exit 1;
@@ -184,10 +213,7 @@ my $plugin_package_name = "tribes-plugin-$plugin";
-f $plugin_file or fail("Plugin file not found: $plugin_file");
-f $source_file or fail("guix-tribes source file not found: $source_file");
require_tool($_) for qw(env git tar perl);
my $use_remote = defined($opts{build_host}) && $opts{build_host} ne '' ? 1 : 0;
require_tool('guix') unless $use_remote;
require_tool($_) for qw(env git rsync ssh tar perl);
my ($status, $commit_output) = run_capture('git', '-C', $plugin_repo, 'rev-parse', "$rev\^\{commit\}");
$status == 0 or fail(trim($commit_output));
@@ -210,7 +236,7 @@ $local_tmp = tempdir('plugin-pin.XXXXXX', TMPDIR => 1, CLEANUP => 0);
END {
if (defined $remote_tmp && $remote_tmp ne '') {
system('ssh', $opts{build_host}, "rm -rf '$remote_tmp'");
system('ssh', $opts{pguix_host}, "rm -rf '$remote_tmp'");
}
if (defined $local_tmp && $local_tmp ne '' && -d $local_tmp) {
@@ -235,7 +261,7 @@ my $manifest_file = File::Spec->catfile($plugin_source_dir, 'manifest.json');
-f $manifest_file or fail("Plugin manifest not found at $manifest_file");
my $manifest = decode_json(read_file($manifest_file));
for my $key (qw(id slug version provides requires)) {
for my $key (qw(name version provides requires)) {
exists $manifest->{$key} or fail("manifest missing required key: $key");
}
@@ -247,71 +273,35 @@ ref($manifest->{requires}) eq 'ARRAY'
&& !grep { ref($_) || !defined($_) } @{ $manifest->{requires} }
or fail('manifest requires must be a list of strings');
my $plugin_id = $manifest->{id};
my $plugin_slug = $manifest->{slug};
my $plugin_name = $manifest->{name};
my $version = $manifest->{version};
my $provides_joined = join("\037", @{ $manifest->{provides} });
my $requires_joined = join("\037", @{ $manifest->{requires} });
$plugin_slug eq $plugin or fail("Plugin manifest slug mismatch: expected $plugin, got $plugin_slug");
$plugin_name eq $plugin or fail("Plugin manifest name mismatch: expected $plugin, got $plugin_name");
my ($plugin_source_for_scheme, $tribes_source_for_scheme, $guix_load_path);
my $source_hash;
($status, my $remote_tmp_output) = run_capture('ssh', $opts{pguix_host}, 'mktemp -d /tmp/plugin-pin.XXXXXX');
$status == 0 or fail(trim($remote_tmp_output));
$remote_tmp = trim($remote_tmp_output);
sub setup_remote {
require_tool($_) for qw(rsync ssh);
run_checked('rsync', '-az', '--delete', '--exclude', '.git', "$guix_repo/", "$opts{pguix_host}:$remote_tmp/guix-tribes/");
run_checked('rsync', '-az', '--delete', "$plugin_source_dir/", "$opts{pguix_host}:$remote_tmp/plugin-source/");
run_checked('rsync', '-az', '--delete', "$tribes_source_dir/", "$opts{pguix_host}:$remote_tmp/tribes-source/");
if ($remote_tmp eq '') {
print STDERR "Using build host $opts{build_host}.\n";
($status, my $source_hash_output) =
run_capture('ssh', $opts{pguix_host}, "guix hash -rx '$remote_tmp/plugin-source'");
$status == 0 or fail(trim($source_hash_output));
my $source_hash = trim($source_hash_output);
$source_hash =~ tr/\r//d;
($status, my $remote_tmp_output) = run_capture('ssh', $opts{build_host}, 'mktemp -d /tmp/plugin-pin.XXXXXX');
$status == 0 or fail(trim($remote_tmp_output));
$remote_tmp = trim($remote_tmp_output);
run_checked('rsync', '-az', '--delete', '--exclude', '.git', "$guix_repo/", "$opts{build_host}:$remote_tmp/guix-tribes/");
run_checked('rsync', '-az', '--delete', "$plugin_source_dir/", "$opts{build_host}:$remote_tmp/plugin-source/");
run_checked('rsync', '-az', '--delete', "$tribes_source_dir/", "$opts{build_host}:$remote_tmp/tribes-source/");
}
$plugin_source_for_scheme = "$remote_tmp/plugin-source";
$tribes_source_for_scheme = "$remote_tmp/tribes-source";
$guix_load_path = "$remote_tmp/guix-tribes";
($status, my $source_hash_output) =
run_capture('ssh', $opts{build_host}, "guix hash -rx '$plugin_source_for_scheme'");
$status == 0 or fail(trim($source_hash_output));
$source_hash = trim($source_hash_output);
$source_hash =~ tr/\r//d;
}
if ($use_remote) {
setup_remote();
} else {
$plugin_source_for_scheme = $plugin_source_dir;
$tribes_source_for_scheme = $tribes_source_dir;
$guix_load_path = $guix_repo;
($status, my $source_hash_output) = run_capture('guix', 'hash', '-rx', $plugin_source_dir);
$status == 0 or fail(trim($source_hash_output));
$source_hash = trim($source_hash_output);
$source_hash =~ tr/\r//d;
}
sub run_scheme {
sub remote_run_scheme {
my ($name, $body) = @_;
my ($fh, $local_path) = tempfile("$name.XXXXXX", DIR => $local_tmp, SUFFIX => '.scm');
print {$fh} $body or fail("Failed to write $local_path: $!");
close $fh or fail("Failed to close $local_path: $!");
if ($use_remote) {
run_checked('rsync', '-az', $local_path, "$opts{build_host}:$remote_tmp/$name.scm");
my ($exit, $output) =
run_capture('ssh', $opts{build_host}, "guix build -L '$guix_load_path' -f '$remote_tmp/$name.scm' --no-grafts 2>&1");
return $output;
}
run_checked('rsync', '-az', $local_path, "$opts{pguix_host}:$remote_tmp/$name.scm");
my ($exit, $output) =
run_capture('guix', 'build', '-L', $guix_load_path, '-f', $local_path, '--no-grafts');
run_capture('ssh', $opts{pguix_host}, "guix build -L '$remote_tmp/guix-tribes' -f '$remote_tmp/$name.scm' --no-grafts 2>&1");
return $output;
}
@@ -329,23 +319,51 @@ sub extract_hash {
return $hash;
}
sub build_hash {
my ($label, $build) = @_;
my $output = $build->();
my $hash = eval { extract_hash($output) };
if ($@) {
my $hint = $use_remote
? "Build host Guix did not complete the hash refresh."
: "Local Guix did not complete the hash refresh. To run this step on a build host, rerun with --build-host HOST.";
fail("Failed to extract $label hash.\n$hint\n$output");
}
return $hash;
}
my $dummy_hash = '0' x 52;
my $host_setup_gexp = <<"EOF";
#~(begin
(let ((host-root (string-append work "/tribes")))
(when (file-exists? host-root)
(delete-file-recursively host-root))
(copy-recursively #+(local-file "$remote_tmp/tribes-source" #:recursive? #t)
host-root
#:follow-symlinks? #t)
(invoke "chmod" "-R" "u+w" host-root)))
EOF
my $mix_output = remote_run_scheme(
'mix-deps',
<<"EOF"
(use-modules (guix gexp) (tribes packages mix))
(fetch-mix-deps
(local-file "$remote_tmp/plugin-source" #:recursive? #t)
#:name "$plugin_package_name-mix-deps"
#:version "$version"
#:sha256 "$dummy_hash"
#:setup-gexp $host_setup_gexp)
EOF
);
my $mix_hash = extract_hash($mix_output);
my $npm_hash = '';
if (-f File::Spec->catfile($plugin_source_dir, 'assets', 'package-lock.json')) {
my $npm_output = remote_run_scheme(
'npm-deps',
<<"EOF"
(use-modules (guix gexp) (tribes packages mix))
(fetch-npm-deps
(local-file "$remote_tmp/plugin-source" #:recursive? #t)
#:name "$plugin_package_name-npm-deps"
#:version "$version"
#:sha256 "$dummy_hash"
#:assets-dir "assets"
#:setup-gexp $host_setup_gexp)
EOF
);
$npm_hash = extract_hash($npm_output);
}
my $text = read_file($plugin_file);
my @candidates;
for my $candidate ($plugin, ($plugin =~ tr/_/-/r)) {
@@ -357,100 +375,6 @@ my ($symbol_base) =
defined $symbol_base
or fail("failed to locate plugin symbol prefix for '$plugin' in $plugin_file");
my $package_body = $text;
if ($text =~ /\(define\* \(\Q$symbol_base\E-package-from-source\b(.*?)(?:\n\(define \Q$symbol_base\E-package\b)/s) {
$package_body = $1;
}
sub package_reuses_host_libs {
my ($body) = @_;
return 1 if $body =~ /#:reuse-host-libs\?\s+#t\b/;
return 0 if $body =~ /#:reuse-host-libs\?\s+#f\b/;
if ($body =~ /#:reuse-host-libs\?\s+reuse-host-libs\?/) {
return 1 if $body =~ /\(reuse-host-libs\?\s+#t\)/;
return 0 if $body =~ /\(reuse-host-libs\?\s+#f\)/;
}
return 0;
}
sub package_includes_mix_deps {
my ($body, $reuse_host_libs) = @_;
return 1 if $body =~ /#:include-mix-deps\?\s+#t\b/;
return 0 if $body =~ /#:include-mix-deps\?\s+#f\b/;
if ($body =~ /#:include-mix-deps\?\s+include-mix-deps\?/) {
return 1 if $body =~ /\(include-mix-deps\?\s+#t\)/;
return 0 if $body =~ /\(include-mix-deps\?\s+#f\)/;
}
return $reuse_host_libs ? 0 : 1;
}
my $reuse_host_libs = package_reuses_host_libs($package_body);
my $include_mix_deps = package_includes_mix_deps($package_body, $reuse_host_libs);
sub host_setup_gexp {
return <<"EOF";
#~(begin
(let ((host-root (string-append work "/tribes")))
(when (file-exists? host-root)
(delete-file-recursively host-root))
(copy-recursively #+(local-file "$tribes_source_for_scheme" #:recursive? #t)
host-root
#:follow-symlinks? #t)
(invoke "chmod" "-R" "u+w" host-root)))
EOF
}
my $source_setup_gexp = $reuse_host_libs ? "#~(begin)" : host_setup_gexp();
sub mix_deps_output {
return run_scheme(
'mix-deps',
<<"EOF"
(use-modules (guix gexp) (tribes packages mix))
(fetch-mix-deps
(local-file "$plugin_source_for_scheme" #:recursive? #t)
#:name "$plugin_package_name-mix-deps"
#:version "$version"
#:sha256 "$dummy_hash"
#:setup-gexp $source_setup_gexp)
EOF
);
}
sub npm_deps_output {
return run_scheme(
'npm-deps',
<<"EOF"
(use-modules (guix gexp) (tribes packages mix))
(fetch-npm-deps
(local-file "$plugin_source_for_scheme" #:recursive? #t)
#:name "$plugin_package_name-npm-deps"
#:version "$version"
#:sha256 "$dummy_hash"
#:assets-dir "assets"
#:setup-gexp $source_setup_gexp)
EOF
);
}
$text =~ /\(define %\Q$symbol_base\E-mix-deps-sha256\s+"([^"]+)"\)/
or fail("failed to locate %$symbol_base-mix-deps-sha256 in $plugin_file");
my $mix_hash = $1;
if ($include_mix_deps) {
$mix_hash = build_hash('mix deps', \&mix_deps_output);
}
my $npm_hash = '';
if (-f File::Spec->catfile($plugin_source_dir, 'assets', 'package-lock.json')) {
$npm_hash = build_hash('npm deps', \&npm_deps_output);
}
replace_once(
\$text,
qr/\(define %\Q$symbol_base\E-commit\s+"[^"]+"\)/,
@@ -485,16 +409,17 @@ replace_once(
$npm_replacement,
"%$symbol_base-npm-deps-sha256",
);
replace_all(
update_plugin_definition_header(\$text, $plugin_name, $plugin_package_name, $version);
replace_once(
\$text,
qr/#:provides\s+'\([^)]*\)/,
"#:provides '" . scheme_string_list(@{ $manifest->{provides} }),
qr/\(provides '\([^)]*\)\)/,
"(provides '" . scheme_string_list(@{ $manifest->{provides} }) . ')',
'plugin provides',
);
replace_all(
replace_once(
\$text,
qr/#:requires\s+'\([^)]*\)/,
"#:requires '" . scheme_string_list(@{ $manifest->{requires} }),
qr/\(requires '\([^)]*\)\)/,
"(requires '" . scheme_string_list(@{ $manifest->{requires} }) . ')',
'plugin requires',
);
@@ -502,7 +427,6 @@ write_file($plugin_file, $text);
print "Updated $plugin_file\n";
print "plugin: $plugin\n";
print "plugin id: $plugin_id\n";
print "commit: $commit\n";
print "host tribes commit: $host_commit\n";
print "version: $version\n";
scripts/update-tribes-and-plugin-pins
-113
View File
@@ -1,113 +0,0 @@
#!/bin/sh
set -eu
# External plugin pins to refresh. Each name maps to ../tribes-plugin-$name
# and tribes/plugins/$name.scm unless update-plugin-pin is called with
# different defaults in the future.
plugins="sender aether supertest kobold trust"
usage() {
cat <<'EOF'
Usage: update-tribes-and-plugin-pins [options]
Refresh the Tribes pin and all plugin pins listed in this script by calling
scripts/update-tribes-pin and scripts/update-plugin-pin.
Options:
--commit Commit the affected pin files after updating
--tribes-repo PATH Local Tribes git checkout
--guix-repo PATH Local guix-tribes checkout
--build-host HOST SSH host used by the update scripts for Guix builds and hashing
-h, --help Show this help
EOF
}
script_dir=$(CDPATH= cd -- "$(dirname -- "$0")" && pwd)
default_guix_repo=$(CDPATH= cd -- "$script_dir/.." && pwd)
default_tribes_repo=$(CDPATH= cd -- "$default_guix_repo/../tribes" && pwd)
guix_repo=$default_guix_repo
tribes_repo=$default_tribes_repo
build_host=
commit_after=false
while [ "$#" -gt 0 ]; do
case "$1" in
--commit)
commit_after=true
shift
;;
--tribes-repo)
tribes_repo=$2
shift 2
;;
--guix-repo)
guix_repo=$2
shift 2
;;
--build-host)
build_host=$2
shift 2
;;
-h|--help)
usage
exit 0
;;
*)
printf 'Unknown option: %s\n' "$1" >&2
usage >&2
exit 1
;;
esac
done
update_tribes_pin=$guix_repo/scripts/update-tribes-pin
update_plugin_pin=$guix_repo/scripts/update-plugin-pin
if [ ! -x "$update_tribes_pin" ]; then
printf 'update-tribes-pin not found or not executable: %s\n' "$update_tribes_pin" >&2
exit 1
fi
if [ ! -x "$update_plugin_pin" ]; then
printf 'update-plugin-pin not found or not executable: %s\n' "$update_plugin_pin" >&2
exit 1
fi
build_host_args=
if [ -n "$build_host" ]; then
build_host_args="--build-host $build_host"
fi
# shellcheck disable=SC2086
"$update_tribes_pin" \
--guix-repo "$guix_repo" \
--tribes-repo "$tribes_repo" \
$build_host_args
for plugin in $plugins; do
# shellcheck disable=SC2086
"$update_plugin_pin" \
--guix-repo "$guix_repo" \
--tribes-repo "$tribes_repo" \
$build_host_args \
"$plugin"
done
if [ "$commit_after" = true ]; then
git -C "$guix_repo" add -- \
tribes/packages/source.scm
for plugin in $plugins; do
git -C "$guix_repo" add -- "tribes/plugins/$plugin.scm"
done
if git -C "$guix_repo" diff --cached --quiet; then
printf 'No pin changes to commit.\n'
else
git -C "$guix_repo" commit \
-m "chore: Bump Tribes and plugin pins" \
-m "Refresh the Tribes source pin and the external plugin pins listed in scripts/update-tribes-and-plugin-pins."
fi
fi
scripts/update-tribes-pin
+36 -86
View File
@@ -8,14 +8,13 @@ Usage: update-tribes-pin [options] [rev]
Pin guix-tribes to a Tribes commit and refresh all fixed-output hashes.
By default, REV is "master" resolved from the local Tribes checkout. Hashing and
Guix builds run with local `guix` unless --build-host is provided.
By default, REV is "master" resolved from the local Tribes checkout.
Options:
--tribes-repo PATH Local Tribes git checkout
--guix-repo PATH Local guix-tribes checkout
--build-host HOST SSH host used for Guix builds and hashing
-h, --help Show this help
--tribes-repo PATH Local Tribes git checkout
--guix-repo PATH Local guix-tribes checkout
--pguix-host HOST SSH host used for Guix builds and hashing
-h, --help Show this help
EOF
}
@@ -25,7 +24,7 @@ default_tribes_repo=$(CDPATH= cd -- "$default_guix_repo/../tribes" && pwd)
tribes_repo=$default_tribes_repo
guix_repo=$default_guix_repo
build_host=
pguix_host=pguix
rev=master
while [ "$#" -gt 0 ]; do
@@ -38,8 +37,8 @@ while [ "$#" -gt 0 ]; do
guix_repo=$2
shift 2
;;
--build-host)
build_host=$2
--pguix-host)
pguix_host=$2
shift 2
;;
-h|--help)
@@ -89,17 +88,12 @@ require_tool() {
require_tool env
require_tool git
require_tool rsync
require_tool ssh
require_tool tar
require_tool perl
require_tool mktemp
if [ -n "$build_host" ]; then
use_remote=true
else
use_remote=false
require_tool guix
fi
commit=$(git -C "$tribes_repo" rev-parse "$rev^{commit}")
version=$(env LC_ALL=C perl -0ne 'print $1 if /\(git-version "([^"]+)"/' "$source_file")
@@ -113,7 +107,7 @@ remote_tmp=
cleanup() {
if [ -n "${remote_tmp:-}" ]; then
ssh "$build_host" "rm -rf '$remote_tmp'" >/dev/null 2>&1 || true
ssh "$pguix_host" "rm -rf '$remote_tmp'" >/dev/null 2>&1 || true
fi
rm -rf "$local_tmp"
}
@@ -123,49 +117,22 @@ trap cleanup EXIT INT TERM
mkdir -p "$local_tmp/tribes-source"
git -C "$tribes_repo" archive "$commit" | tar -x -C "$local_tmp/tribes-source"
setup_remote() {
require_tool rsync
require_tool ssh
remote_tmp=$(ssh "$pguix_host" 'mktemp -d /tmp/tribes-pin.XXXXXX')
if [ -z "${remote_tmp:-}" ]; then
printf 'Using build host %s.\n' "$build_host" >&2
remote_tmp=$(ssh "$build_host" 'mktemp -d /tmp/tribes-pin.XXXXXX')
rsync -az --delete --exclude .git "$guix_repo/" "$pguix_host:$remote_tmp/guix-tribes/"
rsync -az --delete "$local_tmp/tribes-source/" "$pguix_host:$remote_tmp/tribes-source/"
rsync -az --delete --exclude .git "$guix_repo/" "$build_host:$remote_tmp/guix-tribes/"
rsync -az --delete "$local_tmp/tribes-source/" "$build_host:$remote_tmp/tribes-source/"
fi
source_hash=$(ssh "$pguix_host" "guix hash -rx '$remote_tmp/tribes-source'" | tr -d '\r')
source_root=$remote_tmp/tribes-source
guix_load_path=$remote_tmp/guix-tribes
source_hash=$(ssh "$build_host" "guix hash -rx '$source_root'" | tr -d '\r')
}
if [ "$use_remote" = true ]; then
setup_remote
else
source_root=$local_tmp/tribes-source
guix_load_path=$guix_repo
source_hash=$(guix hash -rx "$source_root" | tr -d '\r')
fi
run_scheme() {
remote_run_scheme() {
name=$1
body=$2
if [ "$use_remote" = true ]; then
ssh "$build_host" "cat > '$remote_tmp/$name.scm' <<'EOF'
ssh "$pguix_host" "cat > '$remote_tmp/$name.scm' <<'EOF'
$body
EOF"
ssh "$build_host" "guix build -L '$guix_load_path' -f '$remote_tmp/$name.scm' --no-grafts 2>&1" || true
else
scheme_file=$local_tmp/$name.scm
cat > "$scheme_file" <<EOF
$body
EOF
guix build -L "$guix_load_path" -f "$scheme_file" --no-grafts 2>&1 || true
fi
ssh "$pguix_host" "guix build -L '$remote_tmp/guix-tribes' -f '$remote_tmp/$name.scm' --no-grafts 2>&1" || true
}
extract_hash() {
@@ -189,64 +156,47 @@ extract_hash() {
dummy_hash=0000000000000000000000000000000000000000000000000000
raw_mix_deps_output() {
run_scheme raw-mix-deps "(use-modules (guix gexp) (tribes packages source))
raw_output=$(remote_run_scheme raw-mix-deps "(use-modules (guix gexp) (tribes packages source))
(fetch-mix-deps
(local-file \"$source_root\" #:recursive? #t)
(local-file \"$remote_tmp/tribes-source\" #:recursive? #t)
#:name \"tribes-mix-deps-raw\"
#:version \"$version\"
#:sha256 \"$dummy_hash\")"
#:sha256 \"$dummy_hash\")")
raw_mix_hash=$(printf '%s\n' "$raw_output" | extract_hash) || {
printf 'Failed to extract raw mix deps hash.\n%s\n' "$raw_output" >&2
exit 1
}
mix_deps_output() {
run_scheme mix-deps "(use-modules (guix gexp) (tribes packages source))
mix_output=$(remote_run_scheme mix-deps "(use-modules (guix gexp) (tribes packages source))
(tribes-mix-deps
(local-file \"$source_root\" #:recursive? #t)
(local-file \"$remote_tmp/tribes-source\" #:recursive? #t)
#:name \"tribes-mix-deps\"
#:version \"$version\"
#:raw-sha256 \"$raw_mix_hash\"
#:sha256 \"$dummy_hash\")"
#:sha256 \"$dummy_hash\")")
mix_hash=$(printf '%s\n' "$mix_output" | extract_hash) || {
printf 'Failed to extract prepared mix deps hash.\n%s\n' "$mix_output" >&2
exit 1
}
npm_deps_output() {
run_scheme npm-deps "(use-modules (guix gexp) (tribes packages source))
npm_output=$(remote_run_scheme npm-deps "(use-modules (guix gexp) (tribes packages source))
(fetch-npm-deps
(local-file \"$source_root\" #:recursive? #t)
(local-file \"$remote_tmp/tribes-source\" #:recursive? #t)
#:mix-fod-deps
(tribes-mix-deps
(local-file \"$source_root\" #:recursive? #t)
(local-file \"$remote_tmp/tribes-source\" #:recursive? #t)
#:name \"tribes-mix-deps\"
#:version \"$version\"
#:raw-sha256 \"$raw_mix_hash\"
#:sha256 \"$mix_hash\")
#:name \"tribes-npm-deps\"
#:version \"$version\"
#:sha256 \"$dummy_hash\")"
}
hash_failure_hint() {
label=$1
output=$2
printf 'Failed to extract %s hash.\n' "$label" >&2
if [ "$use_remote" = false ]; then
printf 'Local Guix did not complete the hash refresh. To run this step on a build host, rerun with --build-host HOST.\n' >&2
else
printf 'Build host Guix did not complete the hash refresh.\n' >&2
fi
printf '%s\n' "$output" >&2
#:sha256 \"$dummy_hash\")")
npm_hash=$(printf '%s\n' "$npm_output" | extract_hash) || {
printf 'Failed to extract npm deps hash.\n%s\n' "$npm_output" >&2
exit 1
}
raw_output=$(raw_mix_deps_output)
raw_mix_hash=$(printf '%s\n' "$raw_output" | extract_hash) || hash_failure_hint 'raw mix deps' "$raw_output"
mix_output=$(mix_deps_output)
mix_hash=$(printf '%s\n' "$mix_output" | extract_hash) || hash_failure_hint 'prepared mix deps' "$mix_output"
npm_output=$(npm_deps_output)
npm_hash=$(printf '%s\n' "$npm_output" | extract_hash) || hash_failure_hint 'npm deps' "$npm_output"
COMMIT=$commit \
SOURCE_HASH=$source_hash \
RAW_MIX_HASH=$raw_mix_hash \
supertest-dev-B19D4784.key
-11
View File
@@ -1,11 +0,0 @@
-----BEGIN PGP PUBLIC KEY BLOCK-----
mDMEafMY7xYJKwYBBAHaRw8BAQdAX7Cs0UPcvEpHOwmTDkjNBfeH6/FH6sqKZbRi
sd3oBCy0U1RyaWJlcyBTdXBlcnRlc3QgRGV2IChBSSBsb2NhbCBkZXZlbG9wbWVu
dCBrZXkpIDx0cmliZXMtc3VwZXJ0ZXN0LWRldkB0ZXJhbGluay5uZXQ+iJYEExYK
AD4WIQTym6baluXsKf3e2ZSPT3WzsZ1HhAUCafMY7wIbAwUJAeEzgAULCQgHAgYV
CgkICwIEFgIDAQIeAQIXgAAKCRCPT3WzsZ1HhMp8AP4gGrPkBoGLKMyubISESFpH
fnqYUGDGucIoLRvtbl+ULQD/SlC9u/Ek9WSYvsskd0jD09lc2TxBnubl8yRi3bTM
sA8=
=JA7U
-----END PGP PUBLIC KEY BLOCK-----
tests/nbde-system-boot-store.scm
-31
View File
@@ -1,31 +0,0 @@
(define-module (tests nbde-system-boot-store)
#:use-module (srfi srfi-64)
#:use-module (tests support)
#:use-module (nbde system boot-store)
#:export (run-tests))
(define (fresh-file name)
(let ((path (string-append "/tmp/" name "-" (number->string (getpid)))))
(when (file-exists? path)
(delete-file path))
path))
(define (run-tests)
(test-begin "nbde-system-boot-store")
(let ((grub-cfg (fresh-file "boot-store-grub.cfg")))
(call-with-output-file grub-cfg
(lambda (port)
(display "linux /gnu/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-linux/bzImage root=x\n" port)
(display "initrd /gnu/store/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-raw-initrd/initrd.cpio.gz, /gnu/store/cccccccccccccccccccccccccccccccc-extra)\n" port)
(display "old /gnu/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-linux/bzImage\n" port)))
(test-equal "extracts unique grub store references"
'("/gnu/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-linux/bzImage"
"/gnu/store/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb-raw-initrd/initrd.cpio.gz"
"/gnu/store/cccccccccccccccccccccccccccccccc-extra")
(grub-config-store-references grub-cfg))
(delete-file grub-cfg))
(test-end "nbde-system-boot-store"))
(run-tests-when-script "tests/nbde-system-boot-store.scm" run-tests)
tests/tribes-ci-substitutes.scm
-78
View File
@@ -1,78 +0,0 @@
(define-module (tests tribes-ci-substitutes)
#:use-module (guix gexp)
#:use-module (gnu services)
#:use-module (gnu system)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (tests support)
#:use-module (tribes ci substitutes)
#:use-module (tribes packages kernel)
#:use-module (tribes packages plugins)
#:use-module (tribes services tribes)
#:export (run-tests))
(define (target-names)
(map car %substitute-operating-system-targets))
(define (target-plugin-names os)
(let ((service (find (lambda (service)
(eq? (service-kind service) tribes-service-type))
(operating-system-user-services os))))
(map tribes-external-plugin-name
(tribes-configuration-plugins (service-value service)))))
(define (run-tests)
(test-begin "tribes-ci-substitutes")
(test-equal "substitute OS target names are stable"
'(phase1 base-edge aether-edge kobold-edge sender-edge supertest-edge)
(target-names))
(test-assert "all substitute targets are operating systems"
(every operating-system?
(map cdr %substitute-operating-system-targets)))
(test-assert "substitute targets use the Tribes kernel"
(every (lambda (os)
(string=? (package-name (operating-system-kernel os))
(package-name tribes-linux)))
(map cdr %substitute-operating-system-targets)))
(test-assert "NBDE systems include common provider initrd NIC modules"
(every (lambda (module)
(member module
(operating-system-initrd-modules base-edge-operating-system)))
'("bnxt_en" "ena" "e1000e" "i40e" "ice" "igb" "igc" "ixgbe"
"mlx4_core" "mlx4_en" "mlx5_core" "r8169" "tg3")))
(test-assert "bootloader configuration targets are file-like"
(every file-like?
(list bios-bootloader-configuration
efi-bootloader-configuration
bios-bootloader-configuration-installer
efi-bootloader-configuration-installer)))
(test-equal "kobold target has expected host name"
"tribes-ci-kobold-edge"
(operating-system-host-name kobold-edge-operating-system))
(test-equal "kobold target includes trust provider"
'("trust" "kobold")
(target-plugin-names kobold-edge-operating-system))
(test-equal "sender target has expected host name"
"tribes-ci-sender-edge"
(operating-system-host-name sender-edge-operating-system))
(test-equal "aether target has expected host name"
"tribes-ci-aether-edge"
(operating-system-host-name aether-edge-operating-system))
(test-equal "supertest target has expected host name"
"tribes-ci-supertest-edge"
(operating-system-host-name supertest-edge-operating-system))
(test-end "tribes-ci-substitutes"))
(run-tests-when-script "tests/tribes-ci-substitutes.scm" run-tests)
tests/tribes-config-system-facts.scm
-32
View File
@@ -1,32 +0,0 @@
(define-module (tests tribes-config-system-facts)
#:use-module (srfi srfi-64)
#:use-module (tests support)
#:use-module (tribes config system-facts)
#:export (run-tests))
(define minimal-system-facts-json
'(("schemaVersion" . "1")
("hostName" . "node-a")
("interface" . "eth0")
("bootloaderTargets" . ("/dev/vda"))
("bootPartitionUuid" . "00000000-0000-0000-0000-000000000001")
("rootLuksUuid" . "00000000-0000-0000-0000-000000000002")))
(define (run-tests)
(test-begin "tribes-config-system-facts")
(test-equal "default local boot key lives under /boot"
"/boot/nbde/local-boot.key"
(tribes-system-facts-local-boot-key-file
(json-scm->tribes-system-facts minimal-system-facts-json)))
(test-equal "explicit local boot key path is preserved"
"/boot/custom.key"
(tribes-system-facts-local-boot-key-file
(json-scm->tribes-system-facts
(append minimal-system-facts-json
'(("localBootKeyFile" . "/boot/custom.key"))))))
(test-end "tribes-config-system-facts"))
(run-tests-when-script "tests/tribes-config-system-facts.scm" run-tests)
tests/tribes-deploy-channel-updates.scm
-123
View File
@@ -1,123 +0,0 @@
(define-module (tests tribes-deploy-channel-updates)
#:use-module (ice-9 ftw)
#:use-module (ice-9 popen)
#:use-module (ice-9 textual-ports)
#:use-module (guix build utils)
#:use-module (srfi srfi-64)
#:use-module (tests support)
#:use-module (tribes deploy channel-updates)
#:use-module (tribes deploy json)
#:export (run-tests))
(define *fixture-counter* 0)
(define (delete-directory-if-present path)
(when (false-if-exception (lstat path))
(delete-file-recursively path)))
(define (fresh-root)
(set! *fixture-counter* (+ *fixture-counter* 1))
(let ((root (string-append "/tmp/tribes-channel-updates-test-"
(number->string (getpid))
"-"
(number->string *fixture-counter*))))
(delete-directory-if-present root)
(mkdir-p root)
root))
(define (run . args)
(let ((status (apply system* args)))
(unless (zero? status)
(error "command failed" args status))))
(define (git-output repo . args)
(let* ((port (apply open-pipe* OPEN_READ "git" "-C" repo args))
(output (string-trim-right (get-string-all port)))
(status (close-pipe port)))
(unless (zero? status)
(error "git command failed" args status))
output))
(define (write-file path text)
(call-with-output-file path
(lambda (port)
(display text port))))
(define (commit! repo text)
(write-file (string-append repo "/file.txt") text)
(run "git" "-C" repo "add" "file.txt")
(run "git" "-C" repo "commit" "-m" text))
(define (with-env name value thunk)
(let ((old (getenv name)))
(dynamic-wind
(lambda () (setenv name value))
thunk
(lambda ()
(if old
(setenv name old)
(unsetenv name))))))
(define (setup-repo root)
(let ((origin (string-append root "/origin"))
(checkout (string-append root "/cache/guix/checkouts/channel")))
(run "git" "init" "-b" "master" origin)
(run "git" "-C" origin "config" "user.email" "test@example.invalid")
(run "git" "-C" origin "config" "user.name" "Tribes Test")
(commit! origin "release 1.0.0")
(run "git" "-C" origin "tag" "v1.0.0")
(commit! origin "release 1.1.0")
(run "git" "-C" origin "tag" "v1.1.0")
(commit! origin "unreleased head")
(mkdir-p (dirname checkout))
(run "git" "clone" origin checkout)
(values origin checkout)))
(define (run-tests)
(test-begin "tribes-deploy-channel-updates")
(let ((root (fresh-root)))
(call-with-values (lambda () (setup-repo root))
(lambda (origin _checkout)
(let ((current (git-output origin "rev-list" "-n" "1" "v1.0.0")))
(with-env "XDG_CACHE_HOME" (string-append root "/cache")
(lambda ()
(let* ((payload `(("mode" . "semver_tags")
("limit" . 5)
("channels" . ((("id" . "channel-1")
("name" . "tribes")
("url" . ,origin)
("branch" . "master")
("current_commit" . ,current))))))
(result (channel-updates-payload payload))
(channels (json-list-ref result "channels"))
(channel (car channels))
(candidates (json-list-ref channel "candidates"))
(candidate (car candidates)))
(test-assert "channel update check succeeds"
(json-ref channel "ok"))
(test-equal "newest semver tag is returned"
"v1.1.0"
(json-ref candidate "tag"))
(test-equal "commit subject is included"
"release 1.1.0"
(json-ref candidate "subject"))
(let* ((commit-payload `(("mode" . "commits")
("limit" . 5)
("channels" . ((("id" . "channel-1")
("name" . "tribes")
("url" . ,origin)
("branch" . "master")
("current_commit" . ,current))))))
(commit-result (channel-updates-payload commit-payload))
(commit-channel (car (json-list-ref commit-result "channels")))
(commit-candidates (json-list-ref commit-channel "candidates"))
(commit-candidate (car commit-candidates)))
(test-equal "commit mode returns branch commits"
"unreleased head"
(json-ref commit-candidate "subject")))))))))
(delete-directory-if-present root))
(test-end "tribes-deploy-channel-updates"))
(run-tests-when-script "tests/tribes-deploy-channel-updates.scm" run-tests)
tests/tribes-deploy-current-guix-worker.scm
-47
View File
@@ -1,47 +0,0 @@
(define-module (tests tribes-deploy-current-guix-worker)
#:use-module (srfi srfi-64)
#:use-module (tests support)
#:use-module (tribes deploy current-guix-worker)
#:export (run-tests))
(define (with-worker-store-mocks ensure-path* references* thunk)
(let* ((worker-module (resolve-module '(tribes deploy current-guix-worker)))
(saved-ensure-path (module-ref worker-module 'ensure-path))
(saved-references (module-ref worker-module 'references)))
(dynamic-wind
(lambda ()
(module-set! worker-module 'ensure-path ensure-path*)
(module-set! worker-module 'references references*))
thunk
(lambda ()
(module-set! worker-module 'ensure-path saved-ensure-path)
(module-set! worker-module 'references saved-references)))))
(define (run-tests)
(test-begin "tribes-deploy-current-guix-worker")
(let ((ensured '())
(references-by-path
'(("system" . ("service-program"))
("service-program" . ("vinyl"))
("vinyl" . ()))))
(with-worker-store-mocks
(lambda (_store path)
(set! ensured (cons path ensured)))
(lambda (_store path)
;; Model substituted/generated store items whose references are only
;; known after the item itself has been realized locally.
(if (member path ensured)
(assoc-ref references-by-path path)
'()))
(lambda ()
((@@ (tribes deploy current-guix-worker) realize-store-closures)
'mock-store
'("system"))))
(test-equal "closure realization discovers references after each ensure"
'("vinyl" "service-program" "system")
ensured))
(test-end "tribes-deploy-current-guix-worker"))
(run-tests-when-script "tests/tribes-deploy-current-guix-worker.scm" run-tests)
tests/tribes-deploy-current-guix.scm
+12 -52
View File
@@ -55,9 +55,7 @@
("PATH" "/no-such-path"))
(test-equal "current-guix-binary prefers pulled profile"
pulled
(current-guix-binary))
(test-assert "pulled Guix profile is detected"
(pulled-guix-profile-available?))))
(current-guix-binary))))
(let* ((root (fresh-root))
(home (string-append root "/home"))
@@ -66,80 +64,42 @@
(write-executable path-guix "#!/bin/sh\nexit 0\n")
(with-env (("HOME" home)
("PATH" bin))
(test-assert "missing pulled Guix profile is detected"
(not (pulled-guix-profile-available?)))
(test-equal "current-guix-binary falls back after pulled profile"
(if (file-exists? system-guix-binary)
system-guix-binary
path-guix)
(test-equal "current-guix-binary falls back to guix on PATH"
path-guix
(current-guix-binary))))
(with-env (("GUILE_LOAD_PATH" "bad-load")
("GUILE_LOAD_COMPILED_PATH" "bad-compiled")
("GUIX_PACKAGE_PATH" "bad-package")
("GUIX_UNINSTALLED" "bad-uninstalled"))
("GUIX_PACKAGE_PATH" "bad-package"))
(let ((inside
(call-with-clean-guix-environment
(lambda ()
(list (getenv "GUILE_LOAD_PATH")
(getenv "GUILE_LOAD_COMPILED_PATH")
(getenv "GUIX_PACKAGE_PATH")
(getenv "GUIX_UNINSTALLED"))))))
(getenv "GUIX_PACKAGE_PATH"))))))
(test-equal "clean Guix environment unsets wrapper paths"
'(#f #f #f #f)
'(#f #f #f)
inside)
(test-equal "clean Guix environment restores wrapper paths"
'("bad-load" "bad-compiled" "bad-package" "bad-uninstalled")
'("bad-load" "bad-compiled" "bad-package")
(list (getenv "GUILE_LOAD_PATH")
(getenv "GUILE_LOAD_COMPILED_PATH")
(getenv "GUIX_PACKAGE_PATH")
(getenv "GUIX_UNINSTALLED")))))
(getenv "GUIX_PACKAGE_PATH")))))
(let* ((root (fresh-root))
(profile (string-append root "/profile"))
(home (string-append root "/home"))
(pulled (string-append home "/.config/guix/current"))
(guix (string-append profile "/bin/guix"))
(site (string-append pulled "/share/guile/site/3.0"))
(compiled (string-append pulled "/lib/guile/3.0/site-ccache"))
(module (string-append site "/tribes/example.scm")))
(module (string-append profile
"/share/guile/site/3.0/tribes/example.scm")))
(write-executable guix "#!/bin/sh\nexit 0\n")
(mkdir-p (dirname pulled))
(symlink profile pulled)
(mkdir-p (dirname module))
(mkdir-p compiled)
(call-with-output-file module
(lambda (port) (display ";; fixture\n" port)))
(with-env (("HOME" home)
(with-env (("HOME" (string-append root "/home"))
("PATH" (string-append profile "/bin")))
(test-equal "current-guix-module-file resolves under selected profile"
module
(current-guix-module-file "tribes/example.scm"))
(test-equal "current Guix environment selects profile load paths"
(list site compiled #f "1")
(with-env (("GUILE_LOAD_PATH" "bad-load")
("GUILE_LOAD_COMPILED_PATH" "bad-compiled")
("GUIX_PACKAGE_PATH" "bad-package")
("GUIX_UNINSTALLED" "bad-uninstalled"))
(call-with-current-guix-environment
(lambda ()
(list (getenv "GUILE_LOAD_PATH")
(getenv "GUILE_LOAD_COMPILED_PATH")
(getenv "GUIX_PACKAGE_PATH")
(getenv "GUIX_UNINSTALLED"))))))))
(let* ((root (fresh-root))
(current-system (string-append root "/run/current-system"))
(channels-file (string-append current-system "/channels.scm")))
(mkdir-p current-system)
(call-with-output-file channels-file
(lambda (port)
(display "(list)\n" port)))
(test-equal "current system channels file is detected from active system"
channels-file
(current-system-channels-file current-system))
(test-assert "missing current system channels file is not synthesized"
(not (current-system-channels-file (string-append root "/missing")))))
(current-guix-module-file "tribes/example.scm"))))
(test-end "tribes-deploy-current-guix"))
tests/tribes-deploy-executor.scm
+4 -67
View File
@@ -2,8 +2,6 @@
#:use-module (srfi srfi-64)
#:use-module (tribes deploy executor)
#:use-module (tribes deploy plan)
#:use-module (tribes packages plugins)
#:use-module (tribes plugins built-ins)
#:export (run-tests))
(define valid-signer
@@ -52,8 +50,7 @@
(test-equal "host config plugins are updated in tribes block"
'(("schemaVersion" . "1")
("tribes" . (("host" . "example.com")
("plugins" . ("aether"))
("disabledPlugins" . ())))
("plugins" . ("aether"))))
("edge" . (("certificateName" . "tribes"))))
(host-config-with-plugins
'(("schemaVersion" . "1")
@@ -62,22 +59,14 @@
("edge" . (("certificateName" . "tribes"))))
'("aether")))
(test-equal "system target plugin names include installed plugins"
'("aether" "disabled")
(test-equal "system target plugin names include only enabled plugins"
'("aether")
(system-target-plugin-names
'(("plugins" . ((("plugin_name" . "aether")
("enabled" . #t))
(("plugin_name" . "disabled")
("enabled" . #f)))))))
(test-equal "system target disabled plugin names include disabled plugins"
'("disabled")
(system-target-disabled-plugin-names
'(("plugins" . ((("plugin_name" . "aether")
("enabled" . #t))
(("plugin_name" . "disabled")
("enabled" . #f)))))))
(test-assert "legacy plans without resolved channel metadata still pull"
(plan-requires-pull? '(("plan_hash" . "legacy"))))
@@ -91,15 +80,6 @@
'(("plan_hash" . "channel-update")
("resolved_channels" . #((("name" . "guix-tribes")))))))
(test-equal "runtime capabilities come from built-in Tribes UI manifest"
'("org.tribe-one.caps.ui@1")
(tribes-plugin-definitions-provided-capabilities
guix-tribes-built-in-plugin-definitions))
(test-equal "host manifest requirements are satisfied by built-ins"
'()
guix-tribes-runtime-missing-capabilities)
(test-equal "resolve-target emits channel-aware plugin package refs"
'("aether")
(let* ((plan (resolve-target valid-target))
@@ -114,53 +94,10 @@
"abc123"
(json-ref package-ref "commit"))
(test-equal "registry version is used"
"0.2.0"
"0.1.0"
(json-ref package-ref "version"))
(plan-plugins plan)))
(test-equal "resolve-target accepts spaced introduction fingerprints"
'("sender")
(let* ((spaced-channel
`(("id" . "guix-tribes")
("channel_id" . "guix-tribes")
("url" . "https://git.example.test/guix-tribes.git")
("branch" . "main")
("commit" . "abc123")
("position" . 10)
("allowed_signer_ids" . ("signer-1"))
("introduction" . (("commit" . "intro123")
("fingerprint" . "0123 4567 89AB CDEF 0123 4567 89AB CDEF 0123 4567")))))
(plan
(resolve-target
`(("trusted_signers" . (,valid-signer))
("channels" . (,spaced-channel))
("plugins" . ((("plugin_name" . "sender")
("channel_id" . "guix-tribes")
("enabled" . #t))))))))
(plan-plugins plan)))
(test-equal "resolve-target satisfies org.tribe-one.caps.ui@1 from built-in Tribes UI"
'("sender")
(let ((plan
(resolve-target
`(("trusted_signers" . (,valid-signer))
("channels" . (,valid-channel))
("plugins" . ((("plugin_name" . "sender")
("channel_id" . "guix-tribes")
("enabled" . #t))))))))
(plan-plugins plan)))
(test-equal "resolve-target keeps disabled plugins installed but runtime-disabled"
'(("aether") ("aether"))
(let ((plan
(resolve-target
`(("trusted_signers" . (,valid-signer))
("channels" . (,valid-channel))
("plugins" . ((("plugin_name" . "aether")
("channel_id" . "guix-tribes")
("enabled" . #f))))))))
(list (plan-plugins plan) (plan-disabled-plugins plan))))
(test-equal "resolve-target rejects duplicate plugin requests"
"duplicate_plugin"
(error-code
tests/tribes-deploy-operations.scm
+1 -108
View File
@@ -30,25 +30,6 @@
("resolved_channels" . #())
("resolved_plugins" . ((("name" . "supertest"))))))
(define plan-with-channel-pin
'(("plan_hash" . "plan-with-channel-pin")
("resolved_channels" . #((("channel_id" . "guix-tribes")
("name" . "tribes")
("url" . "https://git.example.test/guix-tribes.git")
("branch" . "master")
("commit" . "abc123")
("position" . 10))))
("resolved_plugins" . ((("name" . "supertest"))))))
(define plan-with-branch-channel
'(("plan_hash" . "plan-with-branch-channel")
("resolved_channels" . #((("channel_id" . "guix-tribes")
("name" . "tribes")
("url" . "https://git.example.test/guix-tribes.git")
("branch" . "master")
("commit" . #f)
("position" . 10))))
("resolved_plugins" . ((("name" . "supertest"))))))
(define (delete-if-present path)
(when (false-if-exception (lstat path))
(delete-file path)))
@@ -86,19 +67,10 @@
(current-system-link (assq-ref fixture 'current-system-link)))
(let ((backend
(make-helper-backend
(lambda (_cfg _on-frame)
(helper-success-result
'(("event" . "done")
("catalog" . (("schemaVersion" . "2") ("plugins" . #()))))))
(lambda (_cfg _on-frame)
(set! pull-count (+ pull-count 1))
(helper-success-result
'(("event" . "done")
("phase" . "pulling")
("channels" . ((("name" . "tribes")
("url" . "https://git.example.test/guix-tribes.git")
("branch" . "master")
("commit" . "pulled456")))))))
'(("event" . "done") ("phase" . "pulling"))))
(lambda (_cfg root-link _on-frame)
(set! build-count (+ build-count 1))
(let ((store-path
@@ -143,15 +115,6 @@
(lambda (port)
(scm->json (json-ready payload) port))))
(define (read-text-file path)
(call-with-input-file path
(lambda (port)
(let loop ((chars '()))
(let ((char (read-char port)))
(if (eof-object? char)
(list->string (reverse chars))
(loop (cons char chars))))))))
(define (make-fixture)
(let* ((root (fresh-root))
(deploy-directory (string-append root "/deploy"))
@@ -205,9 +168,6 @@
(define rollback-herd-command
(@@ (tribes deploy operations) rollback-herd-command))
(define write-plan-channels!
(@@ (tribes deploy operations) write-plan-channels!))
(define (write-executable path content)
(call-with-output-file path
(lambda (port) (display content port)))
@@ -244,28 +204,6 @@
(define (run-tests)
(test-begin "tribes-deploy-operations")
(let* ((fixture (make-fixture))
(config (fixture->config fixture))
(channels-file (assq-ref fixture 'channels-file))
(plan `(("plan_hash" . "plan-with-plugin-channel")
("resolved_channels" . ,(vector '(("channel_id" . "guix-tribes")
("name" . "tribes")
("url" . "https://git.example.test/guix-tribes.git")
("branch" . "supertest-dev")
("commit" . "plugin-commit")
("position" . 10)))))))
(call-with-output-file channels-file
(lambda (port)
(display "(list\n" port)
(display " (channel (name 'guix) (url \"https://git.example.test/guix.git\") (branch \"master\") (commit \"guix-commit\"))\n" port)
(display ")\n" port)))
(write-plan-channels! config plan)
(let ((channels (read-text-file channels-file)))
(test-assert "plan channel writer preserves current guix channel"
(string-contains channels "(name (quote guix))"))
(test-assert "plan channel writer includes plugin channel"
(string-contains channels "supertest-dev"))))
(let* ((fixture (make-fixture))
(state (make-state-store (fixture->config fixture))))
(call-with-values (lambda () (make-fake-helper fixture))
@@ -303,51 +241,6 @@
(test-equal "generation is marked active after commit"
"active" (json-ref generation-a "status")))))))
(let* ((fixture (make-fixture))
(state (make-state-store (fixture->config fixture))))
(call-with-values (lambda () (make-fake-helper fixture))
(lambda (helper _get-builds _get-pulls _get-switches)
(let* ((prepared (prepare-plugins! state helper
(plan-plugins plan-with-channel-pin)
(plan-hash plan-with-channel-pin)
no-frame
#:plan plan-with-channel-pin))
(committed (commit-plan! state helper
(plan-hash plan-with-channel-pin)
no-frame))
(generation (find-generation-by-plan-hash
(state-store-read-generations state)
(plan-hash plan-with-channel-pin)))
(channels (json-list-ref generation "channels"))
(channel (car channels)))
(test-equal "prepared generation records channel pins"
"ready"
(json-ref prepared "status"))
(test-equal "active generation keeps channel pins"
"healthy"
(json-ref committed "status"))
(test-equal "generation channel pin records pulled commit"
"pulled456"
(json-ref channel "commit"))))))
(let* ((fixture (make-fixture))
(state (make-state-store (fixture->config fixture))))
(call-with-values (lambda () (make-fake-helper fixture))
(lambda (helper _get-builds _get-pulls _get-switches)
(prepare-plugins! state helper
(plan-plugins plan-with-branch-channel)
(plan-hash plan-with-branch-channel)
no-frame
#:plan plan-with-branch-channel)
(let* ((generation (find-generation-by-plan-hash
(state-store-read-generations state)
(plan-hash plan-with-branch-channel)))
(channels (json-list-ref generation "channels"))
(channel (car channels)))
(test-equal "branch channel records exact pulled commit"
"pulled456"
(json-ref channel "commit"))))))
(let* ((fixture (make-fixture))
(state (make-state-store (fixture->config fixture))))
(call-with-values (lambda () (make-fake-helper fixture))
tests/tribes-system-node.scm
+5 -295
View File
@@ -1,58 +1,23 @@
(define-module (tests tribes-system-node)
#:use-module (gnu services)
#:use-module (gnu services monitoring)
#:use-module (gnu services shepherd)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-64)
#:use-module (tests support)
#:use-module (tribes plugins sender)
#:use-module (tribes services chrony)
#:use-module (tribes services haproxy)
#:use-module (tribes services lego)
#:use-module (tribes services logging)
#:use-module (tribes services tribes)
#:use-module (tribes services vinyl)
#:use-module (tribes services vinyl-exporter)
#:use-module (tribes services victoriametrics)
#:use-module (tribes system node)
#:export (run-tests))
(define node-module (resolve-module '(tribes system node)))
(define chrony-module (resolve-module '(tribes services chrony)))
(define haproxy-module (resolve-module '(tribes services haproxy)))
(define logging-module (resolve-module '(tribes services logging)))
(define tribes-service-module (resolve-module '(tribes services tribes)))
(define victoriametrics-module (resolve-module '(tribes services victoriametrics)))
(define edge-cache-vcl-text (module-ref node-module 'edge-cache-vcl-text))
(define edge-cache-vcl (module-ref node-module 'edge-cache-vcl))
(define edge-services (module-ref node-module 'edge-services))
(define chrony-shepherd-services
(module-ref chrony-module 'chrony-shepherd-services))
(define haproxy-config-file (module-ref haproxy-module 'haproxy-config-file))
(define tribes-system-logging-config-text
(module-ref logging-module 'tribes-system-logging-config-text))
(define tribes-root-shepherd-services
(module-ref tribes-service-module 'tribes-root-shepherd-services))
(define tribes-profile-packages
(module-ref tribes-service-module 'tribes-profile-packages))
(define tribes-sender-ffmpeg-package
(module-ref tribes-service-module 'tribes-sender-ffmpeg-package))
(define victoriametrics-shepherd-services
(module-ref victoriametrics-module 'victoriametrics-shepherd-services))
(define vmagent-shepherd-services
(module-ref victoriametrics-module 'vmagent-shepherd-services))
(define (contains? haystack needle)
(and (string-contains haystack needle) #t))
(define (object->string value)
(call-with-output-string
(lambda (port)
(write value port))))
(define (run-tests)
(test-begin "tribes-system-node")
@@ -83,170 +48,6 @@
vcl
(plain-file-content rendered))))
(let* ((config (tribes-node-configuration
(tribes (tribes-configuration
(host "example.invalid")))))
(services (tribes-node-services config))
(chrony-service
(find (lambda (service)
(eq? (service-kind service) chrony-service-type))
services))
(node-exporter-service
(find (lambda (service)
(eq? (service-kind service)
prometheus-node-exporter-service-type))
services))
(network-tools-service
(find (lambda (service)
(let ((value (service-value service)))
(and (list? value)
(any (lambda (package)
(string=? (package-name package) "nftables"))
(filter package? value)))))
services)))
(test-assert "node profile includes nftables for sync partition tests"
network-tools-service)
(test-assert "node includes Chrony service"
chrony-service)
(test-assert "node includes Prometheus node exporter service"
node-exporter-service)
(test-equal "node exporter binds to loopback by default"
"127.0.0.1:9100"
(prometheus-node-exporter-web-listen-address
(service-value node-exporter-service)))
(test-assert "node includes VictoriaMetrics storage service"
(find (lambda (service)
(eq? (service-kind service) victoriametrics-service-type))
services))
(test-assert "node includes vmagent scrape service"
(find (lambda (service)
(eq? (service-kind service) vmagent-service-type))
services)))
(let ((logging-config (tribes-system-logging-configuration)))
(test-equal "syslog-ng combined JSONL path is the importer default"
"/var/log/tribes-combined.jsonl"
(tribes-system-logging-configuration-jsonl-path logging-config))
(let ((text (tribes-system-logging-config-text logging-config)))
(test-assert "syslog-ng listens on /dev/log for syslogd compatibility"
(contains? text "unix-dgram(\"/dev/log\")"))
(test-assert "syslog-ng writes conventional messages log"
(contains? text "file(\"/var/log/messages\" template(t_plain))"))
(test-assert "syslog-ng writes Tribes combined JSONL"
(contains? text "file(\"/var/log/tribes-combined.jsonl\" template(t_json) group(\"tribes\") perm(0640))"))
(test-assert "syslog-ng makes combined JSONL readable by the Tribes importer"
(contains? text "destination d_combined_jsonl { file(\"/var/log/tribes-combined.jsonl\" template(t_json) group(\"tribes\") perm(0640)); };"))
(test-assert "syslog-ng normalizes Shepherd messages copied through kmsg"
(and (contains? text "filter f_kmsg_shepherd")
(contains? text "set(\"shepherd\", value(\"PROGRAM\"))")
(contains? text "set-severity(\"notice\")")))
(test-assert "syslog-ng excludes raw Shepherd kmsg copies from generic system logs"
(contains? text "filter(f_not_kmsg_shepherd); destination(d_combined_jsonl)"))
(test-assert "syslog-ng tails Tribes service log"
(contains? text "file(\"/var/log/tribes.log\" flags(no-parse)"))
(test-assert "syslog-ng tails Prometheus node exporter log"
(contains? text "file(\"/var/log/prometheus-node-exporter.log\" flags(no-parse) program_override(\"prometheus-node-exporter\")"))
(test-assert "syslog-ng writes Chrony native syslog to a per-service log"
(contains? text "filter f_native_chronyd { program(\"chronyd\"); };"))
(test-assert "syslog-ng does not tail Chrony's native syslog destination"
(not (contains? text "file(\"/var/log/chronyd.log\" flags(no-parse)")))))
(let* ((config (chrony-configuration))
(rendered (chrony-config-file config))
(text (plain-file-content rendered))
(services (chrony-shepherd-services config)))
(test-equal "Chrony renders expected configuration file name"
"chrony.conf"
(plain-file-name rendered))
(test-assert "Chrony uses the Guix NTP pool"
(contains? text "pool 2.guix.pool.ntp.org iburst"))
(test-assert "Chrony allows startup clock steps"
(contains? text "makestep 0.1 3"))
(test-assert "Chrony stores drift under its state directory"
(contains? text "driftfile /var/lib/chrony/chrony.drift"))
(test-equal "Chrony renders one shepherd service"
1
(length services))
(test-assert "Chrony shepherd service provides chronyd"
(memq 'chronyd
(shepherd-service-provision (car services)))))
(let ((storage-config (victoriametrics-configuration))
(agent-config (vmagent-configuration))
(scrape-config (default-vmagent-scrape-config-text)))
(test-equal "VictoriaMetrics binds to loopback by default"
"127.0.0.1:8428"
(victoriametrics-configuration-http-listen-address storage-config))
(test-equal "VictoriaMetrics retains node metrics for 90 days"
"90d"
(victoriametrics-configuration-retention-period storage-config))
(test-equal "vmagent binds to loopback by default"
"127.0.0.1:8429"
(vmagent-configuration-http-listen-address agent-config))
(test-equal "vmagent remote-writes to local VictoriaMetrics"
"http://127.0.0.1:8428/api/v1/write"
(vmagent-configuration-remote-write-url agent-config))
(test-assert "default scrape config scrapes node exporter"
(contains? scrape-config "targets: [\"127.0.0.1:9100\"]"))
(test-assert "default scrape config scrapes VictoriaMetrics"
(contains? scrape-config "targets: [\"127.0.0.1:8428\"]"))
(test-assert "default scrape config scrapes Tribes metrics"
(contains? scrape-config "targets: [\"127.0.0.1:4000\"]"))
(test-assert "default scrape config scrapes Vinyl exporter"
(contains? scrape-config "targets: [\"127.0.0.1:9131\"]"))
(test-equal "VictoriaMetrics renders one shepherd service"
1
(length (victoriametrics-shepherd-services storage-config)))
(test-equal "vmagent renders one shepherd service"
1
(length (vmagent-shepherd-services agent-config))))
(let* ((services (tribes-root-shepherd-services
(tribes-configuration (host "example.invalid"))))
(service-by-provision
(lambda (provision)
(find (lambda (service)
(memq provision (shepherd-service-provision service)))
services))))
(for-each
(lambda (provision)
(test-assert
(string-append (symbol->string provision)
" waits for explicit post-secret startup")
(let ((service (service-by-provision provision)))
(and service
(not (shepherd-service-auto-start? service))))))
'(tribes tribes-migrations tribes-plugin-rollback-migrations))
(test-assert "tribes-boot-start starts automatically after secrets exist"
(let ((service (service-by-provision 'tribes-boot-start)))
(and service
(shepherd-service-auto-start? service))))
(test-assert "tribes-boot-start uses Shepherd start-service"
(let* ((service (service-by-provision 'tribes-boot-start))
(start-sexpr (and service
(gexp->approximate-sexp
(shepherd-service-start service))))
(start-text (and start-sexpr
(object->string start-sexpr))))
(and start-text
(contains? start-text "(start-service (lookup-service (quote tribes)))")
(not (contains? start-text "perform-service-action")))))
(test-assert "tribes profile includes inotify-tools for file_system"
(any (lambda (package)
(string=? (package-name package) "inotify-tools"))
(tribes-profile-packages
(tribes-configuration (host "example.invalid")))))
(test-assert "base tribes config does not force ffmpeg into the launcher"
(not (tribes-sender-ffmpeg-package
(tribes-configuration (host "example.invalid")))))
(test-assert "sender-enabled tribes config exposes sender ffmpeg for env override"
(let ((package (tribes-sender-ffmpeg-package
(tribes-configuration
(host "example.invalid")
(plugins (list (sender-external-plugin)))))))
(and package
(string=? (package-name package) "sender-ffmpeg")))))
(let* ((config (tribes-node-configuration
(tribes (tribes-configuration
(host "example.invalid")))
@@ -256,104 +57,13 @@
(vinyl-service (find (lambda (service)
(eq? (service-kind service) vinyl-service-type))
services))
(vinyl-exporter-service
(find (lambda (service)
(eq? (service-kind service) vinyl-exporter-service-type))
services))
(haproxy-service (find (lambda (service)
(eq? (service-kind service) haproxy-service-type))
services))
(lego-service (find (lambda (service)
(eq? (service-kind service) lego-service-type))
services))
(vinyl-configs (and vinyl-service
(service-value vinyl-service)))
(vinyl-exporter-config (and vinyl-exporter-service
(service-value vinyl-exporter-service)))
(lego-config (and lego-service
(service-value lego-service)))
(edge-vinyl (and vinyl-configs
(find (lambda (config)
(string=? (vinyl-configuration-name config)
"tribes-edge"))
vinyl-configs))))
(test-equal "edge uses one vinyl cache process"
1
(and vinyl-configs
(length vinyl-configs)))
(test-assert "edge includes Vinyl exporter service"
vinyl-exporter-service)
(test-equal "edge Vinyl exporter uses edge workdir"
"/var/vinyl/tribes-edge"
(and vinyl-exporter-config
(vinyl-exporter-configuration-vinyl-workdir
vinyl-exporter-config)))
(test-equal "edge Vinyl exporter labels Sender HLS streams by stream id"
"/sender/hls/streams/"
(and vinyl-exporter-config
(vinyl-exporter-configuration-hls-path-prefix
vinyl-exporter-config)))
(test-equal "edge Vinyl exporter uses one HLS stream label component"
1
(and vinyl-exporter-config
(vinyl-exporter-configuration-hls-stream-components
vinyl-exporter-config)))
(test-equal "edge Vinyl exporter uses vsid identity"
'("vsid")
(and vinyl-exporter-config
(vinyl-exporter-configuration-hls-query-params
vinyl-exporter-config)))
(edge-vinyl (find (lambda (config)
(string=? (vinyl-configuration-name config)
"tribes-edge"))
(service-value vinyl-service))))
(test-equal "edge vinyl permits five graceful retries"
'((max_retries . 5))
(and edge-vinyl
(vinyl-configuration-parameters edge-vinyl)))
(test-equal "lego waits for haproxy challenge routing"
'(haproxy)
(and lego-config
(lego-certificate-configuration-requirement
(car (lego-configuration-certificates lego-config)))))
(test-assert "edge uses haproxy for TLS termination"
haproxy-service))
(let* ((config (haproxy-configuration
(backend "127.0.0.1:6081")
(frontends '("0.0.0.0:443" "[::]:443 v6only"))
(http-frontends '("0.0.0.0:80" "[::]:80 v6only"))
(acme-backend "127.0.0.1:8080")
(pem-files '("/var/lib/lego/tribes/full.pem"))))
(rendered (haproxy-config-file config))
(text (plain-file-content rendered)))
(test-equal "haproxy renders expected configuration file name"
"haproxy.conf"
(plain-file-name rendered))
(test-assert "haproxy does not use deprecated master-worker config keyword"
(not (contains? text "master-worker\n")))
(test-assert "haproxy does not require OpenSSL QUIC compatibility mode"
(not (contains? text "limited-quic")))
(test-assert "haproxy logs to syslog-ng"
(contains? text "log /dev/log local0"))
(test-assert "haproxy binds configured certificate"
(contains? text
"bind 0.0.0.0:443 ssl crt /var/lib/lego/tribes/full.pem alpn h2,http/1.1"))
(test-assert "haproxy binds QUIC over IPv4"
(contains? text
"bind quic4@0.0.0.0:443 ssl crt /var/lib/lego/tribes/full.pem alpn h3"))
(test-assert "haproxy binds QUIC over IPv6"
(contains? text
"bind quic6@[::]:443 v6only ssl crt /var/lib/lego/tribes/full.pem alpn h3"))
(test-assert "haproxy advertises HTTP/3"
(contains? text "http-response set-header alt-svc 'h3=\":443\"; ma=86400'"))
(test-assert "haproxy binds public HTTP"
(contains? text "bind 0.0.0.0:80"))
(test-assert "haproxy routes ACME challenges to lego"
(contains? text "use_backend lego_acme if acme_challenge"))
(test-assert "haproxy redirects non-ACME HTTP traffic"
(contains? text
"http-request redirect scheme https code 308 unless acme_challenge"))
(test-assert "haproxy forwards ACME requests to lego challenge server"
(contains? text "server lego 127.0.0.1:8080"))
(test-assert "haproxy forwards to vinyl cache backend"
(contains? text "server vinyl 127.0.0.1:6081 check")))
(vinyl-configuration-parameters edge-vinyl)))
(test-end "tribes-system-node"))
tribes/ci/artifacts-kexec.scm
-13
View File
@@ -1,13 +0,0 @@
(define-module (tribes ci artifacts-kexec)
#:use-module (tribes ci artifacts)
#:use-module (srfi srfi-1)
#:export (cuirass-jobs))
(define (cuirass-jobs store arguments)
(append-map
(lambda (system)
(list (artifact-job store
"guix-kexec-installer"
guix-kexec-installer-image
system)))
(arguments->systems arguments)))
tribes/ci/artifacts-master.scm
-28
View File
@@ -1,28 +0,0 @@
(define-module (tribes ci artifacts-master)
#:use-module (tribes ci artifacts)
#:use-module (srfi srfi-1)
#:export (cuirass-jobs))
(define (cuirass-jobs store arguments)
(let ((tribes-commit (arguments->channel-commit arguments 'tribes)))
(append-map
(lambda (system)
(append
(list (artifact-job store
"tribes-debug-docker"
(lambda ()
(tribes-debug-docker-image
#:image-tag
(if tribes-commit
(string-append "tribes-guix-debug:"
tribes-commit)
"tribes-guix-debug:latest")))
system)
(artifact-job store
"tribes-sender-runtime"
tribes-sender-runtime-pack
system))
(substitute-manifest-jobs store system)
(substitute-system-jobs store system)
(substitute-file-jobs store system)))
(arguments->systems arguments))))
tribes/ci/artifacts.scm
-313
View File
@@ -1,313 +0,0 @@
(define-module (tribes ci artifacts)
#:use-module (gnu compression)
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages cpio)
#:use-module (gnu packages linux)
#:use-module (gnu packages monitoring)
#:use-module (gnu packages nss)
#:use-module (gnu system)
#:use-module (guix build-system gnu)
#:use-module (guix derivations)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix scripts pack)
#:use-module (guix store)
#:use-module (ice-9 match)
#:use-module (manifests substitutes base)
#:use-module (manifests substitutes installer)
#:use-module (manifests substitutes tribes-node)
#:use-module (nbde system build-host-kexec-installer)
#:use-module (srfi srfi-1)
#:use-module (tribes ci substitutes)
#:use-module (tribes packages docker)
#:use-module (tribes packages monitoring)
#:use-module (tribes packages sender-runtime)
#:use-module (tribes packages web)
#:export (tribes-debug-docker-image
tribes-sender-runtime-pack
guix-kexec-installer-image
artifact-job
arguments->systems
arguments->channel-commit
substitute-manifest-jobs
substitute-system-jobs
substitute-file-jobs))
(define (tribes-debug-docker-profile)
(profile
(content (packages->manifest (list tribes-debug-docker-package)))
(hooks %default-profile-hooks)
(locales? #t)))
(define* (tribes-debug-docker-image
#:key
(image-tag "tribes-guix-debug:latest"))
(docker-image (string-append "tribes-debug-docker-" (%current-system))
(tribes-debug-docker-profile)
#:compressor (lookup-compressor "gzip")
#:symlinks '(("/bin" -> "bin"))
#:entry-point "/bin/tribes"
#:extra-options `(#:image-tag ,image-tag)))
(define (tribes-sender-runtime-profile)
(profile
(content (packages->manifest
(list tribes-sender-runtime
sender-ffmpeg
vinyl
vinyl-exporter
prometheus-node-exporter
victoriametrics
shepherd
nss-certs)))
(hooks %default-profile-hooks)
(locales? #t)))
(define (tribes-sender-runtime-pack)
(self-contained-tarball
(string-append "tribes-sender-runtime-" (%current-system))
(tribes-sender-runtime-profile)
#:compressor (lookup-compressor "zstd")
#:symlinks '(("/opt/tribes-sender-runtime/bin" -> "bin")
("/opt/tribes-sender-runtime/sbin" -> "sbin")
("/opt/tribes-sender-runtime/share" -> "share"))))
(define (guix-kexec-installer-image)
(mlet %store-monad ((system (operating-system-derivation
build-host-kexec-installer-os)))
(gexp->derivation
(string-append "guix-kexec-installer-" (%current-system) ".tar.gz")
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(ice-9 match)
(ice-9 popen)
(ice-9 rdelim)
(srfi srfi-1)
(srfi srfi-13))
(define system #$system)
(define tmp (getcwd))
(define kexec-dir (string-append tmp "/kexec"))
(define squashfs-root (string-append tmp "/squashfs-root"))
(define (field name fields)
(match (assoc name fields)
((_ value) value)
(_ (error "missing boot parameter field" name))))
(define (read-lines file)
(call-with-input-file file
(lambda (port)
(let loop ((lines '()))
(let ((line (read-line port)))
(if (eof-object? line)
(reverse lines)
(loop (cons line lines))))))))
(define (store-item-root path)
(let ((prefix "/gnu/store/"))
(unless (string-prefix? prefix path)
(error "not a store item" path))
(let* ((base (string-drop path (string-length prefix)))
(slash (string-index base #\/)))
(string-append prefix
(if slash
(string-take base slash)
base)))))
(define (boot-metadata system)
(match (call-with-input-file (string-append system "/parameters") read)
(('boot-parameters fields ...)
(let* ((kernel (field 'kernel fields))
(initrd (field 'initrd fields))
(root (field 'root-device fields))
(args (field 'kernel-arguments fields))
(boot-path (canonicalize-path (string-append system "/boot")))
(boot-args
(append
(cond
((equal? root "tmpfs")
'("rootfstype=tmpfs"))
((and (string? root) (not (string=? root "none")))
(list (string-append "root=" root)))
(else '()))
(list (string-append "gnu.system=" system)
(string-append "gnu.load=" boot-path))
args)))
(list kernel initrd boot-path (string-join boot-args " "))))
(sexp
(error "unrecognized boot parameters file" sexp))))
(match (boot-metadata system)
((kernel initrd boot-path cmdline)
(let* ((initrd-store (store-item-root initrd))
(parameters-store
(store-item-root
(canonicalize-path (string-append system "/parameters"))))
(excluded-store-items (list initrd-store parameters-store)))
(mkdir-p kexec-dir)
(copy-file kernel (string-append kexec-dir "/bzImage"))
(copy-file initrd (string-append kexec-dir "/initrd"))
(chmod (string-append kexec-dir "/initrd") #o644)
(copy-file #$(file-append (static-package kexec-tools) "/sbin/kexec")
(string-append kexec-dir "/kexec-static"))
(chmod (string-append kexec-dir "/kexec-static") #o755)
(copy-file #$(local-file "../../scripts/kexec-run" "kexec-run")
(string-append kexec-dir "/run"))
(chmod (string-append kexec-dir "/run") #o755)
(call-with-output-file (string-append kexec-dir "/cmdline")
(lambda (port)
(display cmdline port)
(newline port)))
(mkdir-p squashfs-root)
(for-each
(lambda (path)
(when (and (string-prefix? "/gnu/store/" path)
(not (member path excluded-store-items))
(file-exists? path))
(copy-recursively path
(string-append squashfs-root "/"
(basename path)))))
(delete-duplicates
(append (list system boot-path)
(read-lines "system-graph"))))
(invoke #$(file-append squashfs-tools "/bin/mksquashfs")
squashfs-root
(string-append kexec-dir "/gnu-store.squashfs")
"-comp" "gzip"
"-Xcompression-level" "9"
"-no-xattrs"
"-noappend")
(let ((cpio-root (string-append tmp "/squashfs-cpio")))
(mkdir-p cpio-root)
(copy-file (string-append kexec-dir "/gnu-store.squashfs")
(string-append cpio-root "/gnu-store.squashfs"))
(delete-file (string-append kexec-dir "/gnu-store.squashfs"))
(let ((pipe (open-output-pipe
(string-append "cd " cpio-root
" && printf gnu-store.squashfs | "
#$(file-append cpio "/bin/cpio")
" -o -H newc | "
#$(file-append gzip "/bin/gzip")
" -9 >> " kexec-dir "/initrd"))))
(unless (zero? (close-pipe pipe))
(error "failed to append squashfs cpio to initrd"))))
(invoke #$(file-append tar "/bin/tar")
"-C" tmp
"-I" #$(file-append gzip "/bin/gzip")
"-cf" #$output
"kexec"))))))
#:references-graphs `(("system-graph" ,system)))))
(define* (derivation->job name drv
#:key
(max-silent-time 3600)
(timeout (* 5 3600)))
`((#:job-name . ,name)
(#:derivation . ,(derivation-file-name drv))
(#:inputs . ,(map (lambda (input)
(derivation-file-name
(derivation-input-derivation input)))
(derivation-inputs drv)))
(#:outputs . ,(filter-map
(lambda (res)
(match res
((name . path)
`(,name . ,path))))
(derivation->output-paths drv)))
(#:nix-name . ,(derivation-name drv))
(#:system . ,(derivation-system drv))
(#:max-silent-time . ,max-silent-time)
(#:timeout . ,timeout)))
(define (arguments->systems arguments)
(or (assoc-ref arguments 'systems)
(list (%current-system))))
(define (repository-field field repository)
(match (assoc field (cdr repository))
((_ value) value)
(_ #f)))
(define (arguments->channel-commit arguments channel-name)
(match (find (lambda (repository)
(and (pair? repository)
(eq? 'repository (car repository))
(eq? channel-name
(repository-field 'name repository))))
(or (assoc-ref arguments 'channels) '()))
(#f #f)
(repository
(repository-field 'commit repository))))
(define %substitute-manifest-targets
`((base . ,base-manifest)
(installer . ,installer-manifest)
(tribes-node . ,tribes-node-manifest)))
(define %substitute-file-targets
`((bios-bootloader-configuration . ,bios-bootloader-configuration)
(bios-bootloader-configuration-installer . ,bios-bootloader-configuration-installer)
(efi-bootloader-configuration . ,efi-bootloader-configuration)
(efi-bootloader-configuration-installer . ,efi-bootloader-configuration-installer)))
(define (manifest-profile manifest)
(profile
(content manifest)
(hooks %default-profile-hooks)
(locales? #t)))
(define (artifact-job store name proc system)
(let ((drv (parameterize ((%current-system system)
(%graft? #f))
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(proc))
#:system system))))
(derivation->job (string-append name "." system)
drv
#:max-silent-time 3600
#:timeout 72000)))
(define (substitute-manifest-jobs store system)
(map (match-lambda
((name . manifest)
(artifact-job store
(string-append "substitute-manifest-"
(symbol->string name))
(lambda ()
(lower-object (manifest-profile manifest)))
system)))
%substitute-manifest-targets))
(define (substitute-system-jobs store system)
(map (match-lambda
((name . os)
(artifact-job store
(string-append "substitute-system-"
(symbol->string name))
(lambda ()
(operating-system-derivation os))
system)))
%substitute-operating-system-targets))
(define (substitute-file-jobs store system)
(map (match-lambda
((name . file)
(artifact-job store
(string-append "substitute-file-"
(symbol->string name))
(lambda ()
(lower-object file))
system)))
%substitute-file-targets))
tribes/ci/substitutes.scm
-256
View File
@@ -1,256 +0,0 @@
(define-module (tribes ci substitutes)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages curl)
#:use-module (gnu services)
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:use-module (gnu system mapped-devices)
#:use-module (gnu system uuid)
#:use-module (guix scripts system reconfigure)
#:use-module (guix gexp)
#:use-module (nbde packages crypto)
#:use-module (nbde services tang)
#:use-module (nbde system initrd)
#:use-module (nbde system mapped-devices)
#:use-module (tribes config host)
#:use-module (tribes packages plugins)
#:use-module (tribes packages source)
#:use-module (tribes plugins registry)
#:use-module (tribes services tribes)
#:use-module (tribes system installer)
#:use-module (tribes system node)
#:export (phase1-operating-system
base-edge-operating-system
aether-edge-operating-system
kobold-edge-operating-system
sender-edge-operating-system
supertest-edge-operating-system
bios-bootloader-configuration
efi-bootloader-configuration
bios-bootloader-configuration-installer
efi-bootloader-configuration-installer
%substitute-operating-system-targets))
(define %ci-authorized-keys-file
(plain-file
"tribes-ci-authorized_keys"
"ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAITestLegionSharedBuilder legion@example.invalid\n"))
(define %ci-mapped-devices
(list
(mapped-device
(source (uuid "00000000-0000-0000-0000-000000000002" 'luks))
(target "cryptroot")
(type clevis-luks-device-mapping))))
(define %ci-initrd
(lambda (file-systems . rest)
(apply clevis-initrd file-systems
#:mapped-devices %ci-mapped-devices
#:network (nbde-network-configuration
(interface "eth0")
(timeout 20))
rest)))
(define %ci-file-systems
(cons* (file-system
(mount-point "/")
(device "/dev/mapper/cryptroot")
(type "ext4"))
(file-system
(mount-point "/boot")
(device (uuid "00000000-0000-0000-0000-000000000001" 'ext4))
(type "ext4"))
%base-file-systems))
(define %ci-efi-file-systems
(cons* (file-system
(mount-point "/boot/efi")
(device (uuid "0000-0003" 'fat32))
(type "vfat"))
%ci-file-systems))
(define %bootloader-ci-file-systems
(cons* (file-system
(mount-point "/")
(device "/dev/vda1")
(type "ext4"))
%base-file-systems))
(define %bootloader-ci-efi-file-systems
(cons* (file-system
(mount-point "/boot/efi")
(device (uuid "0000-0003" 'fat32))
(type "vfat"))
%bootloader-ci-file-systems))
(define %ci-nbde-services
(list
(service tang-service-type
(tang-configuration
(port 7654)))
(simple-service
'tribes-ci-nbde-packages
profile-service-type
(list clevis cryptsetup curl))))
(define (plugin-by-name name)
(let ((plugin-definition (guix-tribes-plugin-definition-by-name name)))
(unless plugin-definition
(error "unknown guix-tribes plugin" name))
(tribes-plugin-definition-external-plugin plugin-definition)))
(define (ci-tribes-configuration plugins)
(tribes-configuration
(package tribes-package)
(plugins plugins)
(working-directory "/var/lib/tribes")
(user "tribes")
(group "tribes")
(host "node1.example.invalid")
(listen-address "127.0.0.1")
(listen-port 4000)
(scheme "https")
(port 443)
(sync-host "node1.example.invalid")
(sync-port 4413)
(sync-bind-address "0.0.0.0")
(sync-url "wss://node1.example.invalid:4413/relay")
(sync-tls-certfile "/var/lib/tribes/secrets/sync/node.pem")
(sync-tls-keyfile "/var/lib/tribes/secrets/sync/node-key.pem")
(sync-tls-cacertfile "/var/lib/tribes/secrets/sync/ca.pem")
(admin-pubkeys '())
(database-user "tribes")
(database-name "tribes")
(parrhesia-database-name "parrhesia")
(database-host "/var/run/postgresql")
(secret-key-base-file "/var/lib/tribes/secrets/secret_key_base")
(token-signing-secret-file "/var/lib/tribes/secrets/token_signing_secret")
(release-cookie-file "/var/lib/tribes/secrets/release_cookie")
(release-distribution "name")
(release-node "tribes@127.0.0.1")
(extra-environment-variables
'("TRIBES_BOOTSTRAP_FILE=/etc/tribes/bootstrap.json"))
(log-file "/var/log/tribes.log")))
(define (ci-host-configuration plugins)
(tribes-host-configuration
(tribes (ci-tribes-configuration plugins))
(edge
(tribes-edge-configuration
(certificate-name "node1-example-invalid")
(certificate-subjects '("node1.example.invalid"))
(certificate-email "ops@example.invalid")
(certificate-profile "shortlived")
(renew-days 4)
(http-port 80)
(https-port 443)
(challenge-address "127.0.0.1")
(challenge-port 8080)
(cache-address "127.0.0.1")
(cache-port 6081)
(cache-storage '("malloc,256M"))))))
(define* (ci-operating-system name plugins
#:key
(bootloader
(bootloader-configuration
(bootloader grub-bootloader)
(targets (list "/dev/vda"))))
(file-systems %ci-file-systems))
(tribes-installer-operating-system
#:host-configuration (ci-host-configuration plugins)
#:host-name name
#:bootloader bootloader
#:mapped-devices %ci-mapped-devices
#:file-systems file-systems
#:initrd %ci-initrd
#:interface "eth0"
#:authorized-keys-file %ci-authorized-keys-file
#:extra-services %ci-nbde-services))
(define* (bootloader-ci-operating-system name bootloader file-systems)
(operating-system
(host-name name)
(bootloader bootloader)
(file-systems file-systems)
(firmware '())
(packages '())))
(define bios-bootloader-operating-system
(bootloader-ci-operating-system
"tribes-ci-bootloader-bios"
(bootloader-configuration
(bootloader grub-bootloader)
(targets (list "/dev/vda")))
%bootloader-ci-file-systems))
(define efi-bootloader-operating-system
(bootloader-ci-operating-system
"tribes-ci-bootloader-efi"
(bootloader-configuration
(bootloader grub-efi-removable-bootloader)
(targets (list "/boot/efi")))
%bootloader-ci-efi-file-systems))
(define (bootloader-configuration-installer os target)
(let* ((bootloader-config (operating-system-bootloader os))
(bootloader (bootloader-configuration-bootloader bootloader-config))
(bootcfg (operating-system-bootcfg os))
(installer (bootloader-installer bootloader))
(disk-installer (bootloader-disk-image-installer bootloader))
(package (bootloader-package bootloader))
(bootcfg-file (bootloader-configuration-file bootloader))
(devices (bootloader-configuration-targets bootloader-config)))
(install-bootloader-program installer
disk-installer
#~#+package
bootcfg
bootcfg-file
devices
target)))
(define bios-bootloader-configuration
(operating-system-bootcfg bios-bootloader-operating-system))
(define efi-bootloader-configuration
(operating-system-bootcfg efi-bootloader-operating-system))
(define bios-bootloader-configuration-installer
(bootloader-configuration-installer bios-bootloader-operating-system "/"))
(define efi-bootloader-configuration-installer
(bootloader-configuration-installer efi-bootloader-operating-system "/"))
(define phase1-operating-system
(ci-operating-system "tribes-ci-phase1" '()))
(define base-edge-operating-system
(ci-operating-system "tribes-ci-base-edge" '()))
(define aether-edge-operating-system
(ci-operating-system "tribes-ci-aether-edge"
(list (plugin-by-name "aether"))))
(define kobold-edge-operating-system
(ci-operating-system "tribes-ci-kobold-edge"
(list (plugin-by-name "trust")
(plugin-by-name "kobold"))))
(define sender-edge-operating-system
(ci-operating-system "tribes-ci-sender-edge"
(list (plugin-by-name "sender"))))
(define supertest-edge-operating-system
(ci-operating-system "tribes-ci-supertest-edge"
(list (plugin-by-name "supertest"))))
(define %substitute-operating-system-targets
`((phase1 . ,phase1-operating-system)
(base-edge . ,base-edge-operating-system)
(aether-edge . ,aether-edge-operating-system)
(kobold-edge . ,kobold-edge-operating-system)
(sender-edge . ,sender-edge-operating-system)
(supertest-edge . ,supertest-edge-operating-system)))
tribes/config/host.scm
+5 -4
View File
@@ -2,7 +2,7 @@
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (tribes packages plugins)
#:use-module (tribes plugins discovery)
#:use-module (tribes plugins registry)
#:use-module (tribes packages source)
#:use-module (tribes services tribes)
#:use-module (tribes system node)
@@ -67,7 +67,7 @@
(map
(lambda (plugin-name)
(let ((plugin-definition
(tribes-plugin-definition-by-name plugin-name)))
(guix-tribes-plugin-definition-by-name plugin-name)))
(unless plugin-definition
(error "unknown tribes plugin" plugin-name))
(tribes-plugin-definition-external-plugin plugin-definition)))
@@ -129,8 +129,9 @@
(plugins
(resolve-external-plugins
(optional-string-list tribes-json "plugins" '())))
(disabled-plugins
(optional-string-list tribes-json "disabledPlugins" '()))
(sync-overlap-seconds
(optional-integer tribes-json "syncOverlapSeconds"
(tribes-configuration-sync-overlap-seconds tribes-defaults)))
(database-user
(optional-string tribes-json "databaseUser"
(tribes-configuration-database-user tribes-defaults)))
tribes/config/system-facts.scm
+2 -2
View File
@@ -44,7 +44,7 @@
(authorized-keys-file tribes-system-facts-authorized-keys-file
(default "/etc/tribes/root-authorized_keys"))
(local-boot-key-file tribes-system-facts-local-boot-key-file
(default "/boot/nbde/local-boot.key"))
(default "/etc/legion/nbde/local-boot.key"))
(tang-port tribes-system-facts-tang-port
(default 7654))
(initrd-network-timeout-seconds
@@ -127,7 +127,7 @@
"/etc/tribes/root-authorized_keys"))
(local-boot-key-file
(optional-string payload "localBootKeyFile"
"/boot/nbde/local-boot.key"))
"/etc/legion/nbde/local-boot.key"))
(tang-port (optional-integer payload "tangPort" 7654))
(initrd-network-timeout-seconds
(optional-integer payload "initrdNetworkTimeoutSeconds" 20))
tribes/deploy/channel-updates.scm
-238
View File
@@ -1,238 +0,0 @@
(define-module (tribes deploy channel-updates)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 regex)
#:use-module (ice-9 textual-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-14)
#:use-module (tribes deploy json)
#:export (channel-updates-payload))
(define %semver-tag-rx
(make-regexp "^v[0-9]+\\.[0-9]+\\.[0-9]+([-+][0-9A-Za-z.-]+)?$"))
(define (non-empty-string? value)
(and (string? value) (not (string-null? value))))
(define (trim-trailing-slashes value)
(let loop ((end (string-length value)))
(if (and (> end 0) (char=? (string-ref value (- end 1)) #\/))
(loop (- end 1))
(substring value 0 end))))
(define (normalized-url value)
(and (non-empty-string? value) (trim-trailing-slashes value)))
(define (same-url? left right)
(let ((l (normalized-url left))
(r (normalized-url right)))
(and l r (string=? l r))))
(define (cache-root)
(let ((xdg (getenv "XDG_CACHE_HOME"))
(home (getenv "HOME")))
(cond
((non-empty-string? xdg) (string-append xdg "/guix/checkouts"))
((non-empty-string? home) (string-append home "/.cache/guix/checkouts"))
(else "/root/.cache/guix/checkouts"))))
(define (git-run checkout args)
(let* ((port (apply open-pipe* OPEN_READ "git" "-C" checkout args))
(output (get-string-all port))
(status (close-pipe port)))
(if (zero? status)
(values #t (string-trim-right output))
(values #f (string-trim-right output)))))
(define (git-run* checkout . args)
(call-with-values (lambda () (git-run checkout args))
(lambda (ok? output)
(and ok? output))))
(define (git-success? checkout . args)
(call-with-values (lambda () (git-run checkout args))
(lambda (ok? _output) ok?)))
(define (directory-children path)
(if (file-exists? path)
(filter (lambda (entry) (not (member entry '("." ".."))))
(scandir path))
'()))
(define (git-checkout? path)
(file-exists? (string-append path "/.git")))
(define (checkout-origin-url checkout)
(git-run* checkout "config" "--get" "remote.origin.url"))
(define (find-channel-checkout url)
(let ((root (cache-root)))
(find (lambda (checkout)
(and (git-checkout? checkout)
(same-url? (checkout-origin-url checkout) url)))
(map (lambda (entry) (string-append root "/" entry))
(directory-children root)))))
(define (channel-id channel)
(or (json-ref channel "id")
(json-ref channel "channel_id")
(json-ref channel "channelId")))
(define (channel-name channel)
(or (json-ref channel "name")
(json-ref channel "channel_id")
(json-ref channel "channelId")
"channel"))
(define (channel-url channel)
(json-ref channel "url"))
(define (channel-branch channel)
(or (json-ref channel "branch") "master"))
(define (channel-current-commit channel)
(or (json-ref channel "current_commit")
(json-ref channel "currentCommit")
(json-ref channel "commit")
(json-ref channel "tracked_commit")
(json-ref channel "trackedCommit")))
(define (payload-limit payload)
(let ((value (json-ref payload "limit")))
(if (and (integer? value) (> value 0))
(min value 100)
20)))
(define (payload-mode payload)
(or (json-ref payload "mode") "semver_tags"))
(define (fetch-channel! checkout)
(git-success? checkout "fetch" "--tags" "--prune" "origin"))
(define (branch-ref branch)
(string-append "refs/remotes/origin/" branch "^{commit}"))
(define (resolve-branch-head checkout branch)
(or (git-run* checkout "rev-parse" "--verify" (branch-ref branch))
(git-run* checkout "rev-parse" "--verify" (string-append branch "^{commit}"))))
(define (semver-tag? tag)
(and (string? tag) (regexp-exec %semver-tag-rx tag) #t))
(define (split-output-lines text)
(if (or (not text) (string-null? text))
'()
(string-tokenize text (char-set-complement (char-set #\newline)))))
(define (merged-semver-tags checkout head)
(filter semver-tag?
(split-output-lines
(git-run* checkout "tag" "--list" "v[0-9]*" "--merged" head "--sort=-v:refname"))))
(define (tag-commit checkout tag)
(git-run* checkout "rev-list" "-n" "1" tag))
(define (ancestor? checkout older newer)
(and (non-empty-string? older)
(non-empty-string? newer)
(git-success? checkout "merge-base" "--is-ancestor" older newer)))
(define (candidate-after-current? checkout current commit)
(cond
((not (non-empty-string? current)) #t)
((string=? current commit) #f)
(else (ancestor? checkout current commit))))
(define (commit-field checkout commit format)
(or (git-run* checkout "show" "-s" (string-append "--format=" format) commit) ""))
(define (candidate-payload checkout tag commit)
`(("commit" . ,commit)
("tag" . ,tag)
("short_commit" . ,(commit-field checkout commit "%h"))
("subject" . ,(commit-field checkout commit "%s"))
("message" . ,(commit-field checkout commit "%B"))
("committed_at" . ,(commit-field checkout commit "%cI"))))
(define (semver-candidates checkout head current limit)
(let loop ((tags (merged-semver-tags checkout head))
(candidates '()))
(cond
((or (null? tags) (>= (length candidates) limit))
(reverse candidates))
(else
(let* ((tag (car tags))
(commit (tag-commit checkout tag)))
(if (and commit (candidate-after-current? checkout current commit))
(loop (cdr tags)
(cons (candidate-payload checkout tag commit) candidates))
(loop (cdr tags) candidates)))))))
(define (commit-candidates checkout head current limit)
(let* ((range (if (and (non-empty-string? current)
(ancestor? checkout current head))
(string-append current ".." head)
head))
(commits (split-output-lines
(git-run* checkout "rev-list"
(string-append "--max-count=" (number->string limit))
range))))
(map (lambda (commit)
(candidate-payload checkout #f commit))
commits)))
(define (channel-error-payload channel code message)
`(("id" . ,(channel-id channel))
("name" . ,(channel-name channel))
("url" . ,(or (channel-url channel) ""))
("branch" . ,(channel-branch channel))
("ok" . #f)
("error" . (("code" . ,code) ("message" . ,message)))))
(define (channel-updates channel mode limit)
(let ((url (channel-url channel))
(branch (channel-branch channel))
(current (channel-current-commit channel)))
(cond
((not (non-empty-string? url))
(channel-error-payload channel "invalid_channel" "channel url is required"))
((not (member mode '("semver_tags" "commits")))
(channel-error-payload channel "unsupported_mode" "supported modes are semver_tags and commits"))
(else
(let ((checkout (find-channel-checkout url)))
(cond
((not checkout)
(channel-error-payload channel "checkout_not_found" "no Guix channel checkout matched the channel url"))
((not (fetch-channel! checkout))
(channel-error-payload channel "fetch_failed" "git fetch failed for channel checkout"))
(else
(let ((head (resolve-branch-head checkout branch)))
(if (not head)
(channel-error-payload channel "branch_not_found" "channel branch was not found in checkout")
`(("id" . ,(channel-id channel))
("name" . ,(channel-name channel))
("url" . ,url)
("branch" . ,branch)
("ok" . #t)
("current_commit" . ,current)
("branch_head" . ,head)
("checkout" . ,checkout)
("candidates" . ,(if (string=? mode "commits")
(commit-candidates checkout head current limit)
(semver-candidates checkout head current limit)))))))))))))
(define (channel-updates-payload payload)
(let* ((channels (or (json-list-ref payload "channels") '()))
(mode (payload-mode payload))
(limit (payload-limit payload)))
`(("schemaVersion" . "1")
("ok" . #t)
("mode" . ,mode)
("channels" . ,(map (lambda (channel)
(if (json-object? channel)
(channel-updates channel mode limit)
`(("ok" . #f)
("error" . (("code" . "invalid_channel")
("message" . "channel must be an object"))))))
channels)))))
tribes/deploy/current-guix-worker.scm
+2 -112
View File
@@ -1,6 +1,4 @@
(define-module (tribes deploy current-guix-worker)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system)
#:use-module (guix derivations)
#:use-module (guix gexp)
@@ -8,11 +6,8 @@
#:use-module (guix scripts system reconfigure)
#:use-module (guix store)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:export (current-guix-worker-main
realize-system-closure!
realize-service-upgrade-inputs!
post-switch-activate-and-upgrade!))
;; This module is intentionally executed through
@@ -31,41 +26,10 @@
(set! %load-path path)
(set! %load-compiled-path compiled-path)))))
(define (realize-store-closures store paths)
"Ensure PATHS and every referenced store item are present in STORE."
(let loop ((pending paths)
(seen '()))
(match pending
(()
#t)
((path . rest)
(if (member path seen)
(loop rest seen)
(begin
;; References may only be known locally after PATH itself has
;; been realized from a substitute or build output.
(ensure-path store path)
(loop (append (references store path) rest)
(cons path seen))))))))
(define realize-store-closures*
(store-lift realize-store-closures))
(define (lowered-gexp-store-paths lowered)
"Return the store paths that LOWERED needs to evaluate without realizing
additional derivations later."
(append (append-map derivation-input-output-paths
(lowered-gexp-inputs lowered))
(lowered-gexp-sources lowered)
(lowered-gexp-load-path lowered)
(lowered-gexp-load-compiled-path lowered)))
(define (local-eval exp)
"Evaluate EXP, a G-Expression, in-place."
(mlet* %store-monad ((lowered (lower-gexp exp))
(_ (built-derivations (lowered-gexp-inputs lowered)))
(_ (realize-store-closures*
(lowered-gexp-store-paths lowered))))
(_ (built-derivations (lowered-gexp-inputs lowered))))
(save-load-path-excursion
(set! %load-path (lowered-gexp-load-path lowered))
(set! %load-compiled-path (lowered-gexp-load-compiled-path lowered))
@@ -90,13 +54,6 @@ additional derivations later."
(error "configuration did not evaluate to an operating-system" config-file))
os))
(define (realize-system-closure! system-path)
"Ensure SYSTEM-PATH and every referenced store item is present locally."
(unless (and (string? system-path) (file-exists? system-path))
(error "system path does not exist" system-path))
(with-store store
(realize-store-closures store (list system-path))))
(define (upgrade-live-services! config-file)
(let ((os (load-operating-system config-file)))
(with-store store
@@ -105,63 +62,6 @@ additional derivations later."
(upgrade-shepherd-services local-eval os)
(return #t))))))
(define (service-upgrade-inputs-gexp os)
(let* ((target-services
(shepherd-configuration-services
(service-value
(fold-services (operating-system-services os)
#:target-type shepherd-root-service-type))))
(service-files (map shepherd-service-file target-services)))
#~(parameterize ((current-warning-port (%make-void-port "w")))
(primitive-load #$(upgrade-services-program service-files '() '() '())))))
(define (realize-lowered-file-like! lowered)
(match lowered
((? derivation? drv)
(mbegin %store-monad
(built-derivations (list drv))
(realize-store-closures* (list (derivation->output-path drv)))))
((? string? path)
(realize-store-closures* (list path)))
(_
(with-monad %store-monad
(return #t)))))
(define (realize-file-likes! file-likes)
(match file-likes
(()
(with-monad %store-monad
(return #t)))
((file-like . rest)
(mlet* %store-monad ((lowered (lower-object file-like))
(_ (realize-lowered-file-like! lowered)))
(realize-file-likes! rest)))))
(define (realize-service-upgrade-inputs! config-file)
"Realize the store items needed by the post-switch Shepherd upgrade.
This intentionally runs during prepare, before the system profile is switched.
If substitutes are missing or a large dependency would need local compilation,
the deployment fails while the old generation is still active instead of
stalling halfway through commit."
(let* ((os (load-operating-system config-file))
(target-services
(shepherd-configuration-services
(service-value
(fold-services (operating-system-services os)
#:target-type shepherd-root-service-type))))
(service-files (map shepherd-service-file target-services)))
(with-store store
(run-with-store store
(mlet* %store-monad ((_ (realize-file-likes! service-files))
(lowered (lower-gexp
(service-upgrade-inputs-gexp os)))
(_ (built-derivations
(lowered-gexp-inputs lowered)))
(_ (realize-store-closures*
(lowered-gexp-store-paths lowered))))
(return #t))))))
(define (post-switch-activate-and-upgrade! generation-path config-file)
(parameterize ((current-output-port (current-error-port))
(current-warning-port (%make-void-port "w")))
@@ -170,21 +70,11 @@ stalling halfway through commit."
(define (usage)
(format (current-error-port)
"Usage: current-guix-worker.scm COMMAND [ARGS...]~%")
(format (current-error-port)
"Commands: realize-system-closure SYSTEM~%")
(format (current-error-port)
" preload-service-upgrade CONFIG~%")
(format (current-error-port)
" post-switch-activate-and-upgrade GENERATION CONFIG~%")
"Usage: current-guix-worker.scm post-switch-activate-and-upgrade GENERATION CONFIG~%")
(exit 64))
(define (current-guix-worker-main args)
(match args
(("realize-system-closure" system-path)
(realize-system-closure! system-path))
(("preload-service-upgrade" config-file)
(realize-service-upgrade-inputs! config-file))
(("post-switch-activate-and-upgrade" generation-path config-file)
(post-switch-activate-and-upgrade! generation-path config-file))
(_ (usage))))
tribes/deploy/current-guix.scm
+5 -51
View File
@@ -6,14 +6,9 @@
system-guix-binary
current-guix-binary
bootstrap-guix-binary
pulled-guix-profile-available?
current-guix-profile-root
current-guix-site-directory
current-guix-compiled-site-directory
current-guix-module-file
current-system-channels-file
call-with-clean-guix-environment
call-with-current-guix-environment
run-current-guix-repl-script))
;; Lightweight helpers for invoking the Guix profile that owns the active
@@ -27,13 +22,8 @@
(define (pulled-guix-binary)
(string-append (home-directory) "/.config/guix/current/bin/guix"))
(define (pulled-guix-profile-available?)
(file-exists? (pulled-guix-binary)))
(define system-guix-binary "/run/current-system/profile/bin/guix")
(define default-current-system "/run/current-system")
(define (path-directories)
(string-split (or (getenv "PATH") "") #\:))
@@ -42,7 +32,7 @@
(define (current-guix-binary)
(cond
((pulled-guix-profile-available?) (pulled-guix-binary))
((file-exists? (pulled-guix-binary)) (pulled-guix-binary))
((file-exists? system-guix-binary) system-guix-binary)
(else (or (guix-on-path) "guix"))))
@@ -61,39 +51,22 @@
(or (guix-profile-root (current-guix-binary))
(error "cannot infer Guix profile root" (current-guix-binary))))
(define (current-guix-site-directory)
(string-append (current-guix-profile-root)
"/share/guile/site/3.0"))
(define (current-guix-compiled-site-directory)
(string-append (current-guix-profile-root)
"/lib/guile/3.0/site-ccache"))
(define (current-guix-module-file relative-path)
(let ((path (string-append (current-guix-site-directory)
"/"
(let ((path (string-append (current-guix-profile-root)
"/share/guile/site/3.0/"
relative-path)))
(unless (file-exists? path)
(error "current Guix profile does not provide required module file"
path))
path))
(define (current-system-channels-file . maybe-current-system)
"Return the channel provenance file recorded by CURRENT-SYSTEM, if present."
(let* ((current-system (if (null? maybe-current-system)
default-current-system
(car maybe-current-system)))
(channels-file (string-append current-system "/channels.scm")))
(and (file-exists? channels-file) channels-file)))
(define %guix-environment-variables
;; These are intentionally unset for child Guix commands. The command from
;; /root/.config/guix/current sets up its own load paths; inheriting the
;; tribes-command wrapper paths would reintroduce packaged Guix modules.
'("GUILE_LOAD_PATH"
"GUILE_LOAD_COMPILED_PATH"
"GUIX_PACKAGE_PATH"
"GUIX_UNINSTALLED"))
"GUIX_PACKAGE_PATH"))
(define (call-with-clean-guix-environment thunk)
(let ((saved (map (lambda (name) (cons name (getenv name)))
@@ -109,25 +82,6 @@
((name . value) (setenv name value)))
saved)))))
(define (call-with-current-guix-environment thunk)
"Run THUNK with wrapper load paths replaced by the selected Guix profile.
The local-control command is itself wrapped with packaged Guix modules so it
can bootstrap. Child invocations that evaluate system configuration files must
instead see the pulled channel profile, including the guix-tribes modules that
materialized the active system."
(call-with-clean-guix-environment
(lambda ()
(setenv "GUILE_LOAD_PATH" (current-guix-site-directory))
(let ((compiled (current-guix-compiled-site-directory)))
(when (file-exists? compiled)
(setenv "GUILE_LOAD_COMPILED_PATH" compiled)))
;; The packaged 'guix' command prepends its own module directory unless
;; GUIX_UNINSTALLED is set. Keep the selected profile modules first so
;; channel fixes are actually used by child Guix commands.
(setenv "GUIX_UNINSTALLED" "1")
(thunk))))
(define (normalize-status status)
(cond
((and (integer? status) (zero? status)) 0)
@@ -137,7 +91,7 @@ materialized the active system."
(define (run-current-guix-repl-script script args)
"Run SCRIPT under the current Guix profile's `guix repl'. Return a process
exit code."
(call-with-current-guix-environment
(call-with-clean-guix-environment
(lambda ()
(normalize-status
(apply system* (current-guix-binary)
tribes/deploy/executor.scm
+34 -62
View File
@@ -1,13 +1,13 @@
(define-module (tribes deploy executor)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (ice-9 textual-ports)
#:use-module (json)
#:use-module (guix packages)
#:use-module (tribes deploy json)
#:use-module (tribes deploy plan)
#:use-module (tribes packages plugins)
#:use-module (tribes plugins built-ins)
#:use-module (tribes plugins discovery)
#:use-module (tribes plugins registry)
#:re-export (json-object?
json-ref
json-string-list-ref
@@ -18,6 +18,16 @@
plan-hash)
#:export (resolve-target))
(define %host-capabilities
'("admin_ui@1"
"ash@1"
"auth@1"
"ecto@1"
"nostr_relay@1"
"nostr_sync@1"
"phoenix@1"
"pubsub@1"))
(define (remove-item value items)
(filter (lambda (item) (not (equal? item value))) items))
@@ -44,17 +54,6 @@
(define (channel-url channel)
(or (json-ref channel "url") ""))
(define (channel-name channel)
(or (json-ref channel "name")
(json-ref channel "guix_name")
(json-ref channel "guixName")
(json-ref channel "channel_id")
(json-ref channel "channelId")
"tribes"))
(define (channel-branch channel)
(or (json-ref channel "branch") "master"))
(define (channel-commit channel)
(or (json-ref channel "commit") ""))
@@ -84,15 +83,8 @@
(define (trusted-signer-ids signers)
(filter-map (lambda (signer) (json-ref signer "id")) signers))
(define (normalize-fingerprint value)
(and (string? value)
(list->string
(map char-upcase
(filter (lambda (char) (not (char-whitespace? char)))
(string->list value))))))
(define (trusted-signer-fingerprints signers)
(filter-map (lambda (signer) (normalize-fingerprint (json-ref signer "fingerprint"))) signers))
(filter-map (lambda (signer) (json-ref signer "fingerprint")) signers))
(define (duplicates values)
(let loop ((remaining values) (seen '()) (dups '()))
@@ -122,11 +114,8 @@
(define (channel->resolved channel)
`(("channel_id" . ,(channel-id channel))
("name" . ,(channel-name channel))
("url" . ,(channel-url channel))
("branch" . ,(channel-branch channel))
("commit" . ,(channel-commit channel))
("introduction" . ,(channel-introduction channel))
("position" . ,(channel-position channel))))
(define (default-plugin-channel channels)
@@ -135,17 +124,15 @@
channels)
(and (pair? channels) (car channels))))
(define (requested-plugins target)
(define (requested-enabled-plugins target)
(filter (lambda (plugin)
(and (json-object? plugin)
(plugin-entry-enabled? plugin)
(string? (plugin-entry-name plugin))))
(or (json-list-ref target "plugins") '())))
(define (requested-enabled-plugins target)
(filter plugin-entry-enabled? (requested-plugins target)))
(define (plugin-definition name)
(tribes-plugin-definition-by-name name))
(guix-tribes-plugin-definition-by-name name))
(define (definition-name definition)
(tribes-plugin-definition-name definition))
@@ -166,7 +153,7 @@
(filter (lambda (definition)
(member capability
(definition-provides definition)))
(tribes-plugin-definitions)))
guix-tribes-plugin-definitions))
(define (plugin-definition-dependencies definition)
(let loop ((caps (definition-requires definition))
@@ -175,7 +162,7 @@
(() (reverse deps))
((capability . rest)
(cond
((member capability guix-tribes-runtime-provided-capabilities)
((member capability %host-capabilities)
(loop rest deps))
(else
(let ((providers
@@ -240,7 +227,7 @@
(lambda (channel)
(let* ((allowed (channel-allowed-signer-ids channel))
(introduction (channel-introduction channel))
(fingerprint (normalize-fingerprint (json-ref introduction "fingerprint"))))
(fingerprint (json-ref introduction "fingerprint")))
(or (any (lambda (signer-id) (not (member signer-id signer-ids))) allowed)
(and (string? fingerprint)
(not (member fingerprint fingerprints))))))
@@ -253,16 +240,8 @@
("allowed_signer_ids" . ,(channel-allowed-signer-ids untrusted))
("introduction" . ,(channel-introduction untrusted)))))))
(define (runtime-capability-error)
(and (not (null? guix-tribes-runtime-missing-capabilities))
(resolver-error
"host_capability_missing"
"host and built-in plugin manifests have unsatisfied capabilities"
`(("missing_capabilities" . ,guix-tribes-runtime-missing-capabilities)
("provided_capabilities" . ,guix-tribes-runtime-provided-capabilities)))))
(define (plugin-name-duplicates target)
(duplicates (map plugin-entry-name (requested-plugins target))))
(duplicates (map plugin-entry-name (requested-enabled-plugins target))))
(define (plugin-request-channel plugin channels)
(let ((explicit-channel-id (plugin-entry-channel-id plugin)))
@@ -285,7 +264,7 @@
(tribes-external-plugin-extra-packages
(tribes-plugin-definition-external-plugin definition))))
(define (resolved-plugin plugin-name channels requested-plugins enabled-plugin-names)
(define (resolved-plugin plugin-name channels requested-plugins)
(let* ((definition (plugin-definition plugin-name))
(request-entry
(find (lambda (plugin)
@@ -294,7 +273,6 @@
(channel (and request-entry
(plugin-request-channel request-entry channels))))
`(("name" . ,plugin-name)
("enabled" . ,(if (member plugin-name enabled-plugin-names) #t #f))
("channel_id" . ,(and channel (channel-id channel)))
("package_ref" . ,(package-ref channel definition))
("migration_target_version" . #f)
@@ -316,12 +294,10 @@
(define (resolve-target target)
(let* ((channels (enabled-channels target))
(requested-plugins (requested-plugins target))
(requested-plugins (requested-enabled-plugins target))
(trusted-signers (enabled-trusted-signers target))
(requested-names (map plugin-entry-name requested-plugins))
(requested-enabled-names (map plugin-entry-name (requested-enabled-plugins target)))
(duplicate-plugin-names (plugin-name-duplicates target))
(runtime-error (runtime-capability-error))
(trust-error (channel-trust-error channels trusted-signers)))
(cond
((not (null? duplicate-plugin-names))
@@ -329,23 +305,19 @@
"duplicate_plugin"
"duplicate plugin names requested"
`(("plugins" . ,duplicate-plugin-names))))
(runtime-error runtime-error)
(trust-error trust-error)
(else
(let ((resolved-names (resolve-plugin-names requested-names))
(enabled-resolved-names (resolve-plugin-names requested-enabled-names)))
(cond
((resolver-error-object? resolved-names) resolved-names)
((resolver-error-object? enabled-resolved-names) enabled-resolved-names)
(else
(let* ((resolved-channels (map channel->resolved channels))
(resolved-plugins
(map (lambda (name)
(resolved-plugin name channels requested-plugins enabled-resolved-names))
resolved-names))
(resolved-extra-packages
(resolved-extra-packages resolved-names channels requested-plugins))
(base-plan
(let ((resolved-names (resolve-plugin-names requested-names)))
(if (resolver-error-object? resolved-names)
resolved-names
(let* ((resolved-channels (map channel->resolved channels))
(resolved-plugins
(map (lambda (name)
(resolved-plugin name channels requested-plugins))
resolved-names))
(resolved-extra-packages
(resolved-extra-packages resolved-names channels requested-plugins))
(base-plan
`(("plan_schema_version" . "1")
("resolved_channels" . ,(list->vector resolved-channels))
("resolved_plugins" . ,(list->vector resolved-plugins))
@@ -353,4 +325,4 @@
("core_migration_target" . #f)
("core_destructive_rollback_migrations" . #())
("closure_estimate_bytes" . #f))))
(assoc-set base-plan "plan_hash" (string-plan-hash base-plan))))))))))
(assoc-set base-plan "plan_hash" (string-plan-hash base-plan)))))))))
tribes/deploy/guix-helper.scm
+4 -11
View File
@@ -17,12 +17,10 @@
helper-result-frames
make-helper-backend
helper-backend?
helper-backend-catalog
helper-backend-pull
helper-backend-build
helper-backend-switch
default-helper-backend
run-catalog!
run-pull!
run-build!
run-switch!
@@ -154,9 +152,6 @@ parsed frame so the worker can stream phase updates."
;; tribes-guix-helper build <config-file> <system-profile-link> <root-link>
;; tribes-guix-helper switch <generation-number> <config-file> <system-profile-link>
(define* (run-catalog! config #:key (on-frame (lambda (_) #t)))
(run-helper config (list "catalog") #:on-frame on-frame))
(define* (run-pull! config #:key (on-frame (lambda (_) #t)))
(run-helper config
(list "pull" (deploy-config-channels-file config))
@@ -184,16 +179,14 @@ parsed frame so the worker can stream phase updates."
;; a fake backend with canned results.
(define-record-type <helper-backend>
(make-helper-backend catalog pull build switch)
(make-helper-backend pull build switch)
helper-backend?
(catalog helper-backend-catalog) ;; (config on-frame) -> <helper-result>
(pull helper-backend-pull) ;; (config on-frame) -> <helper-result>
(build helper-backend-build) ;; (config root-link on-frame) -> result
(switch helper-backend-switch)) ;; (config gen-number on-frame) -> result
(pull helper-backend-pull) ;; (config on-frame) -> <helper-result>
(build helper-backend-build) ;; (config root-link on-frame) -> result
(switch helper-backend-switch)) ;; (config gen-number on-frame) -> result
(define (default-helper-backend)
(make-helper-backend
(lambda (config on-frame) (run-catalog! config #:on-frame on-frame))
(lambda (config on-frame) (run-pull! config #:on-frame on-frame))
(lambda (config root on-frame) (run-build! config root #:on-frame on-frame))
(lambda (config gen on-frame) (run-switch! config gen #:on-frame on-frame))))
tribes/deploy/handlers.scm
-20
View File
@@ -2,7 +2,6 @@
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (tribes deploy channel-updates)
#:use-module (tribes deploy config)
#:use-module (tribes deploy json)
#:use-module (tribes deploy operations)
@@ -11,15 +10,12 @@
#:use-module (tribes deploy worker)
#:export (handle-status
handle-generations
handle-plugin-catalog
handle-channel-updates
handle-resolve
handle-prepare
handle-commit
handle-rollback
handle-abort
error-payload
validate-channel-updates-input
validate-resolve-input
validate-prepare-input
validate-commit-input
@@ -47,13 +43,6 @@
(loop tail seen (if (member v dups) dups (cons v dups))))
(else (loop tail (cons v seen) dups)))))))
(define (validate-channel-updates-input payload)
(cond
((not (json-object-with-string-keys? payload))
"payload must be a JSON object")
((not (json-list-ref payload "channels"))
"channels must be a JSON array")
(else #f)))
(define (validate-resolve-input payload)
(cond
((not (json-object-with-string-keys? payload))
@@ -112,14 +101,6 @@
(define (handle-generations state)
(values 200 (list-generations-payload state)))
(define (handle-plugin-catalog state helper)
(plugin-catalog-payload state helper))
(define (handle-channel-updates payload)
(let ((err (validate-channel-updates-input payload)))
(cond
(err (values 400 (error-payload "invalid_request" err)))
(else (values 200 (channel-updates-payload payload))))))
(define (handle-resolve payload)
(let ((err (validate-resolve-input payload)))
(cond
@@ -135,7 +116,6 @@
(let ((plugins (plan-plugins payload))
(plan-hash-value (plan-hash payload)))
(submit-prepare! state worker helper plugins plan-hash-value
#:plan payload
#:pull-required?
(plan-requires-pull? payload)))))))
tribes/deploy/helper-main.scm
+34 -270
View File
@@ -8,7 +8,6 @@
#:use-module (ice-9 textual-ports)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-71)
#:use-module (tribes deploy current-guix)
@@ -55,10 +54,6 @@
(define system-herd "/run/current-system/profile/bin/herd")
(define default-system-profile "/var/guix/profiles/system")
(define default-deploy-directory "/var/lib/tribes/deploy")
(define default-current-system "/run/current-system")
(define default-current-system-channels-snapshot
(string-append default-deploy-directory "/current-system-channels.scm"))
(define (herd-binary)
(if (file-exists? system-herd) system-herd "herd"))
@@ -68,124 +63,27 @@
;; to operators) and return (values exit-status captured) where captured is
;; the joined stderr+stdout text — used to classify errors.
(define (wait-status->exit-code status)
(cond
((and (integer? status) (status:exit-val status)) => identity)
((and (integer? status) (status:term-sig status))
=> (lambda (signal) (+ 128 signal)))
(else 1)))
(define (open-input-pipe*+stderr command args)
(match (pipe)
((input . output)
(match (primitive-fork)
(0
(dynamic-wind
(const #t)
(lambda ()
(close-port input)
(dup2 (fileno output) 1)
(dup2 (fileno output) 2)
(apply execlp command command args))
(lambda ()
(primitive-exit 127))))
(pid
(close-port output)
(values input pid))))))
(define (capture-status command args)
(format (current-error-port)
"tribes-guix-helper: running command: ~s~%"
(cons command args))
(let ((port pid (open-input-pipe*+stderr command args)))
(let* ((lines (let loop ((acc '()))
(let ((line (read-line port)))
(cond
((eof-object? line) (reverse acc))
(else
(format (current-error-port) "~a~%" line)
(loop (cons line acc)))))))
(_ (close-port port))
(status (match (waitpid pid)
((_ . status) status)))
(exit-code (wait-status->exit-code status)))
(format (current-error-port)
"tribes-guix-helper: command exited with status ~s (exit code ~a): ~s~%"
status
exit-code
(cons command args))
(values exit-code
(string-join lines "\n")))))
(let* ((port (apply open-pipe* OPEN_READ
(cons command args)))
(lines (let loop ((acc '()))
(let ((line (read-line port)))
(cond
((eof-object? line) (reverse acc))
(else
(format (current-error-port) "~a~%" line)
(loop (cons line acc)))))))
(status (close-pipe port)))
(values (or (and (integer? status)
(status:exit-val status))
1)
(string-join lines "\n"))))
(define (capture-guix-status command args)
(call-with-clean-guix-environment
(lambda ()
(capture-status command args))))
(define (capture-current-guix-status args)
(call-with-current-guix-environment
(lambda ()
(format (current-error-port)
"tribes-guix-helper: current Guix binary: ~a~%"
(current-guix-binary))
(format (current-error-port)
"tribes-guix-helper: current Guix profile root: ~a~%"
(current-guix-profile-root))
(format (current-error-port)
"tribes-guix-helper: Guix environment: GUIX_UNINSTALLED=~s GUILE_LOAD_PATH=~s GUILE_LOAD_COMPILED_PATH=~s~%"
(getenv "GUIX_UNINSTALLED")
(getenv "GUILE_LOAD_PATH")
(getenv "GUILE_LOAD_COMPILED_PATH"))
(capture-status (current-guix-binary) args))))
(define (write-current-system-channels-snapshot!)
"Write the current system's recorded channel provenance and return its path."
(let ((channels-file (current-system-channels-file default-current-system)))
(and channels-file
(begin
(mkdir-p default-deploy-directory)
(copy-file channels-file default-current-system-channels-snapshot)
default-current-system-channels-snapshot))))
(define (capture-build-guix-status args)
(if (pulled-guix-profile-available?)
(capture-current-guix-status args)
(let ((channels-file (write-current-system-channels-snapshot!)))
(if channels-file
(capture-guix-status
(bootstrap-guix-binary)
(append (list "time-machine" "-C" channels-file "--") args))
(let ((message
(string-append "current system channel provenance is missing: "
default-current-system
"/channels.scm")))
(format (current-error-port) "~a~%" message)
(values 1 message))))))
(define (capture-prepared-guix-status args)
"Run ARGS under the Guix environment used by the last prepare build.
The system profile contains a packaged Guix that may be built from a different
commit than the channel environment used to build the selected generation.
Post-switch activation must keep using the prepare environment; otherwise
re-evaluating service gexps can compute different derivations and start a
local build after the profile has already been switched."
(if (pulled-guix-profile-available?)
(capture-current-guix-status args)
(let ((channels-file
(if (file-exists? default-current-system-channels-snapshot)
default-current-system-channels-snapshot
(write-current-system-channels-snapshot!))))
(if channels-file
(capture-guix-status
(bootstrap-guix-binary)
(append (list "time-machine" "-C" channels-file "--") args))
(let ((message
(string-append "prepared channel provenance is missing: "
default-current-system-channels-snapshot)))
(format (current-error-port) "~a~%" message)
(values 1 message))))))
;; ----- path helpers --------------------------------------------------------
(define (resolved-link-path path)
@@ -204,6 +102,7 @@ local build after the profile has already been switched."
(define %root-link-generation-rx (make-regexp "system-([0-9]+)-link$"))
(define default-host-config-file "/etc/tribes/host-config.json")
(define default-system-facts-file "/etc/tribes/system-facts.json")
(define default-deploy-directory "/var/lib/tribes/deploy")
(define (file->string path)
(call-with-input-file path get-string-all))
@@ -273,18 +172,6 @@ local build after the profile has already been switched."
((string=? (substring haystack i (+ i nl)) needle) #t)
(else (loop (+ i 1)))))))))
(define (captured-output-tail captured)
"Return a bounded tail of CAPTURED suitable for failure details."
(let* ((lines (if (string? captured)
(string-split captured #\newline)
'()))
(tail (let loop ((remaining lines)
(count (length lines)))
(if (<= count 120)
remaining
(loop (cdr remaining) (- count 1))))))
(string-join tail "\n")))
(define (classify-pull-error captured)
(cond
((text-contains? captured "signature") "signature_invalid")
@@ -293,35 +180,18 @@ local build after the profile has already been switched."
((text-contains? captured "Couldn't find remote ref")
"channel_commit_unreachable")
(else "build_failed")))
(define (last-json-line text)
(find (lambda (line)
(let ((trimmed (string-trim-both line)))
(or (string-prefix? "{" trimmed)
(string-prefix? "[" trimmed))))
(reverse (string-split text #\newline))))
(define (current-guix-describe-channels)
(call-with-values
(lambda ()
(capture-current-guix-status (list "describe" "--format=json")))
(lambda (status captured)
(and (zero? status)
(catch #t
(lambda ()
(json-string->scm (or (last-json-line captured) "")))
(lambda _ #f))))))
;; ----- current Guix worker helpers ----------------------------------------
(define (activate-and-upgrade-with-current-guix! generation-path config-file)
"Activate GENERATION-PATH and upgrade Shepherd services with prepared Guix.
This intentionally uses the same channel snapshot as prepare, not necessarily
the packaged Guix in /run/current-system after `switch-generation'."
"Activate GENERATION-PATH and upgrade Shepherd services in the current Guix
profile, i.e. the pulled channel environment used by `guix system build'."
(let ((script (current-guix-module-file
"tribes/deploy/current-guix-worker.scm")))
(call-with-values
(lambda ()
(capture-prepared-guix-status
(capture-guix-status
(current-guix-binary)
(list "repl" "-q" "--"
script
"post-switch-activate-and-upgrade"
@@ -333,35 +203,6 @@ the packaged Guix in /run/current-system after `switch-generation'."
`((exit_status . ,status)
(output . ,captured))))))))
(define (capture-service-upgrade-preload-status config-file)
"Realize post-switch service upgrade inputs for CONFIG-FILE.
Run this under the same Guix environment used for the prepare build. This
keeps expensive or missing build work in the prepare phase, before the system
profile is switched."
(let ((script (current-guix-module-file
"tribes/deploy/current-guix-worker.scm")))
(capture-build-guix-status
(list "repl" "-q" "--"
script
"preload-service-upgrade"
config-file))))
(define (capture-system-closure-preload-status system-path)
"Realize SYSTEM-PATH's full store closure before it becomes active.
`guix system build' realizes the top-level system item. Its referenced store
items may still be absent locally and get fetched or built later when
activation or Shepherd service loading touches them. Keep that work in
prepare so a missing substitute cannot stall the switch phase."
(let ((script (current-guix-module-file
"tribes/deploy/current-guix-worker.scm")))
(capture-build-guix-status
(list "repl" "-q" "--"
script
"realize-system-closure"
system-path))))
(define (schedule-tribes-restart!)
(let ((pid (primitive-fork)))
(cond
@@ -397,61 +238,14 @@ prepare so a missing substitute cannot stall the switch phase."
(lambda (status captured)
(cond
((zero? status)
(let ((channels (current-guix-describe-channels)))
(done-frame
`("channels" . ,(or channels #())))
(exit 0)))
(done-frame)
(exit 0))
(else
(error-frame (classify-pull-error captured)
"guix pull failed"
`(("exit_status" . ,status)))
(exit status))))))
(define (catalog-script-file)
(let ((path (string-append default-deploy-directory "/plugin-catalog.scm")))
(mkdir-p default-deploy-directory)
(call-with-output-file path
(lambda (port)
(display "(use-modules (json) (tribes plugins discovery))\n" port)
(display "(scm->json (tribes-plugin-catalog-payload) (current-output-port))\n" port)
(display "(newline)\n" port)))
path))
(define (cmd-catalog)
(phase-frame "catalog")
(let ((script (catalog-script-file)))
(call-with-values
(lambda ()
(call-with-current-guix-environment
(lambda ()
(capture-status (current-guix-binary)
(list "repl" "-q" "--" script)))))
(lambda (status captured)
(cond
((zero? status)
(call-with-values
(lambda ()
(catch #t
(lambda () (values (json-string->scm (or (last-json-line captured) "")) #f))
(lambda (key . args)
(values #f (format #f "~a: ~s" key args)))))
(lambda (catalog error)
(cond
(error
(error-frame "plugin_catalog_invalid"
"plugin catalog generator returned invalid JSON"
`(("error" . ,error)))
(exit 1))
(else
(done-frame `("catalog" . ,catalog))
(exit 0))))))
(else
(error-frame "plugin_catalog_failed"
"plugin catalog generation failed"
`(("exit_status" . ,status)
("output_tail" . ,(captured-output-tail captured))))
(exit status)))))))
(define (cmd-build config-file system-profile-link root-link)
(phase-frame "building")
(let* ((effective-config-file
@@ -461,11 +255,11 @@ prepare so a missing substitute cannot stall the switch phase."
(build-config-file-for-prepare effective-config-file root-link)))
(call-with-values
(lambda ()
(capture-build-guix-status
(list "system" "build"
"--save-provenance"
(string-append "--root=" root-link)
build-config-file)))
(capture-guix-status (current-guix-binary)
(list "system" "build"
"--save-provenance"
(string-append "--root=" root-link)
build-config-file)))
(lambda (status captured)
(cond
((zero? status)
@@ -473,47 +267,21 @@ prepare so a missing substitute cannot stall the switch phase."
(or (false-if-exception (canonicalize-path root-link))
(false-if-exception (readlink root-link))
"")))
(call-with-values
(lambda ()
(capture-system-closure-preload-status store-path))
(lambda (closure-status closure-captured)
(cond
((zero? closure-status)
(call-with-values
(lambda ()
(capture-service-upgrade-preload-status
(preferred-configuration-file store-path build-config-file)))
(lambda (preload-status preload-captured)
(cond
((zero? preload-status)
(done-frame `("store_path" . ,store-path))
(exit 0))
(else
(error-frame "service_upgrade_preload_failed"
"post-switch service upgrade inputs could not be realized"
`(("exit_status" . ,preload-status)
("output" . ,preload-captured)))
(exit preload-status))))))
(else
(error-frame "system_closure_preload_failed"
"target system closure could not be realized"
`(("exit_status" . ,closure-status)
("output" . ,closure-captured)))
(exit closure-status)))))))
(done-frame `("store_path" . ,store-path))
(exit 0)))
(else
(error-frame "build_failed"
"guix system build failed"
`(("exit_status" . ,status)
("output_tail" . ,(captured-output-tail captured))))
`(("exit_status" . ,status)))
(exit status)))))))
(define (cmd-switch generation-number config-file system-profile-link)
(phase-frame "switching")
(call-with-values
(lambda ()
(capture-current-guix-status
(list "system" "switch-generation"
generation-number)))
(capture-guix-status (current-guix-binary)
(list "system" "switch-generation"
generation-number)))
(lambda (status captured)
(cond
((zero? status)
@@ -563,15 +331,12 @@ prepare so a missing substitute cannot stall the switch phase."
(else
(error-frame "switch_failed"
"guix system switch-generation failed"
`(("exit_status" . ,status)
("output_tail" . ,(captured-output-tail captured))))
`(("exit_status" . ,status)))
(exit status))))))
(define (usage)
(format (current-error-port)
"Usage: tribes-guix-helper catalog~%")
(format (current-error-port)
" | pull <channels-file>~%")
"Usage: tribes-guix-helper pull <channels-file>~%")
(format (current-error-port)
" | build <config-file> <system-profile-link> <root-link>~%")
(format (current-error-port)
@@ -582,7 +347,6 @@ prepare so a missing substitute cannot stall the switch phase."
;; LC_ALL=C keeps Guix error output stable for fallback parsing.
(setenv "LC_ALL" "C")
(match args
(("catalog") (cmd-catalog))
(("pull" channels-file) (cmd-pull channels-file))
(("build" config-file system-profile-link root-link)
(cmd-build config-file system-profile-link root-link))
tribes/deploy/http.scm
-11
View File
@@ -78,17 +78,6 @@
. ,(lambda (_request _body)
(call-with-values (lambda () (handle-generations state))
json-response)))
((GET . "/v1/plugins/catalog")
. ,(lambda (_request _body)
(call-with-values (lambda () (handle-plugin-catalog state helper))
json-response)))
((POST . "/v1/channels/updates")
. ,(lambda (request body)
(with-json-body cfg request body
(lambda (payload)
(call-with-values
(lambda () (handle-channel-updates payload))
json-response)))))
((POST . "/v1/deployment/resolve")
. ,(lambda (request body)
(with-json-body cfg request body
tribes/deploy/operations.scm
+9 -194
View File
@@ -2,14 +2,12 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (tribes deploy config)
#:use-module (tribes deploy current-guix)
#:use-module (tribes deploy guix-helper)
#:use-module (tribes deploy json)
#:use-module (tribes deploy plan)
#:use-module (tribes deploy state)
#:use-module (tribes deploy worker)
#:export (resolve-deployment
plugin-catalog-payload
list-generations-payload
abort-prepare!
current-status
@@ -100,19 +98,6 @@
("ok" . #t)
("plan" . ,result))))))
(define (plugin-catalog-payload state helper)
(let ((result ((helper-backend-catalog helper)
(state-store-config state)
(lambda (_frame) #t))))
(if (helper-result-ok? result)
(let ((catalog (json-ref (helper-result-payload result) "catalog")))
(values 200
`(("schemaVersion" . "2")
("ok" . #t)
("catalog" . ,catalog)
("plugins" . ,(or (json-ref catalog "plugins") #())))))
(values 500 (from-helper-failure result)))))
;; ---------------------------------------------------------------------------
;; status / generations — flat reads.
@@ -126,7 +111,6 @@
(define (list-generations-payload state)
`(("schemaVersion" . "2")
("ok" . #t)
("current_channels" . ,(current-system-channel-pins))
("generations" . ,(state-store-read-generations state))))
(define (abort-prepare! state worker)
@@ -143,159 +127,12 @@
;; ON-FRAME is called for every helper frame so the worker snapshot can be
;; refreshed in real time.
(define* (record-host-config-update! state plugins #:key (disabled-plugins '()))
(define (record-host-config-update! state plugins)
(let* ((host-config-file (deploy-config-host-config-file
(state-store-config state)))
(host-config (read-json-file host-config-file))
(updated (host-config-with-plugins host-config plugins
#:disabled-plugins disabled-plugins)))
(updated (host-config-with-plugins host-config plugins)))
(atomic-write-json-file host-config-file updated)))
(define (channel-key channel)
(or (json-ref channel "url")
(json-ref channel "name")
(json-ref channel "channel_id")))
(define (matching-channel channel candidates)
(let ((key (channel-key channel)))
(find (lambda (candidate)
(or (and (json-ref channel "url")
(equal? (json-ref channel "url")
(json-ref candidate "url")))
(and key
(equal? key (channel-key candidate)))))
candidates)))
(define (resolve-pulled-channel-pins plan pulled-channels)
(let ((planned (or (and plan (plan-resolved-channels plan)) '()))
(pulled (cond
((vector? pulled-channels) (vector->list pulled-channels))
((list? pulled-channels) pulled-channels)
(else '()))))
(map (lambda (channel)
(let ((pulled-channel (matching-channel channel pulled)))
(if (and pulled-channel (json-ref pulled-channel "commit"))
(assoc-set channel "commit" (json-ref pulled-channel "commit"))
channel)))
planned)))
(define (channel-field channel key fallback)
(or (json-ref channel key) fallback))
(define (write-scheme-string value port)
(write (or value "") port))
(define (write-channel channel port)
(let* ((name (channel-name channel))
(url (channel-field channel "url" ""))
(branch (channel-field channel "branch" "master"))
(commit (channel-field channel "commit" ""))
(introduction (or (json-ref channel "introduction") '()))
(introduction-commit (json-ref introduction "commit"))
(fingerprint (json-ref introduction "fingerprint")))
(display " (channel\n" port)
(format port " (name '~a)\n" (string->symbol name))
(display " (url " port) (write-scheme-string url port) (display ")\n" port)
(display " (branch " port) (write-scheme-string branch port) (display ")\n" port)
(when (and (string? commit) (not (string=? commit "")))
(display " (commit " port) (write-scheme-string commit port) (display ")\n" port))
(when (and (string? introduction-commit)
(not (string=? introduction-commit ""))
(string? fingerprint)
(not (string=? fingerprint "")))
(display " (introduction\n" port)
(display " (make-channel-introduction\n" port)
(display " " port) (write-scheme-string introduction-commit port) (newline port)
(display " (openpgp-fingerprint\n" port)
(display " " port) (write-scheme-string fingerprint port) (display ")))\n" port))
(display " )" port)))
(define (channel-name channel)
(channel-field channel "name"
(channel-field channel "channel_id" "tribes")))
(define (channel-expression-name expression)
(match expression
(('channel fields ...)
(match (find (match-lambda
(('name _value) #t)
(_ #f))
fields)
(('name ('quote name)) (symbol->string name))
(('name (? symbol? name)) (symbol->string name))
(('name (? string? name)) name)
(_ #f)))
(_ #f)))
(define (read-channel-expressions path)
(catch #t
(lambda ()
(call-with-input-file path
(lambda (port)
(match (read port)
(('list channels ...) channels)
(_ '())))))
(lambda _ '())))
(define (channel-expression-field expression field-name)
(match expression
(('channel fields ...)
(match (find (match-lambda
(((? symbol? name) _value) (eq? name field-name))
(_ #f))
fields)
((_ ('quote value)) (and (symbol? value) (symbol->string value)))
((_ (? symbol? value)) (symbol->string value))
((_ (? string? value)) value)
((_ #f) #f)
(_ #f)))
(_ #f)))
(define (channel-expression->pin expression)
`(("name" . ,(channel-expression-field expression 'name))
("url" . ,(channel-expression-field expression 'url))
("branch" . ,(channel-expression-field expression 'branch))
("commit" . ,(channel-expression-field expression 'commit))))
(define (current-system-channel-pins)
(let ((channels-file (current-system-channels-file)))
(if channels-file
(filter (lambda (pin) (json-ref pin "commit"))
(map channel-expression->pin
(read-channel-expressions channels-file)))
'())))
(define (preserved-channel-expressions path channels)
(let ((channel-names (map channel-name channels)))
(if (member "guix" channel-names)
'()
(filter (lambda (channel)
(equal? (channel-expression-name channel) "guix"))
(read-channel-expressions path)))))
(define (write-channel-expression channel port)
(display " " port)
(write channel port))
(define (ensure-directory path)
(unless (or (string=? path "/") (file-exists? path))
(ensure-directory (dirname path))
(mkdir path)))
(define (write-plan-channels! config plan)
(let* ((channels (or (and plan (plan-resolved-channels plan)) '()))
(path (deploy-config-channels-file config))
(preserved-channels (preserved-channel-expressions path channels)))
(ensure-directory (dirname path))
(call-with-output-file path
(lambda (port)
(display ";; Auto-generated by Tribes local-control from SystemTarget channels.\n" port)
(display "(list\n" port)
(for-each
(lambda (channel)
(write-channel-expression channel port)
(newline port))
preserved-channels)
(for-each
(lambda (channel)
(write-channel channel port)
(newline port))
channels)
(display ")\n" port)))))
(define (selected-system-path state)
(state-store-selected-system-path state))
@@ -304,16 +141,14 @@
(state-store-running-system-path state))
(define* (prepare-plugins! state helper plugins plan-hash-value on-frame
#:key plan (pull-required? #t))
#:key (pull-required? #t))
(let* ((cfg (state-store-config state))
(disabled-plugins (if plan (plan-disabled-plugins plan) '()))
(existing (state-store-find-generation-by-plan-hash state plan-hash-value)))
(state-store-write-status! state "running"
#:plugins plugins
#:plan-hash plan-hash-value
#:phase "running")
(record-host-config-update! state plugins
#:disabled-plugins disabled-plugins)
(record-host-config-update! state plugins)
(cond
;; Idempotency: if we already built this plan and the store path still
;; exists, just re-register the GC root and report ready.
@@ -338,7 +173,6 @@
(let ((pull-result
(if pull-required?
(begin
(when plan (write-plan-channels! cfg plan))
(on-frame `(("event" . "phase") ("phase" . "pulling")))
((helper-backend-pull helper) cfg on-frame))
#f)))
@@ -393,14 +227,7 @@
#:generation-number gen-number
#:built-at #f
#:gc-pinned #t
#:plugins plugins
#:disabled-plugins disabled-plugins
#:channels (and plan
(resolve-pulled-channel-pins
plan
(and pull-result
(json-ref (helper-result-payload pull-result)
"channels")))))
#:plugins plugins)
(state-store-write-status! state "completed"
#:plugins plugins
#:plan-hash plan-hash-value
@@ -457,11 +284,7 @@
#:activated-at #f
#:gc-pinned #t
#:plugins
(or (json-string-list-ref existing "plugins") '())
#:disabled-plugins
(or (json-string-list-ref existing "disabled_plugins") '())
#:channels
(or (json-list-ref existing "channels") '()))
(or (json-string-list-ref existing "plugins") '()))
(state-store-activate-generation! state selected-store-path)
(state-store-write-status! state "completed"
#:plan-hash plan-hash-value
@@ -532,10 +355,7 @@
#:code "plugin_migration_rollback_failed"
#:store-path store-path)
(let* ((target-plugins (or (json-string-list-ref generation "plugins") '()))
(target-disabled-plugins
(or (json-string-list-ref generation "disabled_plugins") '()))
(_ (record-host-config-update! state target-plugins
#:disabled-plugins target-disabled-plugins))
(_ (record-host-config-update! state target-plugins))
(gen-number (json-ref generation "generation_number"))
(switch-result ((helper-backend-switch helper) cfg gen-number on-frame)))
(cond
@@ -558,10 +378,7 @@
#:built-at (json-ref generation "built_at")
#:activated-at #f
#:gc-pinned #t
#:plugins target-plugins
#:disabled-plugins target-disabled-plugins
#:channels
(or (json-list-ref generation "channels") '()))
#:plugins target-plugins)
(state-store-activate-generation! state active-store-path)
(state-store-write-status! state "completed"
#:store-path active-store-path
@@ -594,7 +411,6 @@
(let* ((plan-hash-value (plan-hash plan))
(prepared (prepare-plugins! state helper (plan-plugins plan)
plan-hash-value on-frame
#:plan plan
#:pull-required?
(plan-requires-pull? plan))))
(if (equal? (json-ref prepared "ok") #t)
@@ -623,7 +439,7 @@
snapshot)))
(define* (submit-prepare! state worker helper plugins plan-hash-value
#:key plan (pull-required? #t))
#:key (pull-required? #t))
(call-with-values
(lambda ()
(worker-submit!
@@ -636,7 +452,6 @@
(%make-job-result-from-payload
(prepare-plugins! state helper plugins
plan-hash-value on-frame
#:plan plan
#:pull-required? pull-required?))))))
(lambda (status snapshot)
(case status
tribes/deploy/plan.scm
+3 -35
View File
@@ -10,9 +10,7 @@
deployment-request-plugins
host-config-with-plugins
system-target-plugin-names
system-target-disabled-plugin-names
plan-plugins
plan-disabled-plugins
plan-resolved-channels
plan-requires-pull?
plan-hash
@@ -67,8 +65,7 @@
"plugins")))))
(or plugins '())))
(define* (host-config-with-plugins host-config plugin-names
#:key (disabled-plugins '()))
(define (host-config-with-plugins host-config plugin-names)
(unless (json-object? host-config)
(error "host config must be a JSON object"))
(let ((tribes-config (json-ref host-config "tribes")))
@@ -76,9 +73,7 @@
(error "host config is missing tribes object"))
(assoc-set host-config
"tribes"
(assoc-set
(assoc-set tribes-config "plugins" plugin-names)
"disabledPlugins" disabled-plugins))))
(assoc-set tribes-config "plugins" plugin-names))))
(define (system-target-plugin-names target)
(let ((plugins (or (json-list-ref target "plugins") '())))
@@ -86,18 +81,7 @@
(filter-map
(lambda (plugin)
(and (json-object? plugin)
(let ((name (plugin-entry-name plugin)))
(and (string? name) name))))
plugins)
string<?)))
(define (system-target-disabled-plugin-names target)
(let ((plugins (or (json-list-ref target "plugins") '())))
(sort
(filter-map
(lambda (plugin)
(and (json-object? plugin)
(not (plugin-entry-enabled? plugin))
(plugin-entry-enabled? plugin)
(let ((name (plugin-entry-name plugin)))
(and (string? name) name))))
plugins)
@@ -117,22 +101,6 @@
resolved)
string<?)))
(define (plan-disabled-plugins plan)
(let ((resolved (or (json-list-ref plan "resolved_plugins")
(json-list-ref plan "resolvedPlugins")
'())))
(sort
(filter-map
(lambda (plugin)
(and (json-object? plugin)
(let ((enabled-entry (assoc "enabled" plugin)))
(and enabled-entry (equal? (cdr enabled-entry) #f)))
(let ((name (or (json-ref plugin "name")
(plugin-entry-name plugin))))
(and (string? name) name))))
resolved)
string<?)))
(define (plan-resolved-channels plan)
(or (json-list-ref plan "resolved_channels")
(json-list-ref plan "resolvedChannels")))
tribes/deploy/state.scm
+2 -6
View File
@@ -291,9 +291,7 @@ predate the local-control deployment state and therefore may not appear in
built-at
activated-at
(gc-pinned #t)
(plugins #f)
(disabled-plugins #f)
(channels #f))
(plugins #f))
(let ((generation
`(("store_path" . ,store-path)
("generation_number" . ,generation-number)
@@ -302,9 +300,7 @@ predate the local-control deployment state and therefore may not appear in
("gc_pinned" . ,gc-pinned)
("built_at" . ,built-at)
("activated_at" . ,activated-at)
,@(if plugins `(("plugins" . ,plugins)) '())
,@(if disabled-plugins `(("disabled_plugins" . ,disabled-plugins)) '())
,@(if channels `(("channels" . ,channels)) '()))))
,@(if plugins `(("plugins" . ,plugins)) '()))))
(state-store-upsert-generation! store generation)
(when (string=? generation-status "active")
(state-store-activate-generation! store store-path))
tribes/packages/cli.scm
+7 -7
View File
@@ -76,14 +76,14 @@
(arguments
(list
#:source-directory "."
;; Skip compilation of channel-eval-only modules: (tribes ci …),
;; (tribes services …), (tribes system …), (tribes config …), and
;; the package definitions other than the runtime-relevant {plugins,
;; mix, source, otp}. (tribes packages cli) — this very file — is
;; also skipped: channel users reach it via the git checkout, not via
;; the package output.
;; Skip compilation of channel-eval-only modules: (tribes services …)
;; / (tribes system …) / (tribes config …) and the package
;; definitions other than the runtime-relevant {plugins, mix, source,
;; otp}. (tribes packages cli) — this very file — is also skipped:
;; channel users reach it via the git checkout, not via the package
;; output.
#:not-compiled-file-regexp
"tribes/(ci/|services/|system/|config/|packages/(cli|go|release|terminals|web)\\.scm)"
"tribes/(services/|system/|config/|packages/(cli|go|release|terminals|web)\\.scm)"
#:phases
#~(modify-phases %standard-phases
;; Default 'unpack would cd into the source directory and flatten
tribes/packages/cloud.scm
-78
View File
@@ -1,78 +0,0 @@
(define-module (tribes packages cloud)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages)
#:export (ovhcloud-cli
scaleway-cli))
(define-public scaleway-cli
(package
(name "scaleway-cli")
(version "2.56.1")
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/scaleway/scaleway-cli/releases/download/v"
version "/scaleway-cli_" version "_linux_amd64"))
(sha256
(base32 "0282hhpz524fvs7h89f4x07nhm7xkhqc53fd3zr47fk8yz8519fy"))))
(build-system trivial-build-system)
(arguments
(list
#:modules '((guix build utils))
#:builder
#~(begin
(use-modules (guix build utils))
(let* ((bin (string-append #$output "/bin"))
(scw (string-append bin "/scw")))
(mkdir-p bin)
(copy-file #$source scw)
(chmod scw #o555)
(symlink "scw" (string-append bin "/scaleway-cli"))))))
(home-page "https://github.com/scaleway/scaleway-cli")
(synopsis "Command-line interface for Scaleway")
(description
"Scaleway CLI is a command-line interface for interacting with Scaleway
cloud services. This package installs the @command{scw} binary.")
(supported-systems '("x86_64-linux"))
(license license:asl2.0)))
(define-public ovhcloud-cli
(package
(name "ovhcloud-cli")
(version "0.12.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/ovh/ovhcloud-cli/releases/download/v"
version "/ovhcloud-cli_Linux_x86_64.tar.gz"))
(sha256
(base32 "19jypxzzjlshqd0391b01a81d2wckfxi20sz7h29alm59j6j9jsm"))))
(build-system trivial-build-system)
(arguments
(list
#:modules '((guix build utils))
#:builder
#~(begin
(use-modules (guix build utils))
(let ((bin (string-append #$output "/bin")))
(setenv "PATH" #$(file-append gzip "/bin"))
(mkdir-p bin)
(invoke #$(file-append tar "/bin/tar")
"xzf" #$source "ovhcloud")
(install-file "ovhcloud" bin)
(chmod (string-append bin "/ovhcloud") #o555)))))
(native-inputs (list gzip tar))
(home-page "https://github.com/ovh/ovhcloud-cli")
(synopsis "Command-line interface for OVHcloud")
(description
"OVHcloud CLI is a command-line interface for interacting with OVHcloud
services. This package installs the @command{ovhcloud} binary.")
(supported-systems '("x86_64-linux"))
(license license:asl2.0)))
tribes/packages/devtools.scm
-2339
View File
File diff suppressed because it is too large Load Diff
tribes/packages/docker.scm
-73
View File
@@ -1,73 +0,0 @@
(define-module (tribes packages docker)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system trivial)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (gnu packages bash)
#:use-module (gnu packages base)
#:use-module (gnu packages certs)
#:use-module (gnu packages gawk)
#:use-module (gnu packages nss)
#:use-module (tribes packages source)
#:export (tribes-debug-docker-package
tribes-debug-package))
(define tribes-debug-package
(tribes-source-package tribes-upstream-source
#:name "tribes-debug"
#:admin-debug-methods? #t))
(define tribes-debug-docker-package
(package
(name "tribes-debug-docker-entrypoint")
(version (package-version tribes-debug-package))
(source #f)
(build-system trivial-build-system)
(arguments
(list
#:builder
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(let ((bin (string-append #$output "/bin")))
(mkdir-p bin)
(call-with-output-file (string-append bin "/tribes")
(lambda (port)
(display
(string-append
"#!" #$(file-append bash-minimal "/bin/sh") "\n"
"set -eu\n"
#$(file-append coreutils "/bin/mkdir") " -p /tmp\n"
"export HOME=\"${HOME:-/tmp}\"\n"
"export LANG=\"${LANG:-C.UTF-8}\"\n"
"export LC_ALL=\"${LC_ALL:-C.UTF-8}\"\n"
"export PATH=\""
#$(file-append coreutils "/bin") ":"
#$(file-append grep "/bin") ":"
#$(file-append sed "/bin") ":"
#$(file-append gawk "/bin")
"${PATH:+:$PATH}\"\n"
"export MIX_ENV=\"${MIX_ENV:-prod}\"\n"
"export PHX_SERVER=\"${PHX_SERVER:-true}\"\n"
"export PORT=\"${PORT:-4000}\"\n"
"export RELEASE_DISTRIBUTION=\"${RELEASE_DISTRIBUTION:-none}\"\n"
"export RELEASE_MODE=\"${RELEASE_MODE:-interactive}\"\n"
"export RELEASE_COOKIE=\"${RELEASE_COOKIE:-tribes-e2e-cookie}\"\n"
"export TRIBES_PLUGIN_DIR=\"${TRIBES_PLUGIN_DIR:-"
#$tribes-debug-package
"/plugins}\"\n"
"export SSL_CERT_FILE=\"${SSL_CERT_FILE:-"
#$(file-append nss-certs "/etc/ssl/certs/ca-certificates.crt")
"}\"\n"
"exec " #$tribes-debug-package "/bin/tribes-app \"$@\"\n")
port)))
(chmod (string-append bin "/tribes") #o755))))))
(inputs (list bash-minimal coreutils gawk grep nss-certs sed
tribes-debug-package))
(home-page "https://git.teralink.net/tribes/guix-tribes.git")
(synopsis "Docker entrypoint for the Tribes debug build")
(description
"Small wrapper package used by guix pack to build the debug Tribes Docker
image used by e2e tests.")
(license license:asl2.0)))
tribes/packages/go.scm
+5 -9
View File
@@ -21,7 +21,7 @@
name
version
sha256
(go go-1.26)
(go go)
(mod-root ".")
(delete-vendor? #t)
goproxy)
@@ -118,13 +118,9 @@ SOURCE."
(if (string=? #$mod-root ".")
source-dir
(string-append source-dir "/" #$mod-root))
(if #$delete-vendor?
(begin
(when (file-exists? "vendor")
(delete-file-recursively "vendor"))
(invoke "go" "mod" "vendor"))
(unless (file-exists? "vendor")
(error "source does not contain a vendor directory")))
(when (and #$delete-vendor? (file-exists? "vendor"))
(delete-file-recursively "vendor"))
(invoke "go" "mod" "vendor")
(mkdir-p out)
(copy-recursively "vendor" out #:keep-mtime? #t))))
#:options
@@ -143,7 +139,7 @@ SOURCE."
description
license
vendor-sha256
(go go-1.26)
(go go)
(mod-root ".")
(sub-packages '("."))
(build-flags '("-trimpath"))
tribes/packages/kernel.scm
-167
View File
@@ -1,167 +0,0 @@
(define-module (tribes packages kernel)
#:use-module (gnu packages linux)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix utils)
#:export (tribes-linux))
(define %tribes-linux-hardening-configs
'(;; Fail closed when the kernel detects internal data-structure corruption
;; instead of trying to continue in an unknown state. For Tribes hosts,
;; availability is handled at the node/deployment level; a loud crash is
;; preferable to silent memory-corruption persistence. This also selects
;; CONFIG_LIST_HARDENED, which provides the cheap linked-list consistency
;; checks we want without the heavier CONFIG_DEBUG_LIST debug machinery.
"CONFIG_BUG_ON_DATA_CORRUPTION=y"
;; Split general kmalloc allocations across randomized slab caches. This
;; raises the cost of heap-spray style kernel exploits while preserving the
;; broad-driver VPS/bare-metal kernel shape; upstream documents the cost as
;; limited memory/CPU overhead, which is acceptable for our server targets.
"CONFIG_RANDOM_KMALLOC_CACHES=y"
;; Compile in software page poisoning so operators can enable
;; `page_poison=1' for suspicious hosts or higher-assurance deployments.
;; It is not active by default, so the normal runtime cost is avoided; Guix
;; already enables init-on-alloc by default, and this gives us an optional
;; stronger freed-page check/sanitization mode when needed.
"CONFIG_PAGE_POISONING=y"
;; Allow CET shadow stacks for userspace on x86_64 CPUs that support them.
;; Applications must opt in, so old userspace is not forced into a new ABI,
;; but hardened runtimes can gain return-address protection against ROP.
"CONFIG_X86_USER_SHADOW_STACK=y"))
(define %tribes-linux-disabled-options
'(;; Headless/text-console targets: keep VGA/framebuffer consoles, but drop
;; DRM/KMS GPU drivers and display acceleration stacks.
"DRM"
;; No audio output/input stack on Tribes server deployments.
"SOUND"
;; Drop webcams, capture cards, TV/radio tuners, SDR receivers, and remote
;; controls. This keeps storage, networking, USB host, and Wi-Fi intact.
"MEDIA_SUPPORT"
"RC_CORE"
;; Keep ordinary AT/USB keyboards and mice, but drop uncommon local-console
;; input devices that bring many drivers.
"INPUT_JOYSTICK"
"INPUT_TABLET"
"INPUT_TOUCHSCREEN"
"HID_WACOM"
"HID_MULTITOUCH"
;; Targets are USB hosts, not USB devices; USB-IP is also unnecessary for
;; install/operation. Keep USB host, USB storage, HID, and Type-C support.
"USB_GADGET"
"USBIP_CORE"
;; Legacy or non-target interconnects/protocols.
"FIREWIRE"
"BT"
"NFC"
"CAN"
"HAMRADIO"
"ATM"
"ARCNET"
"PHONET"
"INFINIBAND"
;; Non-target network protocols and in-kernel load-balancing stacks. Keep
;; ordinary TCP/UDP/IP, bridge, nftables/netfilter, WireGuard, and Wi-Fi.
"IP_VS"
"ATALK"
"X25"
"LAPB"
"RDS"
"TIPC"
"IP_SCTP"
"AF_KCM"
"MPTCP"
"LLC2"
;; Drop niche overlay/mesh/IoT stacks while keeping Ethernet, Wi-Fi,
;; bridge, VLANs, nftables/netfilter, tunnels, and WireGuard.
"OPENVSWITCH"
"BATMAN_ADV"
"IEEE802154"
"6LOWPAN"
"CAIF"
"MPLS"
;; Cluster/distributed filesystems are not part of the installer or Tribes
;; node runtime. Keep local Linux filesystems and NFS/CIFS available.
"CEPH_FS"
"GFS2_FS"
"OCFS2_FS"
"AFS_FS"
"CODA_FS"
;; Rare local filesystems for our server/text-console targets. Keep ext4,
;; XFS, Btrfs, F2FS, VFAT, exFAT, ISO/UDF, NFS, CIFS, FUSE, and overlayfs.
"JFS_FS"
"NILFS2_FS"
"ZONEFS_FS"
;; Keep local NVMe PCI support, but drop NVMe-over-fabrics clients and
;; target-mode support.
"NVME_FC"
"NVME_TCP"
"NVME_TARGET"
;; Odd local peripherals unrelated to text-console server operation.
"MACINTOSH_DRIVERS"
"FIREWIRE_NOSY"
"USB_APPLEDISPLAY"
"USB_ISIGHTFW"
"USB_IDMOUSE"))
(define tribes-linux/hardened
(customize-linux
#:name "tribes-linux"
#:linux linux-libre
#:extra-version "tribes"
#:configs %tribes-linux-hardening-configs))
(define tribes-linux
(package
(inherit tribes-linux/hardened)
(arguments
(substitute-keyword-arguments (package-arguments tribes-linux/hardened)
((#:phases phases)
#~(modify-phases #$phases
(add-after 'configure 'apply-tribes-slim-config
(lambda _
(use-modules (ice-9 rdelim)
(srfi srfi-1))
(define disabled-options
'#$%tribes-linux-disabled-options)
(define (disabled-line option)
(string-append "# CONFIG_" option " is not set"))
(define config-lines
(call-with-input-file ".config"
(lambda (port)
(let loop ((lines '()))
(let ((line (read-line port)))
(if (eof-object? line)
(reverse lines)
(loop (cons line lines))))))))
(for-each (lambda (option)
(invoke "scripts/config" "--disable" option))
disabled-options)
(invoke "make" "olddefconfig")
(set! config-lines
(call-with-input-file ".config"
(lambda (port)
(let loop ((lines '()))
(let ((line (read-line port)))
(if (eof-object? line)
(reverse lines)
(loop (cons line lines))))))))
(for-each
(lambda (option)
(unless (member (disabled-line option) config-lines)
(error "failed to disable kernel option" option)))
disabled-options)))))))))
tribes/packages/logging.scm
-146
View File
@@ -1,146 +0,0 @@
(define-module (tribes packages logging)
#:use-module (gnu packages autotools)
#:use-module (gnu packages bison)
#:use-module (gnu packages flex)
#:use-module (gnu packages glib)
#:use-module (gnu packages gperf)
#:use-module (gnu packages linux)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages tls)
#:use-module (gnu packages web)
#:use-module (gnu packages version-control)
#:use-module (gnu packages base)
#:use-module (guix build-system gnu)
#:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix packages))
(define-public syslog-ng-minimal
(package
(name "syslog-ng-minimal")
(version "4.10.2")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/syslog-ng/syslog-ng")
(commit (string-append "syslog-ng-" version))
(recursive? #t)))
(file-name (git-file-name name version))
(sha256
(base32 "0srqipyqq8xzcj8dgb391b8jdhs2nf6cnviz8hbkipjnj1w86il5"))))
(build-system gnu-build-system)
(arguments
(list
#:tests? #f
#:configure-flags
#~(list
"--disable-fast-install"
"--enable-dynamic-linking"
"--with-ivykis=internal"
"--with-jsonc=system"
"--enable-json=yes"
"--enable-ipv6"
"--enable-linux-caps"
"--disable-python"
"--disable-python-modules"
"--with-python-packages=none"
"--disable-java"
"--disable-java-modules"
"--disable-systemd"
"--disable-http"
"--disable-smtp"
"--disable-mongodb"
"--disable-amqp"
"--disable-stomp"
"--disable-grpc"
"--disable-kafka"
"--disable-afsnmp"
"--disable-geoip2"
"--disable-sql"
"--disable-ebpf"
"--disable-spoof-source"
"--disable-tcp-wrapper"
"--disable-native"
"--disable-manpages"
"--disable-example-modules"
"--without-compile-date")
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'bootstrap
(lambda _
(substitute* "scripts/version.sh"
(("/bin/sh") (which "sh")))
(invoke "autoreconf" "-vfi")))
(add-after 'configure 'fix-internal-ivykis-makefile
(lambda _
(substitute* "Makefile"
(((string-append "-L\\$\\(top_builddir\\)/lib/ivykis/src "
"-livykis"))
(string-append "-L$(top_builddir)/lib/ivykis/src/.libs "
"-livykis")))))
(add-after 'build 'fix-internal-ivykis-relink
(lambda _
;; The internal ivykis submodule is built in-tree, but libtool's
;; install-time relink only searches lib/ivykis/src. Point it at
;; the actual build output directory so -livykis can be resolved
;; without adding a separate runtime input.
(for-each (lambda (file)
(substitute* file
(("-L\\./lib/ivykis/src -livykis")
"-L./lib/ivykis/src/.libs -livykis")))
(find-files "." "\\.la$"))))
(add-after 'install 'install-internal-ivykis
(lambda* (#:key outputs #:allow-other-keys)
;; syslog-ng links against the internal ivykis shared library, but
;; upstream's install target does not install it when used as a
;; bundled dependency.
(let* ((libdir (string-append (assoc-ref outputs "out") "/lib"))
(library (car (find-files "lib/ivykis/src/.libs"
"^libivykis\\.so\\.0\\.[0-9]+\\.[0-9]+$")))
(basename (basename library)))
(install-file library libdir)
(with-directory-excursion libdir
(symlink basename "libivykis.so.0")
(symlink basename "libivykis.so")))))
(add-after 'install-internal-ivykis 'remove-python-runtime-hooks
(lambda* (#:key outputs #:allow-other-keys)
;; Python is only a native build tool here. Drop the helper and
;; SCL snippets that would otherwise retain a runtime Python
;; reference despite --disable-python.
(let ((out (assoc-ref outputs "out")))
(delete-file (string-append out "/bin/syslog-ng-update-virtualenv"))
(delete-file (string-append out "/share/syslog-ng/tools/merge-grammar.py"))
(delete-file-recursively
(string-append out "/share/syslog-ng/include/scl/python"))))))))
(native-inputs
(list autoconf
autoconf-archive
automake
bison
flex
gperf
libtool
perl
pkg-config
python
which))
(inputs
(list glib
json-c
libcap
openssl
pcre2
util-linux))
(home-page "https://www.syslog-ng.com/")
(synopsis "System logging daemon")
(description
"syslog-ng is a syslog daemon with flexible sources, filters, parsers, and
file destinations. This Tribes package intentionally omits Python, Java,
systemd journal, database, messaging, cloud, and other remote destination
modules used outside the local node logging path.")
(license (list license:gpl2+ license:lgpl2.1+))))
tribes/packages/mix.scm
+29 -45
View File
@@ -8,12 +8,12 @@
#:use-module (gnu packages bash)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages elixir)
#:use-module (gnu packages erlang)
#:use-module (gnu packages node)
#:use-module (gnu packages certs)
#:use-module (gnu packages nss)
#:use-module (gnu packages version-control)
#:use-module (tribes packages otp)
#:export (fetch-mix-deps
fetch-npm-deps
mix-release-package))
@@ -44,14 +44,14 @@ SOURCE according to mix.lock."
(string-append work "/ca-certificates.crt"))
(define hex-lib-dir
(string-append
#$(file-append elixir-hex "/lib/elixir/1.19")
#$(file-append elixir-hex-otp28 "/lib/elixir/1.19")
":"
#$(file-append elixir-hex "/lib/elixir/1.18")))
#$(file-append elixir-hex-otp28 "/lib/elixir/1.18")))
(define path
(string-join
(list #$(file-append elixir "/bin")
#$(file-append elixir-hex "/bin")
#$(file-append rebar3 "/bin")
(list #$(file-append elixir-otp28 "/bin")
#$(file-append elixir-hex-otp28 "/bin")
#$(file-append rebar3-otp28 "/bin")
#$(file-append bash-minimal "/bin")
#$(file-append coreutils "/bin")
#$(file-append findutils "/bin")
@@ -82,7 +82,7 @@ SOURCE according to mix.lock."
(setenv "MIX_ENV" #$mix-env)
(setenv "MIX_TARGET" #$mix-target)
(setenv "MIX_OS_CONCURRENCY_LOCK" "0")
(setenv "MIX_REBAR3" #$(file-append rebar3 "/bin/rebar3"))
(setenv "MIX_REBAR3" #$(file-append rebar3-otp28 "/bin/rebar3"))
(setenv "REBAR_GLOBAL_CONFIG_DIR" (string-append work "/rebar3"))
(setenv "REBAR_CACHE_DIR" (string-append work "/rebar3.cache"))
(setenv "LANG" "C.UTF-8")
@@ -110,33 +110,17 @@ SOURCE according to mix.lock."
(mkdir-p out)
(copy-recursively deps-dir out #:follow-symlinks? #t)
;; Keep SCM deps reproducible without making Mix think the checkout is
;; stale. Mix.SCM.Git checks both .git/HEAD and remote.origin.url
;; during later offline builds, so preserve a tiny valid Git directory
;; with just those facts instead of the full fetched repository.
(invoke #$(file-append bash-minimal "/bin/sh")
"-c"
(string-append
"set -eu\n"
"find \"$1\" -type d -name .git -prune -print | "
"while IFS= read -r git_dir; do\n"
" origin=$(git --git-dir=\"$git_dir\" config remote.origin.url || true)\n"
" head=$(cat \"$git_dir/HEAD\")\n"
" rm -rf \"$git_dir\"\n"
" mkdir -p \"$git_dir/objects\" \"$git_dir/refs\"\n"
" printf '%s\\n' \"$head\" > \"$git_dir/HEAD\"\n"
" if [ -n \"$origin\" ]; then\n"
" git config --file \"$git_dir/config\" "
"core.repositoryformatversion 0\n"
" git config --file \"$git_dir/config\" "
"core.filemode false\n"
" git config --file \"$git_dir/config\" core.bare false\n"
" git config --file \"$git_dir/config\" "
"remote.origin.url \"$origin\"\n"
" fi\n"
"done")
"sanitize-git-deps"
out)))
;; Match nixpkgs fetchMixDeps behavior for SCM deps: keep .git/HEAD so
;; Mix still considers the checkout available, but discard the rest of
;; the repository metadata from the fixed-output tree.
(invoke #$(file-append findutils "/bin/find")
out
"-path" "*/.git/*"
"-a" "!" "-name" "HEAD"
"-exec"
#$(file-append coreutils "/bin/rm") "-rf"
"{}"
"+")))
#:options
`(#:hash ,(base32 sha256)
#:hash-algo sha256
@@ -280,16 +264,16 @@ MIX-FOD-DEPS as a pre-fetched dependency tree."
(string-append work "/ca-certificates.crt"))
(define hex-lib-dir
(string-append
#$(file-append elixir-hex "/lib/elixir/1.19")
#$(file-append elixir-hex-otp28 "/lib/elixir/1.19")
":"
#$(file-append elixir-hex "/lib/elixir/1.18")))
#$(file-append elixir-hex-otp28 "/lib/elixir/1.18")))
(define aclocal-path
(string-join (list #$@aclocal-dirs) ":"))
(define path
(string-join
(list #$(file-append elixir "/bin")
#$(file-append elixir-hex "/bin")
#$(file-append rebar3 "/bin")
(list #$(file-append elixir-otp28 "/bin")
#$(file-append elixir-hex-otp28 "/bin")
#$(file-append rebar3-otp28 "/bin")
#$(file-append bash-minimal "/bin")
#$(file-append coreutils "/bin")
#$(file-append findutils "/bin")
@@ -328,10 +312,10 @@ MIX-FOD-DEPS as a pre-fetched dependency tree."
(setenv "MIX_ENV" #$mix-env)
(setenv "MIX_TARGET" #$mix-target)
(setenv "MIX_OS_CONCURRENCY_LOCK" "0")
(setenv "MIX_OS_DEPS_COMPILE_PARTITION_COUNT" "6")
(setenv "MIX_OS_DEPS_COMPILE_PARTITION_COUNT" "4")
(setenv "HEX_OFFLINE" "1")
(setenv "MIX_REBAR" #$(file-append rebar3 "/bin/rebar3"))
(setenv "MIX_REBAR3" #$(file-append rebar3 "/bin/rebar3"))
(setenv "MIX_REBAR" #$(file-append rebar3-otp28 "/bin/rebar3"))
(setenv "MIX_REBAR3" #$(file-append rebar3-otp28 "/bin/rebar3"))
(setenv "REBAR_GLOBAL_CONFIG_DIR" (string-append work "/rebar3"))
(setenv "REBAR_CACHE_DIR" (string-append work "/rebar3.cache"))
(setenv "SHELL" #$(file-append bash-minimal "/bin/sh"))
@@ -386,9 +370,9 @@ MIX-FOD-DEPS as a pre-fetched dependency tree."
findutils
git-minimal
nss-certs
rebar3
elixir
elixir-hex)
rebar3-otp28
elixir-otp28
elixir-hex-otp28)
native-inputs))
(inputs inputs)
(arguments package-arguments)
tribes/packages/monitoring.scm
-80
View File
@@ -1,80 +0,0 @@
(define-module (tribes packages monitoring)
#:use-module (guix base32)
#:use-module (guix git-download)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (tribes packages go)
#:export (victoriametrics
vinyl-exporter))
(define-public victoriametrics
(build-go-module
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/VictoriaMetrics/VictoriaMetrics")
(commit "v1.143.0")))
(file-name (git-file-name "victoriametrics" "1.143.0"))
(sha256
(base32 "0c6nfnn1lqgdlm5ndacdj471sv7vyy9wv67p1477mmdb1x0nr4rb"))
(modules '((guix build utils)))
(snippet
#~(begin
(use-modules (guix build utils))
(for-each
(lambda (file)
(when (file-exists? file)
(delete-file file)))
'("app/vmui/packages/vmui/web/go.mod"
"app/vmui/packages/vmui/web/main.go"))
(substitute* "go.mod"
(("go 1\\.26\\.[0-9]+") "go 1.26"))
(substitute* "vendor/modules.txt"
(("go 1\\.26\\.[0-9]+") "go 1.26")))))
#:name "victoriametrics"
#:version "1.143.0"
#:vendor-sha256 "0kc1i2whi6fqlh4wzpyrm63s6f89wjbpnvc3hmvbvfj6z870h5ml"
#:delete-vendor? #f
#:sub-packages
'("./app/victoria-metrics"
"./app/vmagent"
"./app/vmbackup"
"./app/vmrestore"
"./app/vmctl")
#:ldflags
'("-s"
"-w"
"-X"
"github.com/VictoriaMetrics/VictoriaMetrics/lib/buildinfo.Version=1.143.0")
#:build-flags '("-trimpath" "-mod=vendor")
#:tests? #f
#:home-page "https://victoriametrics.com/"
#:synopsis "Time series database and monitoring tools"
#:description
"VictoriaMetrics is a time series database and monitoring toolkit. This
package includes the single-node server, vmagent, vmbackup, vmrestore, and
vmctl tools used by Tribes nodes."
#:license license:asl2.0))
(define-public vinyl-exporter
(build-go-module
(origin
(method git-fetch)
(uri (git-reference
(url "https://git.teralink.net/tribes/vinyl_exporter.git")
(commit "v0.2.0")))
(file-name (git-file-name "vinyl_exporter" "0.2.0"))
(sha256
(base32 "13y4kagxbdiwig4pcaqmdbj2prc8i2vpv63k420i9ql692ssm8xw")))
#:name "vinyl-exporter"
#:version "0.2.0"
#:vendor-sha256 "0a7wnm6qxw6ygnhb9jglkqlrm59az6v9spjy82wz8i6f9bdw2yrn"
#:sub-packages '("./cmd/vinyl_exporter")
#:ldflags '("-s" "-w")
#:home-page "https://git.teralink.net/tribes/vinyl_exporter"
#:synopsis "Prometheus exporter for Vinyl Cache"
#:description
"Vinyl Exporter exposes Vinyl Cache counters from vinylstat and HLS viewer
metrics derived from vinyllog."
#:license license:bsd-2))
tribes/packages/node.scm
-117
View File
@@ -1,117 +0,0 @@
(define-module (tribes packages node)
#:use-module (gnu packages compression)
#:use-module (gnu packages libevent)
#:use-module (gnu packages node)
#:use-module (gnu packages tls)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix packages)
#:use-module (guix utils)
#:export (node-24))
;; Node 24, used by Tribes development shells and by tools that declare a
;; Node 24 engine requirement.
;;
;; This is a version bump of upstream Guix's Node package. Node 24 requires a
;; newer libuv and Brotli than the pinned upstream package currently provides,
;; and its bundled llhttp must be kept because the older Guix replacement does
;; not match Node 24's llhttp ABI.
(define libuv-for-node-24
;; Match Node 24.16.0's bundled deps/uv version.
(package
(inherit libuv-for-node-lts)
(version "1.52.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://dist.libuv.org/dist/v" version
"/libuv-v" version ".tar.gz"))
(sha256
(base32
"1rzrrylgqyjcnjarph3r2h5i3cxjpx7j7svr4bkc0d73wswi3mb6"))))))
(define brotli-for-node-24
;; Node 24 requires brotli/shared_dictionary.h, introduced in 1.1.0.
(package
(inherit brotli)
(version "1.1.0")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/google/brotli")
(commit (string-append "v" version))))
(file-name (git-file-name "brotli" version))
(sha256
(base32
"0cvcq302wpjpd1a2cmxcp9a01lwvc2kkir8vsdb3x11djnxc0nsk"))))
(arguments
(substitute-keyword-arguments (package-arguments brotli)
((#:phases phases)
`(modify-phases ,phases
(delete 'rename-static-libraries)))))))
(define openssl-for-node-24
;; Node 24's Argon2 crypto APIs require OpenSSL with Argon2 KDF support.
;; Keep this local to the package so pinned Guix channels with OpenSSL 3.0
;; still produce an Argon2-capable Node.
(package
(inherit openssl)
(version "3.5.5")
(source
(origin
(inherit (package-source openssl))
(uri (list (string-append "https://www.openssl.org/source/openssl-"
version ".tar.gz")
(string-append "ftp://ftp.openssl.org/source/"
"openssl-" version ".tar.gz")
(string-append "ftp://ftp.openssl.org/source/old/3.5/"
"openssl-" version ".tar.gz")))
(sha256
(base32
"129aphl9yy5xd67cwacf000llkhpi1s8phmlhgws2rcb599r335j"))))))
(define-public node-24
(package
(inherit node)
(name "node")
(version "24.16.0")
(source
(origin
(inherit (package-source node))
(uri (string-append "https://nodejs.org/dist/v" version
"/node-v" version ".tar.gz"))
(sha256
(base32
"0j25mpkmdjn565swb6g4x7myd6k48vfsijnwdpx59jvn70pd64gm"))))
(arguments
(substitute-keyword-arguments (package-arguments node)
((#:phases phases)
`(modify-phases ,phases
(delete 'replace-llhttp-sources)
;; npm 11 ships tar under tar/dist/{esm,commonjs}/write-entry.js,
;; not tar/lib/.
(replace 'ignore-number-of-hardlinks
(lambda* (#:key outputs #:allow-other-keys)
(let ((nm (string-append (assoc-ref outputs "out")
"/lib/node_modules/npm/node_modules")))
(for-each
(lambda (variant)
(let ((file (string-append nm "/tar/dist/"
variant "/write-entry.js")))
(when (file-exists? file)
(substitute* file
(("this.stat.nlink > 1") "false")))))
'("esm" "commonjs")))))))))
(native-inputs
(modify-inputs (package-native-inputs node)
(replace "libuv" libuv-for-node-24)
(replace "brotli" brotli-for-node-24)
(replace "openssl" openssl-for-node-24)))
(inputs
(modify-inputs (package-inputs node)
(replace "libuv" libuv-for-node-24)
(replace "brotli" brotli-for-node-24)
(replace "openssl" openssl-for-node-24)
(delete "llhttp")))))
tribes/packages/npm.scm
-230
View File
@@ -1,230 +0,0 @@
(define-module (tribes packages npm)
#:use-module (guix base32)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix build-system trivial)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages compression)
#:use-module (gnu packages node)
#:use-module (gnu packages nss)
#:use-module (gnu packages version-control)
#:export (fetch-npm-deps
npm-binary-package))
;; ---------------------------------------------------------------------------
;; fetch-npm-deps
;;
;; Run `npm ci` in a network-enabled fixed-output derivation against
;; SOURCE/ASSETS-DIR (which must contain package.json + package-lock.json)
;; and return the resulting node_modules tree as a store item. Mirrors the
;; idea of `fetch-mix-deps` (tribes packages mix) for npm. Once the
;; #:sha256 is pinned, all subsequent builds are reproducible and offline.
(define* (fetch-npm-deps source
#:key
(name "npm-deps")
version
sha256
(assets-dir ".")
(omit-dev? #f)
(node node)
(setup-gexp #~(begin)))
"Return a fixed-output node_modules tree for SOURCE/ASSETS-DIR according
to package-lock.json."
(computed-file
(string-append name "-" version)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(define out #$output)
(define work (string-append (getcwd) "/build"))
(define app-dir (string-append work "/app"))
(define assets-subdir (string-append app-dir "/" #$assets-dir))
(define certs-dir
#$(file-append nss-certs "/etc/ssl/certs"))
(define cert-file
(string-append work "/ca-certificates.crt"))
(define path
(string-join
(list #$(file-append node "/bin")
#$(file-append bash-minimal "/bin")
#$(file-append coreutils "/bin")
#$(file-append findutils "/bin")
#$(file-append git-minimal "/bin")
#$(file-append gzip "/bin")
#$(file-append tar "/bin")
(or (getenv "PATH") ""))
":"))
(mkdir-p work)
(copy-recursively #+source app-dir #:follow-symlinks? #t)
(invoke #$(file-append coreutils "/bin/chmod") "-R" "u+w" app-dir)
(invoke #$(file-append bash-minimal "/bin/sh")
"-c"
(string-append
#$(file-append coreutils "/bin/cat")
" "
certs-dir
"/*.pem > "
cert-file))
(setenv "PATH" path)
(setenv "HOME" (string-append work "/home"))
(setenv "XDG_CACHE_HOME" (string-append work "/cache"))
(setenv "npm_config_cache" (string-append work "/npm-cache"))
(setenv "npm_config_userconfig" (string-append work "/npmrc"))
(setenv "SSL_CERT_DIR" certs-dir)
(setenv "SSL_CERT_FILE" cert-file)
(setenv "NODE_ENV" (if #$omit-dev? "production" "development"))
(mkdir-p (getenv "HOME"))
(mkdir-p (getenv "XDG_CACHE_HOME"))
(mkdir-p (getenv "npm_config_cache"))
#$setup-gexp
(with-directory-excursion assets-subdir
(apply invoke
`("npm" "ci"
,@(if #$omit-dev? '("--omit=dev") '("--include=dev"))
"--ignore-scripts"
"--no-audit"
"--no-fund")))
(mkdir-p out)
(copy-recursively (string-append assets-subdir "/node_modules")
out)))
#:options
`(#:hash ,(base32 sha256)
#:hash-algo sha256
#:recursive? #t
#:leaked-env-vars ("http_proxy" "https_proxy"
"LC_ALL" "LC_MESSAGES" "LANG" "COLUMNS"))))
;; ---------------------------------------------------------------------------
;; npm-binary-package
;;
;; Install an npm package (typically the published .tgz, which usually
;; ships a pre-built `dist/`) into $out/lib/node_modules/<install-prefix>/,
;; drop a `node_modules/` tree from FETCH-NPM-DEPS alongside it, and create
;; $out/bin wrappers for each entry in BINARIES.
;;
;; SOURCE may be either:
;; - an .tgz / .tar.gz / .tar tarball (auto-detected), or
;; - an already-extracted directory tree.
;;
;; BINARIES is an alist of (bin-name . relative-js-path-within-install-prefix).
;; PATH-INPUTS is a list of packages whose /bin gets prepended to the
;; wrapper's PATH (e.g. ripgrep for tools that shell out to it).
(define* (npm-binary-package
#:key
name
version
source
node-modules
(binaries '())
(path-inputs '())
(install-prefix #f)
(node node)
(home-page #f)
(synopsis "")
(description "")
license
(build-system trivial-build-system))
(let ((prefix (or install-prefix (string-append name "-" version))))
(package
(name name)
(version version)
(source source)
(build-system build-system)
(arguments
(list
#:modules '((guix build utils))
#:builder
#~(begin
(use-modules (guix build utils)
(ice-9 ftw)
(ice-9 regex))
(define out #$output)
(define lib-root (string-append out "/lib/node_modules"))
(define pkg-dir (string-append lib-root "/" #$prefix))
(define bin-dir (string-append out "/bin"))
(define (looks-like-tarball? p)
(and (string? p)
(or (string-suffix? ".tgz" p)
(string-suffix? ".tar.gz" p)
(string-suffix? ".tar" p))))
;; tar's auto-detection shells out to `gzip` / `xz` etc., so
;; make them resolvable from PATH at build time.
(setenv "PATH"
(string-join
(list #$(file-append gzip "/bin")
#$(file-append coreutils "/bin")
(or (getenv "PATH") ""))
":"))
(mkdir-p lib-root)
(mkdir-p bin-dir)
;; Unpack source into pkg-dir. npm tarballs wrap everything in
;; a "package/" directory; strip it if present.
(if (looks-like-tarball? #$source)
(begin
(mkdir-p pkg-dir)
(invoke #$(file-append tar "/bin/tar")
"-xf" #$source
"-C" pkg-dir
"--strip-components=1"))
(copy-recursively #$source pkg-dir
#:follow-symlinks? #t))
(invoke #$(file-append coreutils "/bin/chmod") "-R" "u+w" pkg-dir)
;; Drop the prefetched node_modules in place.
(let ((nm (string-append pkg-dir "/node_modules")))
(when (file-exists? nm)
(delete-file-recursively nm))
(mkdir-p nm)
(copy-recursively #$node-modules nm
#:follow-symlinks? #t))
;; Create a /bin wrapper for each declared binary. The wrapper
;; invokes node on the target script and prepends PATH-INPUTS.
(let* ((extra-path
(string-join
(list #$@(map (lambda (input)
#~(string-append #$input "/bin"))
path-inputs))
":"))
(path-prefix
(if (string-null? extra-path)
""
(string-append "PATH=\"" extra-path
":$PATH\" "))))
(for-each
(lambda (entry)
(let* ((bin-name (car entry))
(rel-js (cdr entry))
(wrapper (string-append bin-dir "/" bin-name))
(target (string-append pkg-dir "/" rel-js)))
(call-with-output-file wrapper
(lambda (port)
(format port "#!~a/bin/sh~%"
#$(file-append bash-minimal))
(format port "exec env ~a~a ~a \"$@\"~%"
path-prefix
#$(file-append node "/bin/node")
target)))
(chmod wrapper #o755)))
'#$binaries)))))
(inputs (cons* node path-inputs))
(home-page home-page)
(synopsis synopsis)
(description description)
(license license))))
tribes/packages/otp.scm
+102
View File
@@ -0,0 +1,102 @@
(define-module (tribes packages otp)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (gnu packages)
#:use-module (gnu packages bash)
#:use-module (gnu packages elixir)
#:use-module (gnu packages erlang)
#:use-module (gnu packages perl)
#:use-module (gnu packages version-control)
#:use-module (srfi srfi-1)
#:export (erlang-28
rebar3-otp28
elixir-otp28
elixir-hex-otp28))
(define-public erlang-28
(package
(inherit erlang)
(name "erlang-28")
(version "28.4.1")
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/erlang/otp")
(commit (string-append "OTP-" version))))
(file-name (git-file-name name version))
(sha256
(base32
"1lsbmjfraw03d0kcdzmjdjad8b95d630d1jmg8hjklmivc13l6pa"))
(patches (search-patches "erlang-man-path.patch"))))
(arguments
(substitute-keyword-arguments (package-arguments erlang)
((#:configure-flags flags)
`(append
(map (lambda (flag)
(if (string=? flag "--enable-wx")
"--without-wx"
flag))
,flags)
;; OTP does not automatically skip applications that depend on wx.
'("--without-debugger"
"--without-observer"
"--without-et"
"--without-reltool")))))
(inputs
(alist-delete "wxwidgets" (package-inputs erlang)))
(native-inputs
`(("perl" ,perl)
("erlang-manpages"
,(origin
(method url-fetch)
(uri (string-append
"https://github.com/erlang/otp/releases/download"
"/OTP-" version "/otp_doc_man_" version ".tar.gz"))
(sha256
(base32
"00simi301qz3ssn71r77jmsyfz8sb61wp7k92j3gh7pq7gmmc40j"))))))))
(define-public rebar3-otp28
(package
(inherit rebar3)
(name "rebar3-otp28")
(native-inputs
(modify-inputs (package-native-inputs rebar3)
(replace "erlang" erlang-28)))))
(define-public elixir-otp28
(package
(inherit elixir)
(name "elixir-otp28")
(version "1.19.5")
(arguments
(substitute-keyword-arguments (package-arguments elixir)
((#:tests? _ #f)
#f)))
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/elixir-lang/elixir/archive/refs/tags/v"
version
".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0dlflwcdx0da09grndgsj2c9k1ix7vq6vaxg4lgaq42bsy5hnx8h"))
(patches (search-patches "elixir-path-length.patch"))))
(inputs
`(("bash-minimal" ,bash-minimal)
("erlang" ,erlang-28)
("rebar3" ,rebar3-otp28)
("git" ,git)))))
(define-public elixir-hex-otp28
(package
(inherit elixir-hex)
(name "elixir-hex-otp28")
(inputs
`(("elixir" ,elixir-otp28)))))
tribes/packages/plugins.scm
+233 -514
View File
@@ -1,11 +1,14 @@
(define-module (tribes packages plugins)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix base32)
#:use-module (guix build-system trivial)
#:use-module (guix git-download)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix utils)
#:use-module (gnu packages autotools)
#:use-module (gnu packages bash)
#:use-module (gnu packages base)
#:use-module (gnu packages commencement)
#:use-module (gnu packages gawk)
@@ -20,8 +23,7 @@
fetch-npm-deps
mix-release-package))
#:use-module ((tribes packages source)
#:select (tribes-package
tribes-source-directory->local-file
#:select (tribes-source-directory->local-file
tribes-upstream-source))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
@@ -37,10 +39,7 @@
tribes-plugin-definition-provides
tribes-plugin-definition-requires
tribes-plugin-definition-external-plugin
tribes-plugin-definition-from-package
tribes-external-plugin-from-package
tribes-plugin-definitions-provided-capabilities
tribes-plugin-definitions-required-capabilities
tribes-plugin-catalog-file
tribes-plugin-package
tribes-external-plugin
tribes-external-plugin?
@@ -78,6 +77,16 @@
(or (string=? file root)
(not (transient-plugin-source-file? root file))))
(define %libsecp256k1-v0.7.1-source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/bitcoin-core/secp256k1")
(commit "v0.7.1")))
(file-name (git-file-name "secp256k1" "0.7.1"))
(sha256
(base32 "10cvh8jks3rjg6p7y0vm1v4kw9y7vljbfijj0zxwkxzysxx60w0f"))))
(define (plugin-source-directory->local-file directory)
"Return DIRECTORY as a recursively copied local-file suitable for Guix plugin
packaging, excluding transient build artifacts and, when possible, files not
@@ -119,107 +128,84 @@ tracked in Git."
(default '()))
(external-plugin tribes-plugin-definition-external-plugin))
(define (tribes-plugin-package-metadata package)
(let ((metadata (assoc-ref (package-properties package) 'tribes-plugin)))
(if (and (list? metadata) (every pair? metadata)) metadata '())))
(define* (tribes-plugin-catalog-file plugin-definitions
#:key
(schema-version "1"))
"Return a JSON catalog file describing PLUGIN-DEFINITIONS for node-local UI
and admin API consumption."
(computed-file
"tribes-plugin-catalog.json"
(with-extensions (list guile-json-4)
#~(begin
(use-modules (json)
(srfi srfi-1))
(define (plugin-metadata-ref metadata key fallback)
(let ((entry (assoc key metadata)))
(if entry (cdr entry) fallback)))
(define (json-object? value)
(and (list? value) (every pair? value)))
(define (plugin-metadata-string-list metadata key)
(let ((value (plugin-metadata-ref metadata key '())))
(cond
((and (list? value) (every string? value)) value)
((vector? value) (plugin-metadata-string-list `((,key . ,(vector->list value))) key))
(else '()))))
(define (json-ref object key)
(and (json-object? object)
(let ((entry (assoc key object)))
(and entry (cdr entry)))))
(define (plugin-version-from-package-version version)
"Return the plugin manifest version portion from a Guix package VERSION."
(let ((index (string-contains version "-")))
(if index (substring version 0 index) version)))
(define (json-string-list-ref object key)
(let ((value (json-ref object key)))
(cond
((vector? value)
(let ((items (vector->list value)))
(and (every string? items) items)))
((list? value)
(and (every string? value) value))
(else '()))))
(define (tribes-external-plugin-from-package package)
"Return a tribes external-plugin record from PACKAGE's plugin metadata
package properties."
(let* ((metadata (tribes-plugin-package-metadata package))
(name (plugin-metadata-ref metadata "slug"
(plugin-metadata-ref metadata "name"
(package-name package))))
(extra-packages
(let ((value (assoc-ref (package-properties package)
'tribes-plugin-extra-packages)))
(if (list? value) value '())))
(extra-services
(let ((value (assoc-ref (package-properties package)
'tribes-plugin-extra-services)))
(if (procedure? value) value (lambda (_node-config) '())))))
(tribes-external-plugin
(name name)
(package package)
(extra-packages extra-packages)
(extra-services extra-services))))
(define plugin-specs
(list #$@(map
(lambda (plugin-definition)
#~(list (cons 'name #$(tribes-plugin-definition-name plugin-definition))
(cons 'package #$(tribes-plugin-definition-package-name plugin-definition))
(cons 'version #$(tribes-plugin-definition-version plugin-definition))
(cons 'synopsis #$(tribes-plugin-definition-synopsis plugin-definition))
(cons 'home-page #$(tribes-plugin-definition-home-page plugin-definition))
(cons 'provides (list #$@(tribes-plugin-definition-provides plugin-definition)))
(cons 'requires (list #$@(tribes-plugin-definition-requires plugin-definition)))))
plugin-definitions)))
(define (tribes-plugin-definition-from-package package)
"Return a plugin definition from PACKAGE's plugin metadata package
properties instead of duplicating manifest fields in per-plugin modules."
(let* ((metadata (tribes-plugin-package-metadata package))
(external-plugin (tribes-external-plugin-from-package package))
(name (tribes-external-plugin-name external-plugin)))
(tribes-plugin-definition
(name name)
(package-name (plugin-metadata-ref metadata "package" (package-name package)))
(version (plugin-metadata-ref metadata "version" (package-version package)))
(synopsis (plugin-metadata-ref metadata "synopsis" (package-synopsis package)))
(home-page (plugin-metadata-ref metadata "homePage" (package-home-page package)))
(provides (plugin-metadata-string-list metadata "provides"))
(requires (plugin-metadata-string-list metadata "requires"))
(external-plugin external-plugin))))
(define plugins
(map
(lambda (plugin-spec)
`(("name" . ,(assoc-ref plugin-spec 'name))
("package" . ,(assoc-ref plugin-spec 'package))
("version" . ,(assoc-ref plugin-spec 'version))
("synopsis" . ,(assoc-ref plugin-spec 'synopsis))
("homePage" . ,(assoc-ref plugin-spec 'home-page))
("provides" . ,(list->vector (assoc-ref plugin-spec 'provides)))
("requires" . ,(list->vector (assoc-ref plugin-spec 'requires)))))
plugin-specs))
(define (tribes-plugin-definitions-provided-capabilities plugin-definitions)
"Return the de-duplicated capability set provided by PLUGIN-DEFINITIONS."
(delete-duplicates
(append-map tribes-plugin-definition-provides plugin-definitions)
string=?))
(define (tribes-plugin-definitions-required-capabilities plugin-definitions)
"Return the de-duplicated capability set required by PLUGIN-DEFINITIONS."
(delete-duplicates
(append-map tribes-plugin-definition-requires plugin-definitions)
string=?))
(call-with-output-file #$output
(lambda (port)
(scm->json
`(("schemaVersion" . ,#$schema-version)
("plugins" . ,(list->vector plugins)))
port)))))))
(define* (tribes-plugin-package plugin-source
#:key
host-package
(reuse-host-libs? #f)
host-source
host-source-directory
mix-deps
mix-deps-sha256
(include-mix-deps? (not reuse-host-libs?))
(compile-mix-deps '())
(build-assets? #f)
(digest-assets? #f)
(native-deps? #f)
asset-deps
asset-deps-sha256
(assets-directory "assets")
asset-build-gexp
name
(version "dev")
(mix-env "prod")
(home-page "https://git.teralink.net/tribes/plugins")
synopsis
description
plugin-id
plugin-slug
(display-name plugin-slug)
(host-api "1")
(provides '())
(requires '())
(enhances-with '())
(extra-packages '())
(extra-services (lambda (_node-config) '())))
description)
"Build PLUGIN-SOURCE as a standalone Tribes plugin artifact. The plugin is
compiled against the Tribes host source specified by HOST-SOURCE or
HOST-SOURCE-DIRECTORY, and packages its compiled BEAM closure under
@@ -229,90 +215,21 @@ lib/*/ebin."
(and host-source-directory
(tribes-source-directory->local-file host-source-directory))
tribes-upstream-source))
(resolved-host-package
(and reuse-host-libs?
(or host-package tribes-package)))
(plugin-api-setup-gexp
#~(let ((host-root (string-append work "/tribes")))
(when (file-exists? host-root)
(delete-file-recursively host-root))
(copy-recursively #+resolved-host-source host-root #:follow-symlinks? #t)
(invoke "chmod" "-R" "u+w" host-root)
;; Plugin builds compile the Tribes host as a Mix dependency
;; under the plugin application's root config. Keep Ash's host
;; domain inclusion check satisfied for that dependency without
;; requiring every plugin source tree to duplicate host config.
(let* ((config-dir (string-append app-dir "/config"))
(config-file (string-append config-dir "/config.exs")))
(mkdir-p config-dir)
(unless (file-exists? config-file)
(call-with-output-file config-file
(lambda (port)
(display "import Config\n" port))))
(let ((port (open-file config-file "a")))
(display
"\nconfig :tribes, :ash_domains, [\n Tribes.Accounts,\n Tribes.Alliance,\n Tribes.Cluster,\n Tribes.ConfigStore.Domain,\n Tribes.Rollout\n]\n"
port)
(close-port port)))))
(source-setup-gexp
(if reuse-host-libs?
#~(begin)
plugin-api-setup-gexp))
(invoke "chmod" "-R" "u+w" host-root)))
(mix-deps-source
(and include-mix-deps?
(or mix-deps
(and mix-deps-sha256
(fetch-mix-deps
plugin-source
#:name (string-append name "-mix-deps")
#:version version
#:sha256 mix-deps-sha256
#:setup-gexp source-setup-gexp)))))
(host-release-libs-setup-gexp
(if reuse-host-libs?
#~(let* ((host-lib-dir (string-append #+resolved-host-package "/lib"))
(build-root (string-append app-dir "/_build/" #$mix-env))
(target-lib-dir (string-append build-root "/lib"))
(host-apps-file (string-append build-root "/tribes-host-apps")))
(mkdir-p target-lib-dir)
(let* ((app-files (find-files host-lib-dir "\\.app$" #:directories? #f))
(host-ebin-dirs (map dirname app-files))
(host-apps
(map
(lambda (app-file)
(let* ((app-file-base (basename app-file))
(app-name (substring app-file-base
0
(- (string-length app-file-base) 4)))
(release-dir (dirname (dirname app-file)))
(target-dir (string-append target-lib-dir "/" app-name)))
(unless (file-exists? target-dir)
(symlink release-dir target-dir))
app-name))
app-files)))
(call-with-output-file host-apps-file
(lambda (port)
(write host-apps port)))
(let ((existing-erlang-flags (getenv "ERL_AFLAGS"))
(host-code-path-flags
(string-join
(apply append (map (lambda (dir) (list "-pa" dir)) host-ebin-dirs))
" ")))
(setenv "ERL_AFLAGS"
(if existing-erlang-flags
(string-append host-code-path-flags " " existing-erlang-flags)
host-code-path-flags))))
(let ((existing-erlang-libs (getenv "ERL_LIBS")))
(setenv "ERL_LIBS"
(if existing-erlang-libs
(string-append target-lib-dir ":" existing-erlang-libs)
target-lib-dir)))
(let ((existing-elixir-libs (getenv "GUIX_ELIXIR_LIBS")))
(setenv "GUIX_ELIXIR_LIBS"
(if existing-elixir-libs
(string-append target-lib-dir ":" existing-elixir-libs)
target-lib-dir))))
#~(begin)))
(or mix-deps
(and mix-deps-sha256
(fetch-mix-deps
plugin-source
#:name (string-append name "-mix-deps")
#:version version
#:sha256 mix-deps-sha256
#:setup-gexp plugin-api-setup-gexp))))
(asset-deps-source
(or asset-deps
(and build-assets?
@@ -323,12 +240,11 @@ lib/*/ebin."
#:version version
#:sha256 asset-deps-sha256
#:assets-dir assets-directory
#:setup-gexp source-setup-gexp))))
#:setup-gexp plugin-api-setup-gexp))))
(setup-gexp
(if asset-deps-source
#~(begin
#$source-setup-gexp
#$host-release-libs-setup-gexp
#$plugin-api-setup-gexp
(let* ((assets-dir (string-append work "/app/" #$assets-directory))
(node-modules-dir (string-append assets-dir "/node_modules")))
(mkdir-p assets-dir)
@@ -349,9 +265,7 @@ lib/*/ebin."
(patch-shebang (canonicalize-path script)
(list #$(file-append node "/bin"))))
(find-files bin-dir))))))
#~(begin
#$source-setup-gexp
#$host-release-libs-setup-gexp)))
plugin-api-setup-gexp))
(resolved-asset-build-gexp
(cond
((not build-assets?) #~(begin))
@@ -363,246 +277,167 @@ lib/*/ebin."
(if digest-assets?
#~(invoke "mix"
"run"
"--no-deps-check"
"--no-compile"
"-e"
"Application.put_env(:phoenix, :json_library, JSON); Mix.Task.run(\"phx.digest\", [\"priv/static\", \"-o\", \"priv/static\", \"--no-compile\"])")
#~(begin)))
(native-toolchain-inputs
(if (or native-deps? (not reuse-host-libs?))
(list autoconf
autoconf-wrapper
automake
gcc-toolchain
diffutils
gawk
grep
gnu-make
libtool
linux-libre-headers
m4
perl
pkg-config
sed)
'())))
(let ((built-package
(mix-release-package
plugin-source
#~(begin))))
(mix-release-package
plugin-source
#:mix-fod-deps mix-deps-source
#:name name
#:version version
#:mix-env mix-env
#:home-page home-page
#:synopsis synopsis
#:description description
#:license license:asl2.0
#:native-inputs
(append native-toolchain-inputs
(if build-assets? (list node) '()))
(append
(list autoconf
autoconf-wrapper
automake
gcc-toolchain
diffutils
gawk
grep
gnu-make
libtool
linux-libre-headers
m4
perl
pkg-config
sed)
(if build-assets? (list node) '()))
#:path-inputs
(append native-toolchain-inputs
(if build-assets? (list node) '()))
(append
(list autoconf
autoconf-wrapper
automake
gcc-toolchain
diffutils
gawk
grep
gnu-make
libtool
linux-libre-headers
m4
perl
pkg-config
sed)
(if build-assets? (list node) '()))
#:aclocal-inputs
(if (or native-deps? (not reuse-host-libs?)) (list automake libtool) '())
(list automake libtool)
#:setup-gexp
#~(begin
#$@(if (or native-deps? (not reuse-host-libs?))
(list
#~(begin
(define kernel-headers-dir
#$(file-append linux-libre-headers "/include"))
(let ((existing-cpath (getenv "CPATH")))
(setenv "CPATH"
(if existing-cpath
(string-append kernel-headers-dir ":" existing-cpath)
kernel-headers-dir)))
(let ((existing-c-include-path (getenv "C_INCLUDE_PATH")))
(setenv "C_INCLUDE_PATH"
(if existing-c-include-path
(string-append kernel-headers-dir ":"
existing-c-include-path)
kernel-headers-dir)))
(setenv "CC" #$(file-append gcc-toolchain "/bin/gcc"))
(setenv "CXX" #$(file-append gcc-toolchain "/bin/g++"))
(setenv "CPP"
(string-append #$(file-append gcc-toolchain "/bin/gcc")
" -E"))))
'())
#$setup-gexp)
#:configure-gexp
(cond
((not reuse-host-libs?) #f)
((null? compile-mix-deps) #~(begin))
(else #~(begin
#$@(map (lambda (dep)
#~(invoke "mix" "deps.compile" #$dep "--no-deps-check"))
compile-mix-deps))))
(define kernel-headers-dir
#$(file-append linux-libre-headers "/include"))
(let ((existing-cpath (getenv "CPATH")))
(setenv "CPATH"
(if existing-cpath
(string-append kernel-headers-dir ":" existing-cpath)
kernel-headers-dir)))
(let ((existing-c-include-path (getenv "C_INCLUDE_PATH")))
(setenv "C_INCLUDE_PATH"
(if existing-c-include-path
(string-append kernel-headers-dir ":"
existing-c-include-path)
kernel-headers-dir)))
(setenv "CC" #$(file-append gcc-toolchain "/bin/gcc"))
(setenv "CXX" #$(file-append gcc-toolchain "/bin/g++"))
(setenv "CPP"
(string-append #$(file-append gcc-toolchain "/bin/gcc")
" -E"))
#$setup-gexp
(let* ((libsecp-dep (string-append app-dir "/deps/lib_secp256k1"))
(libsecp-c-src (string-append libsecp-dep "/c_src"))
(libsecp-source-dir (string-append libsecp-c-src "/secp256k1")))
(when (file-exists? libsecp-dep)
(mkdir-p libsecp-c-src)
(when (file-exists? libsecp-source-dir)
(delete-file-recursively libsecp-source-dir))
(copy-recursively #+%libsecp256k1-v0.7.1-source
libsecp-source-dir
#:follow-symlinks? #t)
(invoke "chmod" "-R" "u+w" libsecp-source-dir)
(substitute* (string-append libsecp-source-dir "/autogen.sh")
(("^#!.*") (string-append "#!" #$(file-append bash-minimal "/bin/sh") "\n")))
(with-directory-excursion libsecp-source-dir
(invoke #$(file-append bash-minimal "/bin/sh") "autogen.sh")
(invoke #$(file-append bash-minimal "/bin/sh")
"configure"
"--disable-benchmark"
"--disable-tests"
"--disable-fast-install"
"--with-pic"
"--enable-experimental"
"--enable-module-musig"))
(call-with-output-file (string-append libsecp-source-dir "/.fetched")
(lambda (port)
(display "vendored by guix-tribes\n" port))))))
#:build-gexp
(if reuse-host-libs?
#~(begin
#$resolved-asset-build-gexp
(invoke "mix" "compile" "--no-deps-check" "--no-prune-code-paths" "--no-protocol-consolidation")
#$resolved-asset-digest-gexp)
#~(begin
#$resolved-asset-build-gexp
(invoke "mix" "compile")
(let ((muontrap-dir (string-append "_build/" #$mix-env "/lib/muontrap")))
(when (file-exists? muontrap-dir)
(invoke "test" "-x" (string-append muontrap-dir "/priv/muontrap"))))
#$resolved-asset-digest-gexp))
#~(begin
#$resolved-asset-build-gexp
(invoke "mix" "compile")
#$resolved-asset-digest-gexp)
#:install-gexp
#~(begin
(define (install-common-files)
(mkdir-p out)
(copy-file "manifest.json" (string-append out "/manifest.json"))
(mkdir-p out)
(copy-file "manifest.json" (string-append out "/manifest.json"))
(when (file-exists? "priv")
(copy-recursively "priv"
(string-append out "/priv")
#:follow-symlinks? #t))
(when (file-exists? "priv")
(copy-recursively "priv"
(string-append out "/priv")
#:follow-symlinks? #t))
(when (and (not #$build-assets?)
(or (file-exists? "assets/js")
(file-exists? "assets/css")))
(let ((static-dir (string-append out "/priv/static")))
(mkdir-p static-dir)
(when (file-exists? "assets/js")
(invoke "cp" "-r" "assets/js/." static-dir))
(when (file-exists? "assets/css")
(invoke "cp" "-r" "assets/css/." static-dir)))))
(when (and (not #$build-assets?)
(or (file-exists? "assets/js")
(file-exists? "assets/css")))
(let ((static-dir (string-append out "/priv/static")))
(mkdir-p static-dir)
(when (file-exists? "assets/js")
(invoke "cp" "-r" "assets/js/." static-dir))
(when (file-exists? "assets/css")
(invoke "cp" "-r" "assets/css/." static-dir))))
(define (read-host-apps path)
(if (file-exists? path)
(call-with-input-file path read)
'()))
(define (strip-compiled-lib-artifacts root)
(when (file-exists? root)
(for-each
(lambda (path)
(when (file-exists? path)
(delete-file-recursively path)))
(find-files root "^(consolidated|\\.mix)$" #:directories? #t #:stat lstat))))
(define (copy-filtered-compiled-libs)
(let* ((build-root (string-append "_build/" #$mix-env))
(build-lib-dir (string-append build-root "/lib"))
(host-apps-file (string-append build-root "/tribes-host-apps"))
(host-apps (read-host-apps host-apps-file))
(out-lib-dir (string-append out "/lib")))
(when (file-exists? build-lib-dir)
(mkdir-p out-lib-dir)
(let loop ((app-files (find-files build-lib-dir "\\.app$" #:directories? #f))
(copied '()))
(unless (null? app-files)
(let* ((app-file (car app-files))
(app-file-base (basename app-file))
(app-name (substring app-file-base
0
(- (string-length app-file-base) 4)))
(source-dir (dirname (dirname app-file)))
(target-dir (string-append out-lib-dir "/" app-name)))
(when (and (not (member app-name host-apps))
(not (member app-name copied)))
(copy-recursively source-dir target-dir #:follow-symlinks? #t)
(strip-compiled-lib-artifacts target-dir))
(loop (cdr app-files) (cons app-name copied))))))))
(install-common-files)
(if #$reuse-host-libs?
(copy-filtered-compiled-libs)
(let ((build-lib-dir (string-append "_build/" #$mix-env "/lib")))
(when (file-exists? build-lib-dir)
(copy-recursively build-lib-dir
(string-append out "/lib")
#:follow-symlinks? #t)
(strip-compiled-lib-artifacts (string-append out "/lib")))))))))
(package
(inherit built-package)
(properties
`((tribes-plugin
. (("schemaVersion" . "2")
("id" . ,plugin-id)
("name" . ,plugin-slug)
("slug" . ,plugin-slug)
("displayName" . ,display-name)
("package" . ,name)
("version" . ,(plugin-version-from-package-version version))
("synopsis" . ,synopsis)
("homePage" . ,home-page)
("hostApi" . ,host-api)
("provides" . ,provides)
("requires" . ,requires)
("enhancesWith" . ,enhances-with)))
(tribes-plugin-extra-packages . ,extra-packages)
(tribes-plugin-extra-services . ,extra-services)))))))
(when (file-exists? "_build/prod/lib")
(copy-recursively "_build/prod/lib"
(string-append out "/lib")
#:follow-symlinks? #t))))))
(define* (local-tribes-plugin-package directory
#:key
host-package
(reuse-host-libs? #f)
host-source
host-source-directory
mix-deps
mix-deps-sha256
(include-mix-deps? (not reuse-host-libs?))
(compile-mix-deps '())
(build-assets? #f)
(digest-assets? #f)
(native-deps? #f)
asset-deps
asset-deps-sha256
(assets-directory "assets")
asset-build-gexp
name
(version "dev")
(mix-env "prod")
(home-page "https://git.teralink.net/tribes/plugins")
synopsis
description
plugin-id
plugin-slug
(display-name plugin-slug)
(host-api "1")
(provides '())
(requires '())
(enhances-with '())
(extra-packages '())
(extra-services (lambda (_node-config) '())))
description)
"Build DIRECTORY as a standalone Tribes plugin artifact."
(tribes-plugin-package
(plugin-source-directory->local-file directory)
#:host-package host-package
#:reuse-host-libs? reuse-host-libs?
#:host-source host-source
#:host-source-directory host-source-directory
#:mix-deps mix-deps
#:mix-deps-sha256 mix-deps-sha256
#:include-mix-deps? include-mix-deps?
#:compile-mix-deps compile-mix-deps
#:build-assets? build-assets?
#:digest-assets? digest-assets?
#:native-deps? native-deps?
#:asset-deps asset-deps
#:asset-deps-sha256 asset-deps-sha256
#:assets-directory assets-directory
#:asset-build-gexp asset-build-gexp
#:name name
#:version version
#:mix-env mix-env
#:home-page home-page
#:synopsis synopsis
#:description description
#:plugin-id plugin-id
#:plugin-slug plugin-slug
#:display-name display-name
#:host-api host-api
#:provides provides
#:requires requires
#:enhances-with enhances-with
#:extra-packages extra-packages
#:extra-services extra-services))
#:description description))
(define* (tribes-package-with-external-plugins host-package plugins
#:key
@@ -654,13 +489,6 @@ build."
#~(list (cons 'name #$(tribes-external-plugin-name plugin))
(cons 'path #$(tribes-external-plugin-package plugin))))
plugins)))
(define app-roots
(list
(cons #+host-package "host")
#$@(map (lambda (plugin)
#~(cons #$(tribes-external-plugin-package plugin)
#$(tribes-external-plugin-name plugin)))
plugins)))
(define (json-file->scm file)
(call-with-input-file file json->scm))
@@ -687,8 +515,12 @@ build."
(and (every string? value) value))
(else #f))))
(define cap-rx
(make-regexp "^[a-z][a-z0-9_-]*(\\.[a-z][a-z0-9_-]*)+@[1-9][0-9]*$"))
(define cap-rx (make-regexp "^[a-z][a-z0-9_]*(@[1-9][0-9]*)?$"))
(define (normalize-capability cap)
(if (string-contains cap "@")
cap
(string-append cap "@1")))
(define (validate-capabilities plugin-name field caps)
(for-each
@@ -700,27 +532,29 @@ build."
plugin-name
" -> "
cap))))
caps))
caps))
(define (plugin-manifest-metadata expected-slug path)
(let* ((manifest-path (string-append path "/manifest.json")))
(define (plugin-metadata spec)
(let* ((expected-name (assoc-ref spec 'name))
(path (assoc-ref spec 'path))
(manifest-path (string-append path "/manifest.json")))
(unless (file-exists? manifest-path)
(error "plugin package missing manifest.json" expected-slug path))
(error "plugin package missing manifest.json" expected-name path))
(let* ((manifest (json-file->scm manifest-path))
(id (json-string-ref manifest "id"))
(slug (json-string-ref manifest "slug"))
(display-name (json-string-ref manifest "display_name"))
(name (json-string-ref manifest "name"))
(version (json-string-ref manifest "version"))
(entry-module (json-string-ref manifest "entry_module"))
(plugin-host-api (json-string-ref manifest "host_api"))
(otp-app (json-string-ref manifest "otp_app"))
(provides (json-string-list-ref manifest "provides"))
(requires (json-string-list-ref manifest "requires")))
(provides
(and=> (json-string-list-ref manifest "provides")
(lambda (caps) (map normalize-capability caps))))
(requires
(and=> (json-string-list-ref manifest "requires")
(lambda (caps) (map normalize-capability caps)))))
(unless (and (json-object? manifest)
id
slug
display-name
name
version
entry-module
plugin-host-api
@@ -728,31 +562,24 @@ build."
provides
requires)
(error "plugin manifest failed schema validation"
expected-slug
expected-name
manifest-path))
(unless (string=? slug expected-slug)
(error "plugin package slug does not match manifest slug"
expected-slug
slug))
(unless (string=? name expected-name)
(error "plugin package name does not match manifest name"
expected-name
name))
(unless (string=? plugin-host-api #$host-api)
(error "plugin manifest host_api mismatch"
id
name
plugin-host-api
#$host-api))
(validate-capabilities id "provides" provides)
(validate-capabilities id "requires" requires)
`((id . ,id)
(name . ,slug)
(slug . ,slug)
(display-name . ,display-name)
(validate-capabilities name "provides" provides)
(validate-capabilities name "requires" requires)
`((name . ,name)
(path . ,path)
(provides . ,provides)
(requires . ,requires)))))
(define (plugin-metadata spec)
(plugin-manifest-metadata (assoc-ref spec 'name)
(assoc-ref spec 'path)))
(define (duplicates items)
(delete-duplicates
(filter-map
@@ -761,20 +588,12 @@ build."
item))
items)))
(define (manifest-capabilities path field)
(let* ((manifest (json-file->scm path))
(id (json-string-ref manifest "id"))
(caps (json-string-list-ref manifest field)))
(unless caps
(error "manifest has invalid capability field" path field))
(validate-capabilities id field caps)
caps))
(define (manifest-provides path)
(manifest-capabilities path "provides"))
(define (manifest-requires path)
(manifest-capabilities path "requires"))
(let* ((manifest (json-file->scm path))
(provides (json-string-list-ref manifest "provides")))
(unless provides
(error "host manifest has invalid provides field" path))
(map normalize-capability provides)))
(define (find-host-manifest root)
(let ((matches
@@ -790,27 +609,8 @@ build."
matches)
(error "host package manifest.json not found" root matches))))
(define (find-built-in-plugin-manifests root)
(filter
(lambda (path)
(string-contains path "/plugins/"))
(find-files root
"^manifest\\.json$"
#:directories? #f
#:stat lstat)))
(define (built-in-plugin-metadata manifest-path)
(let* ((plugin-dir
(let ((index (string-rindex manifest-path #\/)))
(if index (substring manifest-path 0 index) ".")))
(manifest (json-file->scm manifest-path))
(slug (json-string-ref manifest "slug")))
(unless slug
(error "built-in plugin manifest missing slug" manifest-path))
(plugin-manifest-metadata slug plugin-dir)))
(define (provider-ids plugins capability)
(map (lambda (plugin) (assoc-ref plugin 'id))
(define (provider-names plugins capability)
(map (lambda (plugin) (assoc-ref plugin 'name))
(filter (lambda (plugin)
(member capability (assoc-ref plugin 'provides)))
plugins)))
@@ -820,8 +620,8 @@ build."
(append-map
(lambda (cap)
(filter (lambda (provider)
(not (string=? provider (assoc-ref plugin 'id))))
(provider-ids plugins cap)))
(not (string=? provider (assoc-ref plugin 'name))))
(provider-names plugins cap)))
(assoc-ref plugin 'requires))))
(define (ordered-plugins plugins)
@@ -829,117 +629,38 @@ build."
(remaining plugins))
(if (null? remaining)
ordered
(let* ((ordered-ids (map (lambda (plugin) (assoc-ref plugin 'id))
ordered))
(let* ((ordered-names (map (lambda (plugin) (assoc-ref plugin 'name))
ordered))
(ready
(filter
(lambda (plugin)
(every (lambda (dep)
(member dep ordered-ids))
(member dep ordered-names))
(plugin-dependencies plugins plugin)))
remaining)))
(if (null? ready)
(error "plugin capability dependency cycle detected"
(map (lambda (plugin)
(assoc-ref plugin 'id))
(assoc-ref plugin 'name))
remaining))
(loop (append ordered ready)
(filter (lambda (plugin)
(not (member plugin ready)))
remaining)))))))
(define app-file-rx (make-regexp "\\.app$"))
(define app-name-rx
(make-regexp "\\{application,[[:space:]\n\r]*'?([A-Za-z0-9_@.-]+)'?"))
(define app-vsn-rx
(make-regexp "\\{vsn,[[:space:]\n\r]*\"([^\"]+)\"\\}"))
(define (regexp-match-submatch rx text index)
(let ((match (regexp-exec rx text)))
(and match (match:substring match index))))
(define (port->string port)
(let loop ((chars '()))
(let ((char (read-char port)))
(if (eof-object? char)
(list->string (reverse chars))
(loop (cons char chars))))))
(define (compiled-app-metadata owner file)
(let* ((content (call-with-input-file file port->string))
(app (regexp-match-submatch app-name-rx content 1))
(vsn (regexp-match-submatch app-vsn-rx content 1)))
(and app
vsn
`((app . ,app)
(version . ,vsn)
(owner . ,owner)
(file . ,file)))))
(define (compiled-apps root owner)
(filter-map
(lambda (file)
(compiled-app-metadata owner file))
(find-files root "\\.app$" #:directories? #f #:stat lstat)))
(define (validate-compiled-app-versions roots)
(let* ((apps
(append-map
(lambda (entry)
(compiled-apps (car entry) (cdr entry)))
roots))
(names (delete-duplicates
(map (lambda (app) (assoc-ref app 'app)) apps))))
(for-each
(lambda (name)
(let* ((matches
(filter (lambda (app)
(string=? name (assoc-ref app 'app)))
apps))
(versions
(delete-duplicates
(map (lambda (app) (assoc-ref app 'version))
matches))))
(when (> (length versions) 1)
(error "compiled OTP application version conflict"
name
(map (lambda (app)
(list (cons 'version (assoc-ref app 'version))
(cons 'owner (assoc-ref app 'owner))
(cons 'file (assoc-ref app 'file))))
matches)))))
names)))
(define host-manifest (find-host-manifest #+host-package))
(define built-in-plugins
(map built-in-plugin-metadata
(find-built-in-plugin-manifests #+host-package)))
(define host-provides (manifest-provides host-manifest))
(define host-requires (manifest-requires host-manifest))
(define plugins (map plugin-metadata plugin-specs))
(define all-plugins (append built-in-plugins plugins))
(define plugin-ids (map (lambda (plugin) (assoc-ref plugin 'id)) all-plugins))
(define duplicate-ids (duplicates plugin-ids))
(define plugin-names (map (lambda (plugin) (assoc-ref plugin 'name)) all-plugins))
(define plugin-names (map (lambda (plugin) (assoc-ref plugin 'name)) plugins))
(define duplicate-names (duplicates plugin-names))
(unless (null? duplicate-ids)
(error "duplicate plugin ids in assembled package" duplicate-ids))
(unless (null? duplicate-names)
(error "duplicate plugin slugs in assembled package" duplicate-names))
(error "duplicate plugin names in assembled package" duplicate-names))
(let ((all-provided
(append host-provides
(append-map (lambda (plugin) (assoc-ref plugin 'provides))
all-plugins))))
(let ((missing-host
(filter (lambda (cap)
(not (member cap all-provided)))
host-requires)))
(unless (null? missing-host)
(error "host capability check failed"
missing-host
all-provided)))
plugins))))
(for-each
(lambda (plugin)
(let ((missing
@@ -953,8 +674,6 @@ build."
all-provided))))
plugins))
(validate-compiled-app-versions app-roots)
(let ((ordered (ordered-plugins plugins)))
(mkdir-p #$output)
(copy-recursively #+host-package #$output #:follow-symlinks? #t)
tribes/packages/sender-runtime.scm
-435
View File
@@ -1,435 +0,0 @@
(define-module (tribes packages sender-runtime)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix base32)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
#:use-module (gnu packages assembly)
#:use-module (gnu packages audio)
#:use-module (gnu packages bash)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages monitoring)
#:use-module (gnu packages mp3)
#:use-module (gnu packages networking)
#:use-module (gnu packages nss)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages tls)
#:use-module (gnu packages video)
#:use-module (gnu packages xiph)
#:use-module (tribes packages monitoring)
#:use-module (tribes packages web)
#:export (sender-ffmpeg
tribes-sender-runtime))
(define-public sender-ffmpeg
(package
(inherit ffmpeg)
(name "sender-ffmpeg")
(version "8.0.2")
(source
(origin
(method url-fetch)
(uri (string-append "https://ffmpeg.org/releases/ffmpeg-"
version ".tar.xz"))
(sha256
(base32 "01cml03fpmfjbn3b220irgi6wv8np49gr1q87mxl4g3068irc5jx"))))
(inputs
(list dav1d
gnutls
opus
lame
libvpx
libx264
x265
soxr
speex
srt
zlib))
(native-inputs
(list bc perl pkg-config texinfo nasm))
(arguments
(substitute-keyword-arguments (package-arguments ffmpeg)
((#:tests? _ #f) #f)
((#:configure-flags _)
#~(list
#$@(if (target-powerpc?)
'("--ignore-tests=checkasm-sw_scale,filter-scale2ref_keep_aspect,sws-floatimg-cmp")
'())
"--enable-gpl"
"--enable-shared"
"--enable-gnutls"
"--enable-libdav1d"
"--enable-libmp3lame"
"--enable-libopus"
"--enable-libsoxr"
"--enable-libspeex"
"--enable-libsrt"
"--enable-libvpx"
"--enable-libx264"
"--enable-libx265"
"--enable-runtime-cpudetect"
"--disable-htmlpages"
"--disable-static"
"--disable-stripping"
#$@(if (target-riscv64?)
'("--extra-cflags=-fPIC")
'())
"--disable-mips32r2"
"--disable-mipsdsp"
"--disable-mipsdspr2"
"--disable-mipsfpu"))))
(synopsis "Headless FFmpeg build for Tribes Sender nodes")
(description
"This FFmpeg variant keeps the codecs and protocols needed by external
Tribes Sender nodes while dropping display, desktop audio, and GPU acceleration
stacks from the default Guix FFmpeg build.")))
(define-public tribes-sender-runtime
(package
(name "tribes-sender-runtime")
(version "0.1.0")
(source #f)
(build-system trivial-build-system)
(arguments
(list
#:builder
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(let ((bin (string-append #$output "/bin"))
(share (string-append #$output "/share/tribes-sender-runtime")))
(mkdir-p bin)
(mkdir-p share)
(call-with-output-file (string-append bin "/tribes-sender-runtime")
(lambda (port)
(display
(string-append
"#!" #$(file-append bash-minimal "/bin/sh") "\n"
"set -eu\n"
"\n"
"SHEPHERD=\"" #$(file-append shepherd "/bin/shepherd") "\"\n"
"HERD=\"" #$(file-append shepherd "/bin/herd") "\"\n"
"NODE_EXPORTER=\"" #$(file-append prometheus-node-exporter "/bin/node_exporter") "\"\n"
"VINYLD=\"" #$(file-append vinyl "/sbin/vinyld") "\"\n"
"VINYLSTAT=\"" #$(file-append vinyl "/bin/vinylstat") "\"\n"
"VINYLLOG=\"" #$(file-append vinyl "/bin/vinyllog") "\"\n"
"VINYL_EXPORTER=\"" #$(file-append vinyl-exporter "/bin/vinyl_exporter") "\"\n"
"VMAGENT=\"" #$(file-append victoriametrics "/bin/vmagent") "\"\n"
"CA_CERTS=\"" #$(file-append nss-certs "/etc/ssl/certs/ca-certificates.crt") "\"\n"
"\n"
"PATH=\"" #$(file-append coreutils "/bin") ":" #$(file-append grep "/bin") ":" #$(file-append sed "/bin") "${PATH:+:$PATH}\"\n"
"export PATH\n"
"\n"
"CONFIG_FILE=${TRIBES_SENDER_CONFIG:-/etc/tribes/sender-runtime.env}\n"
"RUN_DIR=${TRIBES_SENDER_RUN_DIR:-/run/tribes-sender-runtime}\n"
"STATE_DIR=${TRIBES_SENDER_STATE_DIR:-/var/lib/tribes-sender-runtime}\n"
"LOG_DIR=${TRIBES_SENDER_LOG_DIR:-/var/log/tribes-sender-runtime}\n"
"SOCKET=$RUN_DIR/shepherd.sock\n"
"PID_FILE=$RUN_DIR/shepherd.pid\n"
"SHEPHERD_CONFIG=$RUN_DIR/shepherd.scm\n"
"VMAGENT_CONFIG=$RUN_DIR/vmagent.yml\n"
"\n"
"usage() {\n"
" cat <<'EOF'\n"
"Usage: tribes-sender-runtime COMMAND [SERVICE]\n"
"\n"
"Commands:\n"
" start Start the private Shepherd and configured services\n"
" stop Stop the private Shepherd and all services\n"
" status Show Shepherd service status\n"
" restart [SVC] Restart one service, or all configured services\n"
" logs Follow the private Shepherd log\n"
" install-boot Install a best-effort host boot hook when supported\n"
"\n"
"Config defaults to /etc/tribes/sender-runtime.env.\n"
"Set TRIBES_SENDER_CONFIG to use another env file.\n"
"EOF\n"
"}\n"
"\n"
"load_config() {\n"
" if [ -r \"$CONFIG_FILE\" ]; then\n"
" set -a\n"
" # shellcheck disable=SC1090\n"
" . \"$CONFIG_FILE\"\n"
" set +a\n"
" fi\n"
"\n"
" TRIBES_SENDER_SERVICES=${TRIBES_SENDER_SERVICES:-node-exporter vinyl vinyl-exporter vmagent}\n"
" TRIBES_NODE_EXPORTER_LISTEN=${TRIBES_NODE_EXPORTER_LISTEN:-127.0.0.1:9100}\n"
" TRIBES_VINYL_NAME=${TRIBES_VINYL_NAME:-tribes-sender}\n"
" TRIBES_VINYL_LISTEN=${TRIBES_VINYL_LISTEN:-0.0.0.0:6081}\n"
" TRIBES_VINYL_BACKEND=${TRIBES_VINYL_BACKEND:-127.0.0.1:4000}\n"
" TRIBES_VINYL_STORAGE=${TRIBES_VINYL_STORAGE:-malloc,1G}\n"
" TRIBES_VINYL_STATE_DIR=${TRIBES_VINYL_STATE_DIR:-$STATE_DIR/vinyl}\n"
" TRIBES_VINYL_EXPORTER_LISTEN=${TRIBES_VINYL_EXPORTER_LISTEN:-127.0.0.1:9131}\n"
" TRIBES_VINYL_EXPORTER_METRICS_PATH=${TRIBES_VINYL_EXPORTER_METRICS_PATH:-/metrics}\n"
" TRIBES_VINYL_EXPORTER_HEALTH_PATH=${TRIBES_VINYL_EXPORTER_HEALTH_PATH:-/-/healthy}\n"
" TRIBES_HLS_PATH_PREFIX=${TRIBES_HLS_PATH_PREFIX:-/sender/hls/streams/}\n"
" TRIBES_HLS_STREAM_COMPONENTS=${TRIBES_HLS_STREAM_COMPONENTS:-1}\n"
" TRIBES_HLS_VIEWER_TTL=${TRIBES_HLS_VIEWER_TTL:-5m}\n"
" TRIBES_VMAGENT_LISTEN=${TRIBES_VMAGENT_LISTEN:-127.0.0.1:8429}\n"
" TRIBES_VMAGENT_REMOTE_WRITE_URL=${TRIBES_VMAGENT_REMOTE_WRITE_URL:-${TRIBES_METRICS_REMOTE_WRITE_URL:-http://127.0.0.1:8428/api/v1/write}}\n"
" TRIBES_VMAGENT_TMP_DATA_PATH=${TRIBES_VMAGENT_TMP_DATA_PATH:-$STATE_DIR/vmagent}\n"
" SSL_CERT_FILE=${SSL_CERT_FILE:-$CA_CERTS}\n"
" export SSL_CERT_FILE\n"
"}\n"
"\n"
"scheme_string() {\n"
" printf '%s' \"$1\" | sed 's/\\\\/\\\\\\\\/g; s/\"/\\\\\"/g; s/^/\"/; s/$/\"/'\n"
"}\n"
"\n"
"normalize_service() {\n"
" case \"$1\" in\n"
" node-exporter|node_exporter) printf '%s\\n' node-exporter ;;\n"
" vinyl) printf '%s\\n' vinyl ;;\n"
" vinyl-exporter|vinyl_exporter) printf '%s\\n' vinyl-exporter ;;\n"
" vmagent) printf '%s\\n' vmagent ;;\n"
" all) printf '%s\\n' node-exporter vinyl vinyl-exporter vmagent ;;\n"
" *) echo \"unknown service: $1\" >&2; return 1 ;;\n"
" esac\n"
"}\n"
"\n"
"start_services_sexp() {\n"
" services=\n"
" for service in $TRIBES_SENDER_SERVICES; do\n"
" for normalized in $(normalize_service \"$service\"); do\n"
" case \" $services \" in\n"
" *\" $normalized \"*) ;;\n"
" *) services=\"$services $normalized\" ;;\n"
" esac\n"
" done\n"
" done\n"
" printf \"'(%s)\" \"$services\"\n"
"}\n"
"\n"
"running() {\n"
" [ -S \"$SOCKET\" ] && \"$HERD\" -s \"$SOCKET\" status root >/dev/null 2>&1\n"
"}\n"
"\n"
"write_vmagent_config() {\n"
" if [ -n \"${TRIBES_VMAGENT_SCRAPE_CONFIG:-}\" ]; then\n"
" VMAGENT_CONFIG=$TRIBES_VMAGENT_SCRAPE_CONFIG\n"
" return\n"
" fi\n"
"\n"
" cat >\"$VMAGENT_CONFIG\" <<EOF\n"
"global:\n"
" scrape_interval: 15s\n"
"scrape_configs:\n"
" - job_name: node-exporter\n"
" static_configs:\n"
" - targets: [\"$TRIBES_NODE_EXPORTER_LISTEN\"]\n"
" - job_name: vinyl-exporter\n"
" static_configs:\n"
" - targets: [\"$TRIBES_VINYL_EXPORTER_LISTEN\"]\n"
"EOF\n"
"}\n"
"\n"
"write_shepherd_config() {\n"
" start_services=$(start_services_sexp)\n"
" cat >\"$SHEPHERD_CONFIG\" <<EOF\n"
"(use-modules (shepherd service))\n"
"\n"
"(register-services\n"
" (list\n"
" (service '(node-exporter)\n"
" #:documentation \"Run Prometheus node_exporter.\"\n"
" #:respawn? #t\n"
" #:start (make-forkexec-constructor\n"
" (list $(scheme_string \"$NODE_EXPORTER\")\n"
" (string-append \"--web.listen-address=\"\n"
" $(scheme_string \"$TRIBES_NODE_EXPORTER_LISTEN\")))\n"
" #:log-file $(scheme_string \"$LOG_DIR/node-exporter.log\"))\n"
" #:stop (make-kill-destructor))\n"
" (service '(vinyl)\n"
" #:documentation \"Run Vinyl Cache.\"\n"
" #:respawn? #t\n"
" #:start (make-forkexec-constructor\n"
" (list $(scheme_string \"$VINYLD\")\n"
" \"-F\"\n"
" \"-n\" $(scheme_string \"$TRIBES_VINYL_STATE_DIR\")\n"
" \"-i\" $(scheme_string \"$TRIBES_VINYL_NAME\")\n"
" \"-b\" $(scheme_string \"$TRIBES_VINYL_BACKEND\")\n"
" \"-a\" $(scheme_string \"$TRIBES_VINYL_LISTEN\")\n"
" \"-s\" $(scheme_string \"$TRIBES_VINYL_STORAGE\")\n"
" \"-p\" \"max_retries=5\")\n"
" #:log-file $(scheme_string \"$LOG_DIR/vinyl.log\"))\n"
" #:stop (make-kill-destructor))\n"
" (service '(vinyl-exporter)\n"
" #:documentation \"Run Vinyl Prometheus exporter.\"\n"
" #:requirement '(vinyl)\n"
" #:respawn? #t\n"
" #:start (make-forkexec-constructor\n"
" (list $(scheme_string \"$VINYL_EXPORTER\")\n"
" (string-append \"-web.listen-address=\" $(scheme_string \"$TRIBES_VINYL_EXPORTER_LISTEN\"))\n"
" (string-append \"-web.telemetry-path=\" $(scheme_string \"$TRIBES_VINYL_EXPORTER_METRICS_PATH\"))\n"
" (string-append \"-web.health-path=\" $(scheme_string \"$TRIBES_VINYL_EXPORTER_HEALTH_PATH\"))\n"
" (string-append \"-vinylstat.path=\" $(scheme_string \"$VINYLSTAT\"))\n"
" (string-append \"-vinyllog.path=\" $(scheme_string \"$VINYLLOG\"))\n"
" (string-append \"-vinyl.workdir=\" $(scheme_string \"$TRIBES_VINYL_STATE_DIR\"))\n"
" (string-append \"-hls.path-prefix=\" $(scheme_string \"$TRIBES_HLS_PATH_PREFIX\"))\n"
" (string-append \"-hls.stream-components=\" $(scheme_string \"$TRIBES_HLS_STREAM_COMPONENTS\"))\n"
" (string-append \"-hls.viewer-ttl=\" $(scheme_string \"$TRIBES_HLS_VIEWER_TTL\"))\n"
" \"-hls.identity.ip-fallback\"\n"
" \"-hls.identity.query-param=vsid\"\n"
" \"-hls.identity.trusted-proxy=127.0.0.1\"\n"
" \"-hls.identity.trusted-proxy=::1\")\n"
" #:log-file $(scheme_string \"$LOG_DIR/vinyl-exporter.log\"))\n"
" #:stop (make-kill-destructor))\n"
" (service '(vmagent)\n"
" #:documentation \"Run vmagent for local metrics scraping.\"\n"
" #:respawn? #t\n"
" #:start (make-forkexec-constructor\n"
" (list $(scheme_string \"$VMAGENT\")\n"
" (string-append \"-httpListenAddr=\" $(scheme_string \"$TRIBES_VMAGENT_LISTEN\"))\n"
" (string-append \"-promscrape.config=\" $(scheme_string \"$VMAGENT_CONFIG\"))\n"
" (string-append \"-remoteWrite.url=\" $(scheme_string \"$TRIBES_VMAGENT_REMOTE_WRITE_URL\"))\n"
" (string-append \"-remoteWrite.tmpDataPath=\" $(scheme_string \"$TRIBES_VMAGENT_TMP_DATA_PATH\")))\n"
" #:environment-variables\n"
" (list (string-append \"SSL_CERT_FILE=\" $(scheme_string \"$SSL_CERT_FILE\")))\n"
" #:log-file $(scheme_string \"$LOG_DIR/vmagent.log\"))\n"
" #:stop (make-kill-destructor))))\n"
"\n"
"(perform-service-action root-service 'daemonize)\n"
"(for-each (lambda (name)\n"
" (start-service (lookup-service name)))\n"
" $start_services)\n"
"EOF\n"
"}\n"
"\n"
"cmd_start() {\n"
" load_config\n"
" mkdir -p \"$RUN_DIR\" \"$STATE_DIR\" \"$LOG_DIR\" \"$TRIBES_VINYL_STATE_DIR\" \"$TRIBES_VMAGENT_TMP_DATA_PATH\"\n"
" if running; then\n"
" echo \"tribes-sender-runtime is already running ($SOCKET)\" >&2\n"
" exit 0\n"
" fi\n"
" rm -f \"$SOCKET\" \"$PID_FILE\"\n"
" write_vmagent_config\n"
" write_shepherd_config\n"
" exec \"$SHEPHERD\" -I -s \"$SOCKET\" -c \"$SHEPHERD_CONFIG\" --pid=\"$PID_FILE\" -l \"$LOG_DIR/shepherd.log\"\n"
"}\n"
"\n"
"cmd_stop() {\n"
" if running; then\n"
" if ! timeout 20 \"$HERD\" -s \"$SOCKET\" stop root; then\n"
" echo \"timed out stopping Shepherd cleanly; killing private Shepherd\" >&2\n"
" if [ -r \"$PID_FILE\" ]; then\n"
" kill \"$(cat \"$PID_FILE\")\" 2>/dev/null || true\n"
" fi\n"
" fi\n"
" else\n"
" echo \"tribes-sender-runtime is not running\" >&2\n"
" fi\n"
"}\n"
"\n"
"cmd_status() {\n"
" if running; then\n"
" \"$HERD\" -s \"$SOCKET\" status\n"
" else\n"
" echo \"tribes-sender-runtime is not running\" >&2\n"
" exit 1\n"
" fi\n"
"}\n"
"\n"
"cmd_restart() {\n"
" if ! running; then\n"
" cmd_start\n"
" fi\n"
" if [ $# -gt 0 ]; then\n"
" service=$(normalize_service \"$1\" | head -n 1)\n"
" \"$HERD\" -s \"$SOCKET\" restart \"$service\"\n"
" else\n"
" load_config\n"
" for service in $TRIBES_SENDER_SERVICES; do\n"
" for normalized in $(normalize_service \"$service\"); do\n"
" \"$HERD\" -s \"$SOCKET\" restart \"$normalized\"\n"
" done\n"
" done\n"
" fi\n"
"}\n"
"\n"
"cmd_logs() {\n"
" mkdir -p \"$LOG_DIR\"\n"
" touch \"$LOG_DIR/shepherd.log\"\n"
" tail -f \"$LOG_DIR/shepherd.log\"\n"
"}\n"
"\n"
"cmd_install_boot() {\n"
" self=${TRIBES_SENDER_RUNTIME_BIN:-/opt/tribes-sender-runtime/bin/tribes-sender-runtime}\n"
" if command -v systemctl >/dev/null 2>&1 && [ -d /etc/systemd/system ]; then\n"
" cat >/etc/systemd/system/tribes-sender-runtime.service <<EOF\n"
"[Unit]\n"
"Description=Tribes Sender Runtime\n"
"After=network-online.target\n"
"Wants=network-online.target\n"
"\n"
"[Service]\n"
"Type=oneshot\n"
"RemainAfterExit=yes\n"
"ExecStart=$self start\n"
"ExecStop=$self stop\n"
"\n"
"[Install]\n"
"WantedBy=multi-user.target\n"
"EOF\n"
" systemctl daemon-reload\n"
" systemctl enable tribes-sender-runtime.service\n"
" echo \"installed systemd boot hook: tribes-sender-runtime.service\"\n"
" elif command -v crontab >/dev/null 2>&1; then\n"
" tmp=$(mktemp)\n"
" crontab -l 2>/dev/null | grep -v 'tribes-sender-runtime start' >\"$tmp\" || true\n"
" printf '@reboot %s start\\n' \"$self\" >>\"$tmp\"\n"
" crontab \"$tmp\"\n"
" rm -f \"$tmp\"\n"
" echo \"installed crontab @reboot hook\"\n"
" else\n"
" echo \"no supported boot hook found; add this to your provider startup script:\" >&2\n"
" echo \"$self start\" >&2\n"
" fi\n"
"}\n"
"\n"
"command=${1:-}\n"
"case \"$command\" in\n"
" start) shift; cmd_start \"$@\" ;;\n"
" stop) shift; cmd_stop \"$@\" ;;\n"
" status) shift; cmd_status \"$@\" ;;\n"
" restart) shift; cmd_restart \"$@\" ;;\n"
" logs) shift; cmd_logs \"$@\" ;;\n"
" install-boot) shift; cmd_install_boot \"$@\" ;;\n"
" -h|--help|help) usage ;;\n"
" *) usage >&2; exit 2 ;;\n"
"esac\n")
port)))
(chmod (string-append bin "/tribes-sender-runtime") #o755)
(call-with-output-file (string-append share "/sender-runtime.env.example")
(lambda (port)
(display
(string-append
"TRIBES_SENDER_SERVICES=\"node-exporter vinyl vinyl-exporter vmagent\"\n"
"TRIBES_METRICS_REMOTE_WRITE_URL=\"https://cluster.example/api/v1/write\"\n"
"TRIBES_VINYL_LISTEN=\"0.0.0.0:6081\"\n"
"TRIBES_VINYL_BACKEND=\"127.0.0.1:4000\"\n"
"TRIBES_VINYL_STORAGE=\"malloc,1G\"\n"
"TRIBES_NODE_EXPORTER_LISTEN=\"127.0.0.1:9100\"\n"
"TRIBES_VINYL_EXPORTER_LISTEN=\"127.0.0.1:9131\"\n"
"TRIBES_VMAGENT_LISTEN=\"127.0.0.1:8429\"\n")
port))))))))
(inputs
(list bash-minimal coreutils grep nss-certs sed shepherd
prometheus-node-exporter victoriametrics vinyl vinyl-exporter))
(home-page "https://git.teralink.net/tribes/guix-tribes.git")
(synopsis "Launcher for external Tribes Sender runtime nodes")
(description
"This package provides the tribes-sender-runtime command, a small launcher
that starts a private GNU Shepherd supervising the runtime daemons used by
external Tribes Sender nodes.")
(license license:asl2.0)))
tribes/packages/source.scm
+23 -148
View File
@@ -26,35 +26,34 @@
fetch-npm-deps
local-tribes-package
tribes-package
tribes-plugin-api-package
tribes-mix-deps
tribes-upstream-source
tribes-source-package
tribes-source-directory->local-file))
;; Recursive sha256 of the raw deps tree produced by `mix deps.get --only prod`
;; from the current Tribes mix.lock, with git metadata minimized for SCM
;; dependencies.
;; from the current Tribes mix.lock, with git metadata stripped except for
;; .git/HEAD in SCM dependencies.
(define %tribes-raw-mix-deps-sha256
"1b6hwd2ii5323d4a4dq57dr6g5vnjn16c7bfffc7f8j6l2kmy93x")
"0xb64ffi2339771jp9b9hq8742v16qkqrqx6m8lx0a02hq877w2y")
;; Recursive sha256 of the Tribes-specific prepared deps tree, after injecting
;; the upstream secp256k1 source into the Hex package and patching its build
;; recipe to avoid build-time network access.
(define %tribes-mix-deps-sha256
"158k8zlmzv6y1abhqj20l14y172ndw1y4p5yr51jpf12a5gs4193")
"1bbs2i7fwqnl1ihalra17kh9bm34by5c0jma18ksy7cjry70xybi")
;; Recursive sha256 of assets/node_modules generated from assets/package-lock.json
;; in an isolated build environment, with local file dependencies resolved from
;; the vendored Mix dependency tree.
(define %tribes-npm-deps-sha256
"18fzdwirgsq14ncd8xy1yyiyjhp0msf5qv51zhml0rgn2lqg6rg8")
"1my46nw162265y8xh0xxfhbm3hd1d9vj3nkd9s1nrrida66siw91")
(define %tribes-home-page
"https://git.teralink.net/tribes/tribes.git")
(define %tribes-commit
"408c39553e4258dd75409eebfa0ffa4380591be0")
"2c4deb96d1b640442e04c6c650b5b9380a2381e2")
(define %tribes-revision "1")
@@ -62,7 +61,7 @@
(git-version "0.2.0" %tribes-revision %tribes-commit))
(define %tribes-source-sha256
"16xn3vs6py74z4wrclwapzh18frrp5i663clvwid4l4kmivz833y")
"1i38ci4fh25lzcwwxycq6ppzymvkkgncsva9mqxxv6ghcw31xpsz")
(define %tribes-upstream-source
(origin
@@ -309,7 +308,6 @@ resolution by injecting extra pre-fetched sources needed for offline builds."
(npm-deps-sha256 %tribes-npm-deps-sha256)
(name "tribes")
(version %tribes-version)
(admin-debug-methods? #f)
(home-page %tribes-home-page)
(synopsis "Tribes social app")
(description
@@ -317,8 +315,7 @@ resolution by injecting extra pre-fetched sources needed for offline builds."
production Elixir release using vendored Mix and npm dependency trees."))
"Return a Guix package that builds a production Tribes release from SOURCE,
using MIX-DEPS and NPM-DEPS as pre-fetched dependency trees resolved from
mix.lock and assets/package-lock.json. When ADMIN-DEBUG-METHODS? is true,
compile admin-only debug methods into the release for e2e test images."
mix.lock and assets/package-lock.json."
(let* ((mix-deps-source
(or mix-deps
(tribes-mix-deps source
@@ -388,8 +385,6 @@ compile admin-only debug methods into the release for e2e test images."
(string-append kernel-headers-dir ":"
existing-c-include-path)
kernel-headers-dir)))
(setenv "TRIBES_ADMIN_DEBUG_METHODS"
#$(if admin-debug-methods? "1" "0"))
(setenv "CC" #$(file-append gcc-toolchain "/bin/gcc"))
(setenv "CXX" #$(file-append gcc-toolchain "/bin/g++"))
(setenv "CPP"
@@ -417,15 +412,6 @@ compile admin-only debug methods into the release for e2e test images."
#~(begin
(invoke "mix" "compile")
(when (file-exists? "plugins")
(for-each
(lambda (mix-file)
(with-directory-excursion
(let ((index (string-rindex mix-file #\/)))
(if index (substring mix-file 0 index) "."))
(invoke "mix" "compile")))
(find-files "plugins" "^mix\\.exs$")))
(let ((assets-node-modules "assets/node_modules"))
(when (file-exists? assets-node-modules)
(delete-file-recursively assets-node-modules))
@@ -477,62 +463,34 @@ compile admin-only debug methods into the release for e2e test images."
(invoke "mix" "phx.digest"))
#:install-gexp
#~(begin
(use-modules (ice-9 regex))
(define otp-app-rx
(make-regexp "\"otp_app\"[[:space:]]*:[[:space:]]*\"([^\"]+)\""))
(define (port->string port)
(let loop ((chars '()))
(let ((char (read-char port)))
(if (eof-object? char)
(list->string (reverse chars))
(loop (cons char chars))))))
(define (manifest-otp-app plugin-dir fallback)
(let ((manifest-path (string-append plugin-dir "/manifest.json")))
(if (file-exists? manifest-path)
(let* ((content (call-with-input-file manifest-path port->string))
(match (regexp-exec otp-app-rx content)))
(if match (match:substring match 1) fallback))
fallback)))
(when (file-exists? "plugins/tribes_ui/mix.exs")
(with-directory-excursion "plugins/tribes_ui"
(invoke "mix" "compile")))
(invoke "mix" "release" "--path" out)
(let ((launcher (string-append out "/bin/tribes"))
(launcher-app (string-append out "/bin/tribes-app")))
(let ((launcher (string-append out "/bin/" #$name))
(launcher-app (string-append out "/bin/" #$name "-app")))
(when (file-exists? launcher)
(rename-file launcher launcher-app)))
(when (file-exists? "plugins")
(copy-recursively "plugins"
(string-append out "/plugins")
#:follow-symlinks? #t)
#:follow-symlinks? #t))
(for-each
(lambda (mix-file)
(let* ((plugin-dir
(let ((index (string-rindex mix-file #\/)))
(if index (substring mix-file 0 index) ".")))
(plugin-name
(let ((index (string-rindex plugin-dir #\/)))
(if index
(substring plugin-dir (+ index 1))
plugin-dir)))
(otp-app (manifest-otp-app plugin-dir plugin-name))
(compiled-ebin
(string-append "_build/prod/lib/" otp-app "/ebin"))
(plugin-ebin
(string-append out "/plugins/" plugin-name "/ebin")))
(when (file-exists? compiled-ebin)
(copy-recursively compiled-ebin
plugin-ebin
#:follow-symlinks? #t))))
(find-files "plugins" "^mix\\.exs$")))))))
(let ((tribes-ui-ebin "_build/prod/lib/tribes_ui/ebin")
(tribes-ui-out (string-append out "/plugins/tribes_ui/ebin")))
(when (file-exists? tribes-ui-ebin)
(when (file-exists? tribes-ui-out)
(delete-file-recursively tribes-ui-out))
(mkdir-p (dirname tribes-ui-out))
(copy-recursively tribes-ui-ebin
tribes-ui-out
#:follow-symlinks? #t)))))))
(define* (local-tribes-package directory
#:key
(version "dev")
(admin-debug-methods? #f)
(mix-deps-sha256 #f)
(raw-mix-deps-sha256 #f)
(npm-deps-sha256 #f))
@@ -542,95 +500,12 @@ package pin."
(tribes-source-package
(tribes-source-directory->local-file directory)
#:version version
#:admin-debug-methods? admin-debug-methods?
#:mix-deps-sha256 (or mix-deps-sha256 %tribes-mix-deps-sha256)
#:raw-mix-deps-sha256
(or raw-mix-deps-sha256 %tribes-raw-mix-deps-sha256)
#:npm-deps-sha256
(or npm-deps-sha256 %tribes-npm-deps-sha256)))
(define (tribes-plugin-api-source source version)
"Return the tribes_plugin_api subproject source, with the root lockfile copied
beside its mix.exs for offline dependency resolution."
(computed-file
(string-append "tribes-plugin-api-source-" version)
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(define source #+source)
(copy-recursively (string-append source "/tribes_plugin_api")
#$output
#:follow-symlinks? #t)
(copy-file (string-append source "/mix.lock")
(string-append #$output "/mix.lock"))))))
(define* (tribes-plugin-api-package-from-source source
#:key
(mix-deps #f)
(mix-deps-sha256
%tribes-mix-deps-sha256)
(raw-mix-deps-sha256
%tribes-raw-mix-deps-sha256)
(version "0.1.0"))
"Return a Guix package for the standalone tribes_plugin_api Mix package."
(let* ((api-source (tribes-plugin-api-source source version))
(mix-deps-source
(or mix-deps
(tribes-mix-deps source
#:name "tribes-plugin-api-mix-deps"
#:version version
#:sha256 mix-deps-sha256
#:raw-sha256 raw-mix-deps-sha256))))
(mix:mix-release-package
api-source
#:mix-fod-deps mix-deps-source
#:name "tribes-plugin-api"
#:version version
#:home-page %tribes-home-page
#:synopsis "Public API package for Tribes plugins"
#:description
"tribes_plugin_api is the public compile-time contract for Tribes plugins."
#:license license:asl2.0
#:native-inputs (list gcc-toolchain gnu-make linux-libre-headers)
#:path-inputs (list gcc-toolchain gnu-make)
#:setup-gexp
#~(begin
(define kernel-headers-dir
#$(file-append linux-libre-headers "/include"))
(let ((existing-cpath (getenv "CPATH")))
(setenv "CPATH"
(if existing-cpath
(string-append kernel-headers-dir ":" existing-cpath)
kernel-headers-dir)))
(let ((existing-c-include-path (getenv "C_INCLUDE_PATH")))
(setenv "C_INCLUDE_PATH"
(if existing-c-include-path
(string-append kernel-headers-dir ":"
existing-c-include-path)
kernel-headers-dir)))
(setenv "CC" #$(file-append gcc-toolchain "/bin/gcc"))
(setenv "CXX" #$(file-append gcc-toolchain "/bin/g++")))
#:configure-gexp
#~(invoke "mix" "deps.compile" "--skip-umbrella-children")
#:build-gexp
#~(invoke "mix" "compile" "--no-protocol-consolidation")
#:install-gexp
#~(begin
(use-modules (guix build utils))
(let ((source-dir "_build/prod/lib/tribes_plugin_api")
(target-dir (string-append out "/lib/tribes_plugin_api")))
(mkdir-p (dirname target-dir))
(copy-recursively source-dir target-dir #:follow-symlinks? #t)
(for-each
(lambda (path)
(when (file-exists? path)
(delete-file-recursively path)))
(find-files target-dir "^(consolidated|\\.mix)$" #:directories? #t #:stat lstat)))))))
(define tribes-package
(tribes-source-package %tribes-upstream-source
#:version %tribes-version))
(define tribes-plugin-api-package
(tribes-plugin-api-package-from-source %tribes-upstream-source))
tribes/packages/web.scm
+90 -93
View File
@@ -2,14 +2,13 @@
#:use-module (gnu packages)
#:use-module (gnu packages bash)
#:use-module (gnu packages base)
#:use-module (gnu packages compression)
#:use-module (gnu packages crypto)
#:use-module (gnu packages curl)
#:use-module (gnu packages jemalloc)
#:use-module (gnu packages libevent)
#:use-module (gnu packages linux)
#:use-module (gnu packages lua)
#:use-module (gnu packages lsof)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages python-xyz)
@@ -18,7 +17,6 @@
#:use-module (gnu packages tls)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix base32)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (guix download)
#:use-module (guix gexp)
@@ -26,88 +24,97 @@
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (tribes packages go)
#:export (aws-lc-for-haproxy
haproxy
#:export (hitch
vinyl
lego))
(define-public aws-lc-for-haproxy
(define-public hitch
(package
(name "aws-lc")
(version "1.73.0")
(source
(origin
(method url-fetch)
(uri (string-append "https://codeload.github.com/aws/aws-lc/tar.gz/refs/tags/v"
version))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "1qycxd03bvj3wlbb0r6518k3r0fqi0hbcs0gj0xb5mq9gngfhfp3"))))
(build-system cmake-build-system)
(native-inputs (list perl))
(arguments
(list
#:configure-flags
#~(list "-DBUILD_SHARED_LIBS=ON"
"-DBUILD_TESTING=OFF"
"-DDISABLE_GO=ON")
#:tests? #f))
(home-page "https://github.com/aws/aws-lc")
(synopsis "General purpose cryptographic library for HAProxy")
(description "AWS-LC contains portable C implementations of cryptographic
algorithms needed for TLS and common applications, with optimized assembly
versions for x86 and ARM. This variant is kept in guix-tribes for HAProxy
QUIC support.")
(license license:asl2.0)))
(define-public haproxy
(package
(name "haproxy")
(version "3.3.10")
(source
(origin
(method url-fetch)
(uri (string-append "https://www.haproxy.org/download/"
(version-major+minor version)
"/src/haproxy-" version ".tar.gz"))
(sha256
(base32 "1wlid1j3xdg99xldsha6026ilpxkxjh5vr0axwb58mrs7yhikaba"))))
(name "hitch")
(version "1.8.0")
(home-page "https://hitch-tls.org/")
(build-system gnu-build-system)
(arguments
(list
#:tests? #f ; there are only regression tests, using varnishtest
#:make-flags
#~(list "LUA_LIB_NAME=lua"
"TARGET=linux-glibc"
"USE_LUA=1"
"USE_OPENSSL_AWSLC=1"
"USE_PCRE2=1"
"USE_PCRE2_JIT=1"
"USE_PROMEX=1"
"USE_QUIC=1"
"USE_ZLIB=1"
(string-append "CC=" #$(cc-for-target))
(string-append "DOCDIR=" #$output "/share/" #$name)
(string-append "LUA_INC=" #$(this-package-input "lua") "/include")
(string-append "LUA_LIB=" #$(this-package-input "lua") "/lib")
(string-append "SSL_INC=" #$(this-package-input "aws-lc") "/include")
(string-append "SSL_LIB=" #$(this-package-input "aws-lc") "/lib")
(string-append "PREFIX=" #$output))
#:phases
#~(modify-phases %standard-phases
(delete 'configure))))
`(#:phases
(modify-phases %standard-phases
(add-before 'check 'pre-check
(lambda _
;; Our grep is compiled without perl regexp support. Rewrite the
;; command to not use it. Literal tabs are supported only in perl
;; regexps, so inject one with printf instead.
(substitute* "src/tests/test32-proxy-authority.sh"
(("grep -Pq") "grep -q")
(("extension:\\\\tdefault")
"extension:$(printf '\\011')default"))
;; Most tests attempt to access hitch-tls.org, which is
;; unavailable in the build container. Run them against a dummy
;; local web server instead.
(for-each (lambda (test)
(substitute* test
(("\\[hitch-tls\\.org\\]:80")
"[localhost]:8000")))
(find-files "src/tests" "\\.sh$"))
;; This test still relies on live external DNS/backend behavior
;; via HOSTALIASES and is too environment-dependent for a
;; reproducible build.
(substitute* "src/tests/test25-dynamic-backend-address.sh"
(("\\. hitch_test\\.sh")
". hitch_test.sh\nskip \"dynamic backend address test requires live external backends\""))
;; The build container does not reap zombie processes, causing
;; stop_hitch to hang indefinitely while waiting for the process
;; to terminate because 'kill -0' never succeeds. Use a
;; different test to see whether the process has shut down.
(substitute* "src/tests/hitch_test.sh"
(("kill -0 \"\\$HITCH_PID\"")
"$(ps -p $HITCH_PID -o state= | grep -qv '^Z$')"))))
(replace 'check
(lambda* (#:key tests? #:allow-other-keys)
(if (not tests?)
#t
(dynamic-wind
(lambda ()
;; Keep the dummy backend out of the build log pipe and
;; tear it down explicitly after the suite so the daemon
;; can observe EOF and finalize the derivation.
(system* (which "sh") "-c"
"python3 -m http.server >/dev/null 2>&1 & echo $! > .guix-hitch-test-http-server.pid")
(invoke "sleep" "1"))
(lambda ()
(invoke "make" "check"))
(lambda ()
(when (file-exists? ".guix-hitch-test-http-server.pid")
(system* (which "sh") "-c"
"kill $(cat .guix-hitch-test-http-server.pid) >/dev/null 2>&1 || true")
(delete-file ".guix-hitch-test-http-server.pid"))))))))))
(source
(origin
(method url-fetch)
(uri (string-append "https://hitch-tls.org/source/hitch-"
version
".tar.gz"))
(sha256
(base32 "0klg2pfsbhjdabjv52i0gfjfv23r45n4vs3965xa5zkzpj299jfz"))))
(native-inputs
(list pkg-config
;; For tests.
curl
grep
lsof
procps
python))
(inputs
(list aws-lc-for-haproxy libxcrypt lua pcre2 zlib))
(home-page "https://www.haproxy.org/")
(synopsis "Reliable, high performance TCP/HTTP load balancer")
(description "HAProxy offers @acronym{HA, high availability}, load
balancing, and proxying for TCP and HTTP-based applications. It is particularly
suited to Web sites crawling under very high loads while needing persistence or
Layer 7 processing. Supporting tens of thousands of connections is clearly
realistic with today's hardware.")
(license (list license:gpl2+
license:lgpl2.1
license:lgpl2.1+))))
(list libev openssl))
(synopsis "Scalable TLS proxy")
(description
"Hitch is a performant TLS proxy based on @code{libev}. It terminates
SSL/TLS connections and forwards the unencrypted traffic to a backend such
as a web server. It is designed to handle many thousand connections on
multicore machines.")
(license license:bsd-2)))
(define-public vinyl
(package
@@ -130,10 +137,6 @@ realistic with today's hardware.")
(list "CFLAGS+=-fexcess-precision=standard"))
'())
(list
;; Vinyl's upstream integration suite is very large and can take hours
;; in constrained builders. Keep channel substitute builds focused on
;; producing the runtime package; exercise service behavior separately.
#:tests? #f
#:configure-flags
#~(list (string-append "LDFLAGS=-Wl,-rpath=" #$output "/lib")
(string-append "CC=" #$(cc-for-target))
@@ -141,19 +144,11 @@ realistic with today's hardware.")
(string-append "PTHREAD_CC="
(search-input-file %build-inputs
"/bin/gcc"))
;; The runtime package does not build docs or man pages below,
;; but upstream still probes for these documentation tools.
"--with-rst2man=true"
"--with-rst2html=true"
"--with-sphinx-build=true"
"--localstatedir=/var")
#:phases
#~(modify-phases %standard-phases
(add-after 'unpack 'use-absolute-file-names
(lambda _
(substitute* "Makefile.in"
(("^SUBDIRS = include lib bin vmod etc doc man contrib")
"SUBDIRS = include lib bin vmod etc contrib"))
(substitute* '("bin/vinyltest/vtc_vinyl.c"
"bin/vinyltest/vtest2/src/vtc_process.c"
"bin/vinyltest/vtest2/src/vtc_haproxy.c"
@@ -190,7 +185,9 @@ realistic with today's hardware.")
(,(dirname
(search-input-file inputs "lib/libc.so")))))))))))
(native-inputs
(list pkg-config))
(list pkg-config
python-sphinx
python-docutils))
(inputs
(list bash-minimal
coreutils-minimal
tribes/plugins/aether.scm
+21 -25
View File
@@ -16,21 +16,21 @@
%aether-home-page)
(define %aether-commit
"80101b7e78808cea9151f1827777edea5c08ba1f")
"5d6ab457ef1795867663b7d061268cd89d248d3d")
(define %aether-revision "1")
(define %aether-version
(git-version "0.2.0" %aether-revision %aether-commit))
(git-version "0.1.0" %aether-revision %aether-commit))
(define %aether-source-sha256
"0shylw4s75djanqm7h82j8advjg96im6n4wr6fz6kwbj5hs8aq4b")
"1g095pk6gmlsvhpj5738g4g8vai8d8w8r29lzkrk7qc8bs9ahwm9")
(define %aether-mix-deps-sha256
"1pk1qv8skbgzi0wg59zj9aiyxx2hxl2k6ngxqqbwvj7wsbiz95bb")
"008s3k3ry3jy13q1gx7l5i0ygr012xqybm8l0zaf1cxbx6mw9nfr")
(define %aether-npm-deps-sha256
"10cwajh8yfdfd9znhibnbali1i8bk7wxrviih03n67lfkmxmghz2")
"0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
(define %aether-source
(origin
@@ -44,8 +44,6 @@
(define* (aether-package-from-source source
#:key
(host-package tribes-package)
(reuse-host-libs? #t)
(host-source tribes-upstream-source)
(mix-deps-sha256 %aether-mix-deps-sha256)
(asset-deps-sha256 %aether-npm-deps-sha256)
@@ -53,8 +51,6 @@
"Build the pinned Aether source as an external Tribes plugin artifact."
(tribes-plugin-package
source
#:host-package host-package
#:reuse-host-libs? reuse-host-libs?
#:host-source host-source
#:mix-deps-sha256 mix-deps-sha256
#:build-assets? #t
@@ -66,13 +62,7 @@
#:synopsis "Aether timeline UI plugin for Tribes"
#:description
"External Tribes plugin artifact for Aether, packaged as a Guix-managed
plugin directory."
#:plugin-id "org.tribe-one.plugins.aether"
#:plugin-slug "aether"
#:display-name "Aether"
#:provides '("org.tribe-one.caps.social@1" "org.tribe-one.caps.chat@1")
#:requires '("org.tribe-one.caps.ui@1")
#:enhances-with '()))
plugin directory."))
(define aether-package
(aether-package-from-source %aether-source))
@@ -102,18 +92,24 @@ artifact."
#:synopsis "Aether timeline UI plugin for Tribes"
#:description
"External Tribes plugin artifact for Aether, packaged as a Guix-managed
plugin directory."
#:plugin-id "org.tribe-one.plugins.aether"
#:plugin-slug "aether"
#:display-name "Aether"
#:provides '("org.tribe-one.caps.social@1" "org.tribe-one.caps.chat@1")
#:requires '("org.tribe-one.caps.ui@1")
#:enhances-with '()))
plugin directory."))
(define* (aether-plugin-definition #:key (package aether-package))
"Return the channel-owned plugin definition for Aether."
(tribes-plugin-definition-from-package package))
(tribes-plugin-definition
(name "aether")
(package-name "tribes-plugin-aether")
(version "0.1.0")
(synopsis "Aether timeline UI plugin for Tribes")
(home-page %aether-home-page)
(provides '("aether@1"))
(requires '("ecto@1" "phoenix@1"))
(external-plugin (aether-external-plugin #:package package))))
(define* (aether-external-plugin #:key package)
"Return the channel-owned Guix integration record for the Aether plugin."
(tribes-external-plugin-from-package package))
(tribes-external-plugin
(name "aether")
(package package)
(extra-packages '())
(extra-services (lambda (_node-config) '()))))
tribes/plugins/built-ins.scm
-54
View File
@@ -1,54 +0,0 @@
(define-module (tribes plugins built-ins)
#:use-module (srfi srfi-1)
#:use-module (tribes packages plugins)
#:export (guix-tribes-host-definition
guix-tribes-built-in-plugin-definitions
guix-tribes-runtime-plugin-definitions
guix-tribes-runtime-provided-capabilities
guix-tribes-runtime-required-capabilities
guix-tribes-runtime-missing-capabilities))
;; These records mirror the manifests shipped by the pinned Tribes package.
;; Package assembly still validates the actual release manifests; these records
;; let rollout preview use the same host/built-in capability model before a new
;; release closure has been built.
(define guix-tribes-host-definition
(tribes-plugin-definition
(name "org.tribe-one.hosts.tribes")
(package-name "tribes")
(version "0.2.0")
(synopsis "Tribes host plugin API foundation")
(home-page "https://git.teralink.net/tribes/tribes")
(provides '())
(requires '("org.tribe-one.caps.ui@1"))
(external-plugin #f)))
(define guix-tribes-built-in-plugin-definitions
(list
(tribes-plugin-definition
(name "tribes_ui")
(package-name "tribes")
(version "0.1.0")
(synopsis "Default Tribes UI capability provider")
(home-page "https://git.teralink.net/tribes/tribes")
(provides '("org.tribe-one.caps.ui@1"))
(requires '())
(external-plugin #f))))
(define guix-tribes-runtime-plugin-definitions
(cons guix-tribes-host-definition
guix-tribes-built-in-plugin-definitions))
(define guix-tribes-runtime-provided-capabilities
(tribes-plugin-definitions-provided-capabilities
guix-tribes-runtime-plugin-definitions))
(define guix-tribes-runtime-required-capabilities
(tribes-plugin-definitions-required-capabilities
guix-tribes-runtime-plugin-definitions))
(define guix-tribes-runtime-missing-capabilities
(filter (lambda (capability)
(not (member capability guix-tribes-runtime-provided-capabilities)))
guix-tribes-runtime-required-capabilities))
tribes/plugins/discovery.scm
-129
View File
@@ -1,129 +0,0 @@
(define-module (tribes plugins discovery)
#:use-module (gnu packages)
#:use-module (guix discovery)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:use-module (tribes packages plugins)
#:export (tribes-plugin-packages
tribes-plugin-definitions
tribes-plugin-catalog-payload
tribes-plugin-definition-by-name
tribes-plugin-external-plugin-by-name))
(define (json-object? value)
(and (list? value) (every pair? value)))
(define (json-ref object key)
(and (json-object? object)
(let ((entry (assoc key object)))
(and entry (cdr entry)))))
(define (string-list value)
(cond
((and (list? value) (every string? value)) value)
((vector? value) (string-list (vector->list value)))
(else '())))
(define (plugin-metadata package)
(let ((metadata (assoc-ref (package-properties package) 'tribes-plugin)))
(and (json-object? metadata) metadata)))
(define (plugin-extra-packages package)
(let ((value (assoc-ref (package-properties package)
'tribes-plugin-extra-packages)))
(if (list? value) value '())))
(define (plugin-extra-services package)
(let ((value (assoc-ref (package-properties package)
'tribes-plugin-extra-services)))
(if (procedure? value) value (lambda (_node-config) '()))))
(define (metadata-name metadata)
(or (json-ref metadata "slug")
(json-ref metadata "name")))
(define (metadata-package-name metadata package)
(or (json-ref metadata "package")
(package-name package)))
(define (plugin-module-path-entry directory)
(and (string? directory)
(file-exists? (string-append directory "/tribes/plugins"))
(cons directory "tribes/plugins")))
(define (plugin-package-module-path)
(delete-duplicates
(filter-map plugin-module-path-entry %load-path)
equal?))
(define (plugin-package-modules)
(all-modules (plugin-package-module-path)))
(define (tribes-plugin-packages)
"Return all packages in the current Guix channel environment that advertise
Tribes plugin metadata through the 'tribes-plugin package property."
(sort
(fold-packages
(lambda (package acc)
(if (plugin-metadata package)
(cons package acc)
acc))
'()
(plugin-package-modules))
(lambda (left right)
(string<? (or (metadata-name (plugin-metadata left)) (package-name left))
(or (metadata-name (plugin-metadata right)) (package-name right))))))
(define (package->catalog-entry package)
(let* ((metadata (plugin-metadata package))
(name (metadata-name metadata)))
`(("id" . ,(or (json-ref metadata "id") name))
("name" . ,name)
("slug" . ,name)
("displayName" . ,(or (json-ref metadata "displayName") name))
("package" . ,(metadata-package-name metadata package))
("version" . ,(or (json-ref metadata "version")
(package-version package)))
("synopsis" . ,(or (json-ref metadata "synopsis")
(package-synopsis package)))
("homePage" . ,(or (json-ref metadata "homePage")
(package-home-page package)))
("hostApi" . ,(or (json-ref metadata "hostApi") "1"))
("provides" . ,(list->vector (string-list (json-ref metadata "provides"))))
("requires" . ,(list->vector (string-list (json-ref metadata "requires"))))
("enhancesWith" . ,(list->vector (string-list (json-ref metadata "enhancesWith")))))))
(define (tribes-plugin-catalog-payload)
(let ((plugins (map package->catalog-entry (tribes-plugin-packages))))
`(("schemaVersion" . "2")
("plugins" . ,(list->vector plugins)))))
(define (package->plugin-definition package)
(let* ((metadata (plugin-metadata package))
(plugin-name (metadata-name metadata)))
(tribes-plugin-definition
(name plugin-name)
(package-name (metadata-package-name metadata package))
(version (or (json-ref metadata "version") (package-version package)))
(synopsis (or (json-ref metadata "synopsis") (package-synopsis package)))
(home-page (or (json-ref metadata "homePage") (package-home-page package)))
(provides (string-list (json-ref metadata "provides")))
(requires (string-list (json-ref metadata "requires")))
(external-plugin
(tribes-external-plugin
(name plugin-name)
(package package)
(extra-packages (plugin-extra-packages package))
(extra-services (plugin-extra-services package)))))))
(define (tribes-plugin-definitions)
(map package->plugin-definition (tribes-plugin-packages)))
(define (tribes-plugin-definition-by-name name)
(find (lambda (definition)
(string=? (tribes-plugin-definition-name definition) name))
(tribes-plugin-definitions)))
(define (tribes-plugin-external-plugin-by-name name)
(let ((definition (tribes-plugin-definition-by-name name)))
(and definition (tribes-plugin-definition-external-plugin definition))))
tribes/plugins/kobold.scm
-118
View File
@@ -1,118 +0,0 @@
(define-module (tribes plugins kobold)
#:use-module (guix git-download)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (tribes packages plugins)
#:use-module (tribes packages source)
#:export (kobold-package
kobold-plugin-definition
kobold-external-plugin
local-kobold-package))
(define %kobold-home-page
"https://git.teralink.net/tribes/tribes-plugin-kobold")
(define %kobold-source-url
%kobold-home-page)
(define %kobold-commit
"74b6c44e4dcfbeaf02f77620b5675f11781ad1eb")
(define %kobold-revision "1")
(define %kobold-version
(git-version "0.1.0" %kobold-revision %kobold-commit))
(define %kobold-source-sha256
"1xxysbslh1fa57873n4669mi874byv861w934mz9g3zszr120ijn")
(define %kobold-mix-deps-sha256
"1pk1qv8skbgzi0wg59zj9aiyxx2hxl2k6ngxqqbwvj7wsbiz95bb")
(define %kobold-npm-deps-sha256
"1mzf6ld6br2y7x3lb67jpis9y5lis1r01ldmdqvf4lhrrfvrzrlb")
(define %kobold-source
(origin
(method git-fetch)
(uri (git-reference
(url %kobold-source-url)
(commit %kobold-commit)))
(file-name (git-file-name "tribes-plugin-kobold" %kobold-version))
(sha256
(base32 %kobold-source-sha256))))
(define* (kobold-package-from-source source
#:key
(host-package tribes-package)
(reuse-host-libs? #t)
(host-source tribes-upstream-source)
(mix-deps-sha256 %kobold-mix-deps-sha256)
(asset-deps-sha256 %kobold-npm-deps-sha256)
(version %kobold-version))
"Build the pinned Kobold source as an external Tribes plugin artifact."
(tribes-plugin-package
source
#:host-package host-package
#:reuse-host-libs? reuse-host-libs?
#:host-source host-source
#:mix-deps-sha256 mix-deps-sha256
#:build-assets? #t
#:digest-assets? #t
#:asset-deps-sha256 asset-deps-sha256
#:name "tribes-plugin-kobold"
#:version version
#:home-page %kobold-home-page
#:synopsis "Distributed dataset plugin for Tribes"
#:description
"External Tribes plugin artifact for Kobold distributed datasets,
packaged as a Guix-managed plugin directory."
#:plugin-id "org.tribe-one.plugins.kobold"
#:plugin-slug "kobold"
#:display-name "Kobold"
#:provides '("org.tribes.kobold.dataset@1")
#:requires '("org.tribe-one.caps.ui@1" "org.tribes.alliance.trust@1")
#:enhances-with '()))
(define kobold-package
(kobold-package-from-source %kobold-source))
(define* (local-kobold-package directory
#:key
host-source
host-source-directory
(build-assets? #t)
(digest-assets? #t)
(mix-deps-sha256 %kobold-mix-deps-sha256)
(asset-deps-sha256 %kobold-npm-deps-sha256)
(version "dev"))
"Build a local checkout of tribes-plugin-kobold as an external plugin artifact."
(local-tribes-plugin-package
directory
#:host-source host-source
#:host-source-directory host-source-directory
#:mix-deps-sha256 mix-deps-sha256
#:build-assets? build-assets?
#:digest-assets? digest-assets?
#:asset-deps-sha256 asset-deps-sha256
#:name "tribes-plugin-kobold"
#:version version
#:home-page %kobold-home-page
#:synopsis "Distributed dataset plugin for Tribes"
#:description
"External Tribes plugin artifact for Kobold distributed datasets,
packaged as a Guix-managed plugin directory."
#:plugin-id "org.tribe-one.plugins.kobold"
#:plugin-slug "kobold"
#:display-name "Kobold"
#:provides '("org.tribes.kobold.dataset@1")
#:requires '("org.tribe-one.caps.ui@1" "org.tribes.alliance.trust@1")
#:enhances-with '()))
(define* (kobold-plugin-definition #:key (package kobold-package))
"Return the channel-owned plugin definition for Kobold."
(tribes-plugin-definition-from-package package))
(define* (kobold-external-plugin #:key package)
"Return the channel-owned Guix integration record for the Kobold plugin."
(tribes-external-plugin-from-package package))
tribes/plugins/registry.scm
+6 -6
View File
@@ -1,12 +1,11 @@
(define-module (tribes plugins registry)
#:use-module (tribes packages plugins)
#:use-module (tribes plugins aether)
#:use-module (tribes plugins kobold)
#:use-module (tribes plugins sender)
#:use-module (tribes plugins supertest)
#:use-module (tribes plugins trust)
#:use-module (srfi srfi-1)
#:export (guix-tribes-plugin-definition-by-name
#:export (guix-tribes-plugin-catalog
guix-tribes-plugin-definition-by-name
guix-tribes-plugin-definitions
guix-tribes-external-plugins
guix-tribes-plugin-substitute-packages))
@@ -14,10 +13,11 @@
(define guix-tribes-plugin-definitions
(list
(aether-plugin-definition)
(kobold-plugin-definition)
(sender-plugin-definition)
(supertest-plugin-definition)
(trust-plugin-definition)))
(supertest-plugin-definition)))
(define guix-tribes-plugin-catalog
(tribes-plugin-catalog-file guix-tribes-plugin-definitions))
(define (guix-tribes-external-plugins)
(map tribes-plugin-definition-external-plugin
tribes/plugins/sender.scm
+22 -34
View File
@@ -2,8 +2,8 @@
#:use-module (guix git-download)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (gnu packages video)
#:use-module (tribes packages plugins)
#:use-module (tribes packages sender-runtime)
#:use-module (tribes packages source)
#:export (sender-package
sender-plugin-definition
@@ -17,7 +17,7 @@
%sender-home-page)
(define %sender-commit
"ee7d0ac29fb583e1c5f75001984622c2ba7e56b1")
"1f3df4c8ed13ec3d2abdc542d34246b50c397da1")
(define %sender-revision "1")
@@ -25,13 +25,13 @@
(git-version "0.1.0" %sender-revision %sender-commit))
(define %sender-source-sha256
"1bbgi20j99ym9yiv78w3j590wpf400bdkfiqf9s1ra31dgfzzq4v")
"1gq4kag3q9iz17j8a4hqg07v9pw2b6lgrbssb0bxkfqk3zl07ckj")
(define %sender-mix-deps-sha256
"08mdy38247dqni8f84y09m8vz6hvjakvc4ml28x1jxqvq53s4nq3")
"0dacj6c9mhxw37ykksjbhmnsqdhrwpkfsbswm68d2wvcwchqazw9")
(define %sender-npm-deps-sha256
"1ksryrfzhs2jdlq4prj04725i5fcdvhslamfzl77i7knsh5sclfd")
"1inziz2028pidg5xag40qqrlpigbvs23jirm41in7d58avlmxmh7")
(define %sender-source
(origin
@@ -45,8 +45,6 @@
(define* (sender-package-from-source source
#:key
(host-package tribes-package)
(reuse-host-libs? #t)
(host-source tribes-upstream-source)
(mix-deps-sha256 %sender-mix-deps-sha256)
(asset-deps-sha256 %sender-npm-deps-sha256)
@@ -54,13 +52,8 @@
"Build the pinned Sender source as an external Tribes plugin artifact."
(tribes-plugin-package
source
#:host-package host-package
#:reuse-host-libs? reuse-host-libs?
#:host-source host-source
#:mix-deps-sha256 mix-deps-sha256
#:include-mix-deps? #t
#:compile-mix-deps '("elixir_make" "muontrap")
#:native-deps? #t
#:build-assets? #t
#:digest-assets? #t
#:asset-deps-sha256 asset-deps-sha256
@@ -70,14 +63,7 @@
#:synopsis "RTMP ingest and HLS streaming plugin for Tribes"
#:description
"External Tribes plugin artifact for RTMP ingest and HLS streaming,
packaged as a Guix-managed plugin directory."
#:plugin-id "org.tribe-one.plugins.sender"
#:plugin-slug "sender"
#:display-name "Sender"
#:provides '("org.tribe-one.caps.sender@1")
#:requires '("org.tribe-one.caps.ui@1")
#:enhances-with '("org.tribe-one.caps.chat@1")
#:extra-packages (list sender-ffmpeg)))
packaged as a Guix-managed plugin directory."))
(define sender-package
(sender-package-from-source %sender-source))
@@ -98,9 +84,6 @@ artifact."
#:host-source host-source
#:host-source-directory host-source-directory
#:mix-deps-sha256 mix-deps-sha256
#:include-mix-deps? #t
#:compile-mix-deps '("elixir_make" "muontrap")
#:native-deps? #t
#:build-assets? build-assets?
#:digest-assets? digest-assets?
#:asset-deps-sha256 asset-deps-sha256
@@ -110,19 +93,24 @@ artifact."
#:synopsis "RTMP ingest and HLS streaming plugin for Tribes"
#:description
"External Tribes plugin artifact for RTMP ingest and HLS streaming,
packaged as a Guix-managed plugin directory."
#:plugin-id "org.tribe-one.plugins.sender"
#:plugin-slug "sender"
#:display-name "Sender"
#:provides '("org.tribe-one.caps.sender@1")
#:requires '("org.tribe-one.caps.ui@1")
#:enhances-with '("org.tribe-one.caps.chat@1")
#:extra-packages (list sender-ffmpeg)))
packaged as a Guix-managed plugin directory."))
(define* (sender-plugin-definition #:key (package sender-package))
"Return the channel-owned plugin definition for Sender."
(tribes-plugin-definition-from-package package))
(tribes-plugin-definition
(name "sender")
(package-name "tribes-plugin-sender")
(version "0.1.0")
(synopsis "RTMP ingest and HLS streaming plugin for Tribes")
(home-page %sender-home-page)
(provides '("streaming@1"))
(requires '("ecto@1" "ui@1"))
(external-plugin (sender-external-plugin #:package package))))
(define* (sender-external-plugin #:key (package sender-package))
(define* (sender-external-plugin #:key package)
"Return the channel-owned Guix integration record for the Sender plugin."
(tribes-external-plugin-from-package package))
(tribes-external-plugin
(name "sender")
(package package)
(extra-packages (list ffmpeg))
(extra-services (lambda (_node-config) '()))))
tribes/plugins/supertest.scm
+20 -24
View File
@@ -16,18 +16,18 @@
%supertest-home-page)
(define %supertest-commit
"afc38412c4362ea2e5b1fe9fe08f1cffe60edf34")
"e042f3265db7a40d4d558132800238c6d466e8dd")
(define %supertest-revision "1")
(define %supertest-version
(git-version "0.1.1" %supertest-revision %supertest-commit))
(git-version "0.1.0" %supertest-revision %supertest-commit))
(define %supertest-source-sha256
"1si0bis5k47j22cv7cbbah86ilrxvrbncld4isvyb17zan7ig0q6")
"1rv844pnvqpc6yzcyg6qb013vbyfg8kipr6mdxkb17434djsmn1c")
(define %supertest-mix-deps-sha256
"1pk1qv8skbgzi0wg59zj9aiyxx2hxl2k6ngxqqbwvj7wsbiz95bb")
"0dacj6c9mhxw37ykksjbhmnsqdhrwpkfsbswm68d2wvcwchqazw9")
(define %supertest-npm-deps-sha256
#f)
@@ -44,16 +44,12 @@
(define* (supertest-package-from-source source
#:key
(host-package tribes-package)
(reuse-host-libs? #t)
(host-source tribes-upstream-source)
(mix-deps-sha256 %supertest-mix-deps-sha256)
(version %supertest-version))
"Build the pinned Supertest source as an external Tribes plugin artifact."
(tribes-plugin-package
source
#:host-package host-package
#:reuse-host-libs? reuse-host-libs?
#:host-source host-source
#:mix-deps-sha256 mix-deps-sha256
#:build-assets? #f
@@ -63,13 +59,7 @@
#:home-page %supertest-home-page
#:synopsis "Supertest fixture plugin for Tribes"
#:description
"External Tribes plugin artifact used by live rollout and sync tests."
#:plugin-id "org.tribe-one.plugins.supertest"
#:plugin-slug "supertest"
#:display-name "Supertest"
#:provides '()
#:requires '()
#:enhances-with '()))
"External Tribes plugin artifact used by live rollout and sync tests."))
(define supertest-package
(supertest-package-from-source %supertest-source))
@@ -93,18 +83,24 @@
#:home-page %supertest-home-page
#:synopsis "Supertest fixture plugin for Tribes"
#:description
"External Tribes plugin artifact used by live rollout and sync tests."
#:plugin-id "org.tribe-one.plugins.supertest"
#:plugin-slug "supertest"
#:display-name "Supertest"
#:provides '()
#:requires '()
#:enhances-with '()))
"External Tribes plugin artifact used by live rollout and sync tests."))
(define* (supertest-plugin-definition #:key (package supertest-package))
"Return the channel-owned plugin definition for Supertest."
(tribes-plugin-definition-from-package package))
(tribes-plugin-definition
(name "supertest")
(package-name "tribes-plugin-supertest")
(version "0.1.0")
(synopsis "Supertest fixture plugin for Tribes")
(home-page %supertest-home-page)
(provides '("supertest@1"))
(requires '("ecto@1"))
(external-plugin (supertest-external-plugin #:package package))))
(define* (supertest-external-plugin #:key package)
"Return the channel-owned Guix integration record for the Supertest plugin."
(tribes-external-plugin-from-package package))
(tribes-external-plugin
(name "supertest")
(package package)
(extra-packages '())
(extra-services (lambda (_node-config) '()))))
tribes/plugins/trust.scm
-116
View File
@@ -1,116 +0,0 @@
(define-module (tribes plugins trust)
#:use-module (guix git-download)
#:use-module (guix packages)
#:use-module (guix utils)
#:use-module (tribes packages plugins)
#:use-module (tribes packages source)
#:export (trust-package
trust-plugin-definition
trust-external-plugin
local-trust-package))
(define %trust-home-page
"https://git.teralink.net/tribes/tribes-plugin-trust")
(define %trust-source-url
%trust-home-page)
(define %trust-commit
"f08af20cd5cd2dbbb50e4472bf1a5d8ed1b73c21")
(define %trust-revision "1")
(define %trust-version
(git-version "0.1.0" %trust-revision %trust-commit))
(define %trust-source-sha256
"1zsg57mr3bjxrxvim77z2as1jqr8a3anfp0jgqz0ycz6rzai58dp")
(define %trust-mix-deps-sha256
"1pk1qv8skbgzi0wg59zj9aiyxx2hxl2k6ngxqqbwvj7wsbiz95bb")
(define %trust-npm-deps-sha256
"145cwhyqknf51fqsqv1qj3l5b7bymwwxj4dlg3mpqd6nxd0x003c")
(define %trust-source
(origin
(method git-fetch)
(uri (git-reference
(url %trust-source-url)
(commit %trust-commit)))
(file-name (git-file-name "tribes-plugin-trust" %trust-version))
(sha256
(base32 %trust-source-sha256))))
(define* (trust-package-from-source source
#:key
(host-package tribes-package)
(reuse-host-libs? #t)
(host-source tribes-upstream-source)
(mix-deps-sha256 %trust-mix-deps-sha256)
(asset-deps-sha256 %trust-npm-deps-sha256)
(version %trust-version))
"Build the pinned Trust source as an external Tribes plugin artifact."
(tribes-plugin-package
source
#:host-package host-package
#:reuse-host-libs? reuse-host-libs?
#:host-source host-source
#:mix-deps-sha256 mix-deps-sha256
#:build-assets? #t
#:digest-assets? #t
#:asset-deps-sha256 asset-deps-sha256
#:name "tribes-plugin-trust"
#:version version
#:home-page %trust-home-page
#:synopsis "Tribe-to-tribe trust and federation plugin for Tribes"
#:description
"External Tribes plugin artifact for tribe-to-tribe trust, alliance, and federation provider behavior."
#:plugin-id "org.tribe-one.plugins.trust"
#:plugin-slug "trust"
#:display-name "Trust"
#:provides '("org.tribes.alliance.trust@1" "org.tribes.federation.provider@1" "org.tribes.access.trust_provider@1")
#:requires '("org.tribe-one.caps.ui@1")
#:enhances-with '()))
(define trust-package
(trust-package-from-source %trust-source))
(define* (local-trust-package directory
#:key
host-source
host-source-directory
(build-assets? #t)
(digest-assets? #t)
(mix-deps-sha256 %trust-mix-deps-sha256)
(asset-deps-sha256 %trust-npm-deps-sha256)
(version "dev"))
"Build a local checkout of tribes-plugin-trust as an external plugin artifact."
(local-tribes-plugin-package
directory
#:host-source host-source
#:host-source-directory host-source-directory
#:mix-deps-sha256 mix-deps-sha256
#:build-assets? build-assets?
#:digest-assets? digest-assets?
#:asset-deps-sha256 asset-deps-sha256
#:name "tribes-plugin-trust"
#:version version
#:home-page %trust-home-page
#:synopsis "Tribe-to-tribe trust and federation plugin for Tribes"
#:description
"External Tribes plugin artifact for tribe-to-tribe trust, alliance, and federation provider behavior."
#:plugin-id "org.tribe-one.plugins.trust"
#:plugin-slug "trust"
#:display-name "Trust"
#:provides '("org.tribes.alliance.trust@1" "org.tribes.federation.provider@1" "org.tribes.access.trust_provider@1")
#:requires '("org.tribe-one.caps.ui@1")
#:enhances-with '()))
(define* (trust-plugin-definition #:key (package trust-package))
"Return the channel-owned plugin definition for Trust."
(tribes-plugin-definition-from-package package))
(define* (trust-external-plugin #:key package)
"Return the channel-owned Guix integration record for the Trust plugin."
(tribes-external-plugin-from-package package))
tribes/services/chrony.scm
-177
View File
@@ -1,177 +0,0 @@
(define-module (tribes services chrony)
#:use-module (gnu packages admin)
#:use-module (gnu packages ntp)
#:use-module (gnu services)
#:use-module (gnu services networking)
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:export (chrony-configuration
chrony-configuration?
chrony-configuration-package
chrony-configuration-servers
chrony-configuration-user
chrony-configuration-group
chrony-configuration-state-directory
chrony-configuration-runtime-directory
chrony-configuration-makestep?
chrony-configuration-makestep-threshold
chrony-configuration-makestep-limit
chrony-configuration-extra-config
chrony-configuration-extra-options
chrony-config-text
chrony-config-file
chrony-service-type))
(define-record-type* <chrony-configuration>
chrony-configuration make-chrony-configuration
chrony-configuration?
(package chrony-configuration-package
(default chrony))
(servers chrony-configuration-servers
(default %ntp-servers))
(user chrony-configuration-user
(default "chrony"))
(group chrony-configuration-group
(default "chrony"))
(state-directory chrony-configuration-state-directory
(default "/var/lib/chrony"))
(runtime-directory chrony-configuration-runtime-directory
(default "/var/run/chrony"))
(makestep? chrony-configuration-makestep?
(default #t))
(makestep-threshold chrony-configuration-makestep-threshold
(default "0.1"))
(makestep-limit chrony-configuration-makestep-limit
(default 3))
(extra-config chrony-configuration-extra-config
(default ""))
(extra-options chrony-configuration-extra-options
(default '())))
(define %chrony-server-types
'(pool server peer))
(define (flatten-options options)
(reverse
(let loop ((values options)
(result '()))
(if (list? values)
(fold loop result values)
(cons (format #f "~a" values) result)))))
(define (chrony-server->string server)
(let ((type (ntp-server-type server))
(address (ntp-server-address server))
(options (ntp-server-options server)))
(unless (memq type %chrony-server-types)
(error "Invalid Chrony server type" type))
(string-join
(cons* (symbol->string type)
address
(flatten-options options)))))
(define (ensure-trailing-newline text)
(if (or (string-null? text)
(string-suffix? "\n" text))
text
(string-append text "\n")))
(define (chrony-config-text config)
(string-append
(string-join
(map chrony-server->string
(chrony-configuration-servers config))
"\n")
"\n"
(if (chrony-configuration-makestep? config)
(format #f "makestep ~a ~a\n"
(chrony-configuration-makestep-threshold config)
(chrony-configuration-makestep-limit config))
"")
"driftfile "
(chrony-configuration-state-directory config)
"/chrony.drift\n"
"keyfile "
(chrony-configuration-state-directory config)
"/chrony.keys\n"
(ensure-trailing-newline
(chrony-configuration-extra-config config))))
(define (chrony-config-file config)
(plain-file "chrony.conf" (chrony-config-text config)))
(define (chrony-accounts config)
(list
(user-group
(name (chrony-configuration-group config))
(system? #t))
(user-account
(name (chrony-configuration-user config))
(group (chrony-configuration-group config))
(system? #t)
(comment "Chrony daemon user")
(home-directory (chrony-configuration-state-directory config))
(shell (file-append shadow "/sbin/nologin")))))
(define (chrony-activation config)
#~(begin
(use-modules (guix build utils))
(define (ensure-file file mode uid gid)
(unless (file-exists? file)
(call-with-output-file file
(lambda _
#t)))
(chown file uid gid)
(chmod file mode))
(let* ((user #$(chrony-configuration-user config))
(group #$(chrony-configuration-group config))
(state-directory #$(chrony-configuration-state-directory config))
(runtime-directory #$(chrony-configuration-runtime-directory config))
(uid (passwd:uid (getpwnam user)))
(gid (group:gid (getgrnam group))))
(for-each mkdir-p (list state-directory runtime-directory))
(for-each (lambda (directory)
(chown directory uid gid)
(chmod directory #o750))
(list state-directory runtime-directory))
(ensure-file (string-append state-directory "/chrony.drift")
#o640 uid gid)
(ensure-file (string-append state-directory "/chrony.keys")
#o640 0 gid))))
(define (chrony-shepherd-services config)
(let ((config-file (chrony-config-file config)))
(list
(shepherd-service
(documentation "Run the Chrony NTP daemon.")
(provision '(chronyd))
(requirement '(user-processes networking))
(actions (list (shepherd-configuration-action config-file)))
(start
#~(make-forkexec-constructor
(list #$(file-append (chrony-configuration-package config)
"/sbin/chronyd")
"-n"
"-u" #$(chrony-configuration-user config)
"-f" #$config-file
#$@(chrony-configuration-extra-options config))
#:log-file "/var/log/chronyd.log"))
(stop #~(make-kill-destructor))))))
(define chrony-service-type
(service-type
(name 'chrony)
(extensions
(list (service-extension account-service-type chrony-accounts)
(service-extension activation-service-type chrony-activation)
(service-extension shepherd-root-service-type
chrony-shepherd-services)
(service-extension profile-service-type
(compose list chrony-configuration-package))))
(default-value (chrony-configuration))
(description "Run Chrony to synchronize the system clock with NTP servers.")))
tribes/services/haproxy.scm
-236
View File
@@ -1,236 +0,0 @@
(define-module (tribes services haproxy)
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#: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 (haproxy-configuration
haproxy-configuration?
haproxy-configuration-package
haproxy-configuration-backend
haproxy-configuration-frontends
haproxy-configuration-quic-frontends
haproxy-configuration-http-frontends
haproxy-configuration-acme-backend
haproxy-configuration-pem-files
haproxy-configuration-user
haproxy-configuration-group
haproxy-configuration-runtime-dir
haproxy-configuration-extra-global
haproxy-configuration-extra-defaults
haproxy-configuration-extra-frontend
haproxy-configuration-open-files-soft-limit
haproxy-configuration-open-files-hard-limit
haproxy-service-type))
(define-record-type* <haproxy-configuration>
haproxy-configuration make-haproxy-configuration
haproxy-configuration?
(package haproxy-configuration-package
(default haproxy))
(backend haproxy-configuration-backend
(default "127.0.0.1:6081"))
(frontends haproxy-configuration-frontends
(default '("0.0.0.0:443" "[::]:443 v6only")))
(quic-frontends haproxy-configuration-quic-frontends
(default '("quic4@0.0.0.0:443"
"quic6@[::]:443 v6only")))
(http-frontends haproxy-configuration-http-frontends
(default '()))
(acme-backend haproxy-configuration-acme-backend
(default #f))
(pem-files haproxy-configuration-pem-files
(default '()))
(user haproxy-configuration-user
(default "haproxy"))
(group haproxy-configuration-group
(default "haproxy"))
(runtime-dir haproxy-configuration-runtime-dir
(default "/var/run/haproxy"))
(extra-global haproxy-configuration-extra-global
(default '()))
(extra-defaults haproxy-configuration-extra-defaults
(default '()))
(extra-frontend haproxy-configuration-extra-frontend
(default '()))
(open-files-soft-limit haproxy-configuration-open-files-soft-limit
(default 32768))
(open-files-hard-limit haproxy-configuration-open-files-hard-limit
(default 65535)))
(define %haproxy-accounts
(list
(user-group
(name "haproxy")
(system? #t))
(user-account
(name "haproxy")
(group "haproxy")
(system? #t)
(comment "HAProxy service user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
(define (haproxy-indent line)
(string-append " " line "\n"))
(define (haproxy-lines lines)
(string-concatenate (map haproxy-indent lines)))
(define (haproxy-http-frontend http-frontends acme-backend)
(if (null? http-frontends)
""
(string-append
"frontend tribes_http\n"
(haproxy-lines
(append
(map (lambda (frontend)
(string-append "bind " frontend))
http-frontends)
(if acme-backend
'("acl acme_challenge path_beg /.well-known/acme-challenge/"
"http-request redirect scheme https code 308 unless acme_challenge"
"use_backend lego_acme if acme_challenge")
'("http-request redirect scheme https code 308"))))
"\n"
(if acme-backend
(string-append
"backend lego_acme\n"
(haproxy-lines
(list (string-append "server lego " acme-backend)))
"\n")
""))))
(define (haproxy-config-file config)
(match config
(($ <haproxy-configuration> _ backend frontends quic-frontends http-frontends
acme-backend pem-files user group runtime-dir
extra-global extra-defaults extra-frontend)
(plain-file
"haproxy.conf"
(string-append
"global\n"
(haproxy-lines
(append
(list "log /dev/log local0"
(string-append "user " user)
(string-append "group " group)
"maxconn 32768"
(string-append "stats socket " runtime-dir
"/admin.sock mode 660 level admin expose-fd listeners")
"tune.ssl.default-dh-param 2048")
extra-global))
"\n"
"defaults\n"
(haproxy-lines
(append
'("log global"
"mode http"
"option httplog"
"option dontlognull"
"option forwardfor"
"timeout connect 5s"
"timeout client 50s"
"timeout server 50s")
extra-defaults))
"\n"
(haproxy-http-frontend http-frontends acme-backend)
"frontend tribes_tls\n"
(haproxy-lines
(append
(append-map
(lambda (frontend)
(map
(lambda (pem-file)
(string-append "bind " frontend
" ssl crt " pem-file
" alpn h2,http/1.1"))
pem-files))
frontends)
(append-map
(lambda (frontend)
(map
(lambda (pem-file)
(string-append "bind " frontend
" ssl crt " pem-file
" alpn h3"))
pem-files))
quic-frontends)
'("http-response set-header alt-svc 'h3=\":443\"; ma=86400'")
'("default_backend tribes_edge_cache")
extra-frontend))
"\n"
"backend tribes_edge_cache\n"
(haproxy-lines
(list (string-append "server vinyl " backend " check"))))))))
(define (haproxy-activation config)
(let ((runtime-dir (haproxy-configuration-runtime-dir config))
(user (haproxy-configuration-user config))
(group (haproxy-configuration-group config)))
#~(begin
(use-modules (guix build utils))
(mkdir-p #$runtime-dir)
(let ((uid (passwd:uid (getpwnam #$user)))
(gid (group:gid (getgrnam #$group))))
(chown #$runtime-dir uid gid)))))
(define (haproxy-resource-limits config)
`((nofile
,(haproxy-configuration-open-files-soft-limit config)
,(haproxy-configuration-open-files-hard-limit config))))
(define (haproxy-reload-procedure package config-file)
#~(lambda (running)
(and (zero? (system* #$(file-append package "/sbin/haproxy")
"-c"
"-f"
#$config-file))
(begin
(kill (process-id running) SIGUSR2)
#t))))
(define (haproxy-shepherd-services config)
(let ((config-file (haproxy-config-file config))
(package (haproxy-configuration-package config)))
(list
(shepherd-service
(documentation "Run HAProxy as the Tribes TLS edge proxy.")
(provision '(haproxy))
(requirement '(user-processes networking))
(start
#~(make-forkexec-constructor
(list #$(file-append package "/sbin/haproxy")
"-W"
"-db"
"-f"
#$config-file)
#:resource-limits '#$(haproxy-resource-limits config)))
(stop #~(make-kill-destructor))
(actions
(list
(shepherd-action
(name 'reload)
(documentation "Validate configuration and reload HAProxy.")
(procedure (haproxy-reload-procedure package config-file)))))))))
(define haproxy-service-type
(service-type
(name 'haproxy)
(extensions
(list (service-extension account-service-type
(const %haproxy-accounts))
(service-extension activation-service-type
haproxy-activation)
(service-extension shepherd-root-service-type
haproxy-shepherd-services)
(service-extension profile-service-type
(compose list haproxy-configuration-package))))
(default-value (haproxy-configuration))
(description "Run HAProxy as a TLS proxy.")))
tribes/services/hitch.scm
+149
View File
@@ -0,0 +1,149 @@
(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)
#:use-module (guix gexp)
#: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?
hitch-configuration-package
hitch-configuration-backend
hitch-configuration-frontends
hitch-configuration-pem-files
hitch-configuration-ciphers
hitch-configuration-user
hitch-configuration-group
hitch-configuration-pid-file
hitch-configuration-ocsp-dir
hitch-configuration-extra-config
hitch-configuration-open-files-soft-limit
hitch-configuration-open-files-hard-limit
hitch-service-type))
(define-record-type* <hitch-configuration>
hitch-configuration make-hitch-configuration
hitch-configuration?
(package hitch-configuration-package
(default hitch))
(backend hitch-configuration-backend
(default "[127.0.0.1]:6081"))
(frontends hitch-configuration-frontends
(default '("[0.0.0.0]:443" "[::]:443")))
(pem-files hitch-configuration-pem-files
(default '()))
(ciphers hitch-configuration-ciphers
(default "EECDH+AESGCM:EDH+AESGCM:AES256+EECDH:AES256+EDH"))
(user hitch-configuration-user
(default "hitch"))
(group hitch-configuration-group
(default "hitch"))
(pid-file hitch-configuration-pid-file
(default "/var/run/hitch/hitch.pid"))
(ocsp-dir hitch-configuration-ocsp-dir
(default "/var/cache/hitch/ocsp"))
(extra-config hitch-configuration-extra-config
(default '()))
(open-files-soft-limit hitch-configuration-open-files-soft-limit
(default 32768))
(open-files-hard-limit hitch-configuration-open-files-hard-limit
(default 65535)))
(define %hitch-accounts
(list
(user-group
(name "hitch")
(system? #t))
(user-account
(name "hitch")
(group "hitch")
(system? #t)
(comment "Hitch TLS proxy user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
(define (hitch-config-file config)
(match config
(($ <hitch-configuration> _ backend frontends pem-files ciphers user group
pid-file ocsp-dir extra-config)
(plain-file
"hitch.conf"
(string-append
"backend = \"" backend "\"\n"
(string-concatenate
(map (lambda (frontend)
(string-append "frontend = \"" frontend "\"\n"))
frontends))
(string-concatenate
(map (lambda (pem-file)
(string-append "pem-file = \"" pem-file "\"\n"))
pem-files))
"ciphers = \"" ciphers "\"\n"
"user = \"" user "\"\n"
"group = \"" group "\"\n"
"ocsp-dir = \"" ocsp-dir "\"\n"
(string-concatenate
(map (lambda (line)
(string-append line "\n"))
extra-config)))))))
(define (hitch-activation config)
#~(begin
(use-modules (guix build utils))
(mkdir-p "/var/run/hitch")
(mkdir-p #$(hitch-configuration-ocsp-dir config))))
(define (hitch-reload-procedure package)
#~(lambda _
(zero? (system* #$(file-append procps "/bin/pkill")
"-HUP"
"-x"
"hitch"))))
(define (hitch-resource-limits config)
`((nofile
,(hitch-configuration-open-files-soft-limit config)
,(hitch-configuration-open-files-hard-limit config))))
(define (hitch-shepherd-services config)
(let ((config-file (hitch-config-file config))
(package (hitch-configuration-package config)))
(list
(shepherd-service
(documentation "Run the Hitch TLS proxy.")
(provision '(hitch))
(requirement '(user-processes networking))
(start
#~(make-forkexec-constructor
(list #$(file-append package "/sbin/hitch")
"--config"
#$config-file)
#:resource-limits '#$(hitch-resource-limits config)))
(stop #~(make-kill-destructor))
(actions
(list
(shepherd-action
(name 'reload)
(documentation "Reload Hitch certificates and listeners.")
(procedure (hitch-reload-procedure package)))))))))
(define hitch-service-type
(service-type
(name 'hitch)
(extensions
(list (service-extension account-service-type
(const %hitch-accounts))
(service-extension activation-service-type
hitch-activation)
(service-extension shepherd-root-service-type
hitch-shepherd-services)
(service-extension profile-service-type
(compose list hitch-configuration-package))))
(default-value (hitch-configuration))
(description "Run the Hitch TLS proxy.")))
tribes/services/logging.scm
-225
View File
@@ -1,225 +0,0 @@
(define-module (tribes services logging)
#:use-module (gnu services)
#:use-module (gnu services admin)
#:use-module (gnu services base)
#:use-module (gnu services shepherd)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (tribes packages logging)
#:export (tribes-system-logging-configuration
tribes-system-logging-configuration?
tribes-system-logging-configuration-package
tribes-system-logging-configuration-jsonl-path
tribes-system-logging-configuration-persist-file
tribes-system-logging-configuration-control-socket
tribes-system-logging-configuration-pid-file
tribes-system-logging-configuration-tailed-log-files
tribes-system-logging-configuration-native-program-log-files
tribes-system-logging-config-text
tribes-system-logging-config-file
tribes-system-logging-service-type
tribes-base-services))
(define %default-tailed-log-files
'(("tribes" . "/var/log/tribes.log")
("tribes-migrations" . "/var/log/tribes-migrations.log")
("tribes-local-control" . "/var/log/tribes-local-control.log")
("prometheus-node-exporter" . "/var/log/prometheus-node-exporter.log")
("victoria-metrics" . "/var/log/victoria-metrics.log")
("vmagent" . "/var/log/vmagent.log")
("vinyl-tribes-edge" . "/var/log/vinyl-tribes-edge.log")
("vinyl-exporter" . "/var/log/vinyl-exporter.log")
("lego" . "/var/log/lego.log")
("tang" . "/var/log/tang.log")))
(define %default-native-program-log-files
'(("chronyd" . "/var/log/chronyd.log")
("haproxy" . "/var/log/haproxy.log")
("postgres" . "/var/log/postgresql.log")))
(define-record-type* <tribes-system-logging-configuration>
tribes-system-logging-configuration make-tribes-system-logging-configuration
tribes-system-logging-configuration?
(package tribes-system-logging-configuration-package
(default syslog-ng-minimal))
(jsonl-path tribes-system-logging-configuration-jsonl-path
(default "/var/log/tribes-combined.jsonl"))
(persist-file tribes-system-logging-configuration-persist-file
(default "/var/lib/syslog-ng/syslog-ng.persist"))
(control-socket tribes-system-logging-configuration-control-socket
(default "/var/run/syslog-ng.ctl"))
(pid-file tribes-system-logging-configuration-pid-file
(default "/var/run/syslog-ng.pid"))
(tailed-log-files tribes-system-logging-configuration-tailed-log-files
(default %default-tailed-log-files))
(native-program-log-files
tribes-system-logging-configuration-native-program-log-files
(default %default-native-program-log-files)))
(define (syslog-ng-quote value)
(call-with-output-string
(lambda (port)
(write value port))))
(define (syslog-ng-id prefix value)
(string-append
prefix
"_"
(list->string
(map (lambda (char)
(if (or (char-alphabetic? char)
(char-numeric? char))
char
#\_))
(string->list value)))))
(define (syslog-ng-source-file-stanza entry)
(match entry
((program . path)
(format #f
"source ~a { file(~a flags(no-parse) program_override(~a) default-facility(local0) default-priority(info) follow-freq(1)); };\n"
(syslog-ng-id "s_file" program)
(syslog-ng-quote path)
(syslog-ng-quote program)))))
(define (syslog-ng-source-name entry)
(match entry
((program . _path)
(syslog-ng-id "s_file" program))))
(define (syslog-ng-native-program-log-stanza entry)
(match entry
((program . path)
(let ((id (syslog-ng-id "native" program)))
(format #f
"filter f_~a { program(~a); };\ndestination d_~a { file(~a template(t_plain)); };\nlog { source(s_sys); filter(f_~a); destination(d_~a); };\n"
id
(syslog-ng-quote program)
id
(syslog-ng-quote path)
id
id)))))
(define (tribes-system-logging-config-text config)
(let ((jsonl-path (tribes-system-logging-configuration-jsonl-path config))
(tail-files (tribes-system-logging-configuration-tailed-log-files config))
(native-program-logs
(tribes-system-logging-configuration-native-program-log-files config)))
(string-append
"@version: 4.10\n"
"@include \"scl.conf\"\n\n"
"options {\n"
" chain_hostnames(no);\n"
" create_dirs(yes);\n"
" dir_perm(0755);\n"
" group(\"root\");\n"
" keep_hostname(yes);\n"
" owner(\"root\");\n"
" perm(0640);\n"
" stats(freq(0));\n"
" use_dns(no);\n"
"};\n\n"
"source s_sys {\n"
" unix-dgram(\"/dev/log\");\n"
" internal();\n"
" file(\"/proc/kmsg\" program_override(\"kernel\"));\n"
"};\n\n"
(string-concatenate (map syslog-ng-source-file-stanza tail-files))
"\n"
"template t_plain { template(\"${ISODATE} ${HOST} ${PROGRAM}[${PID}]: ${MESSAGE}\\n\"); };\n"
"template t_json { template(\"$(format-json timestamp=${ISODATE} host=${HOST} program=${PROGRAM} pid=${PID} facility=${FACILITY} severity=${LEVEL} message=${MESSAGE})\\n\"); };\n\n"
"destination d_combined_jsonl { file("
(syslog-ng-quote jsonl-path)
" template(t_json) group(\"tribes\") perm(0640)); };\n"
"destination d_messages { file(\"/var/log/messages\" template(t_plain)); };\n"
"destination d_debug { file(\"/var/log/debug\" template(t_plain)); };\n"
"destination d_secure { file(\"/var/log/secure\" template(t_plain)); };\n\n"
"filter f_messages { level(info..emerg); };\n"
"filter f_debug { level(debug); };\n"
"filter f_secure { facility(auth, authpriv); };\n"
"filter f_kmsg_shepherd { program(\"kernel\") and message(\"^[0-9]+\\\\.[0-9]+\\\\] shepherd\\\\[1\\\\]:\"); };\n"
"filter f_not_kmsg_shepherd { not filter(f_kmsg_shepherd); };\n"
"rewrite r_kmsg_shepherd { subst(\"^[0-9]+\\\\.[0-9]+\\\\] shepherd\\\\[1\\\\]: ?\", \"\", value(\"MESSAGE\")); set(\"shepherd\", value(\"PROGRAM\")); set-severity(\"notice\"); };\n\n"
"log { source(s_sys); filter(f_not_kmsg_shepherd); destination(d_combined_jsonl); };\n"
"log { source(s_sys); filter(f_not_kmsg_shepherd); filter(f_messages); destination(d_messages); };\n"
"log { source(s_sys); filter(f_not_kmsg_shepherd); filter(f_debug); destination(d_debug); };\n"
"log { source(s_sys); filter(f_not_kmsg_shepherd); filter(f_secure); destination(d_secure); };\n"
"log { source(s_sys); filter(f_kmsg_shepherd); rewrite(r_kmsg_shepherd); destination(d_combined_jsonl); destination(d_messages); };\n"
(string-concatenate
(map (lambda (entry)
(format #f
"log { source(~a); destination(d_combined_jsonl); };\nlog { source(~a); filter(f_messages); destination(d_messages); };\nlog { source(~a); filter(f_debug); destination(d_debug); };\n"
(syslog-ng-source-name entry)
(syslog-ng-source-name entry)
(syslog-ng-source-name entry)))
tail-files))
"\n"
(string-concatenate
(map syslog-ng-native-program-log-stanza native-program-logs)))))
(define (tribes-system-logging-config-file config)
(plain-file "syslog-ng.conf"
(tribes-system-logging-config-text config)))
(define (logging-activation config)
#~(begin
(use-modules (guix build utils))
(define (ensure-file path)
(mkdir-p (dirname path))
(unless (file-exists? path)
(call-with-output-file path (const #t)))
(chmod path #o640))
(define (ensure-combined-jsonl path)
(ensure-file path)
(let ((group (getgrnam "tribes")))
(chown path 0 (group:gid group))))
(mkdir-p "/var/lib/syslog-ng")
(mkdir-p "/var/log")
(ensure-combined-jsonl #$(tribes-system-logging-configuration-jsonl-path config))
(for-each ensure-file
'#$(append (list "/var/log/messages"
"/var/log/debug"
"/var/log/secure")
(map cdr (tribes-system-logging-configuration-tailed-log-files config))
(map cdr (tribes-system-logging-configuration-native-program-log-files config))))))
(define (syslog-ng-shepherd-services config)
(let ((config-file (tribes-system-logging-config-file config))
(package (tribes-system-logging-configuration-package config)))
(list
(shepherd-service
(documentation "Run syslog-ng for system, service, and Tribes JSONL logs.")
(provision '(syslogd syslog-ng))
(requirement '(user-processes))
(actions (list (shepherd-configuration-action config-file)))
(start
#~(make-forkexec-constructor
(list #$(file-append package "/sbin/syslog-ng")
"--foreground"
"--cfgfile" #$config-file
"--persist-file" #$(tribes-system-logging-configuration-persist-file config)
"--control" #$(tribes-system-logging-configuration-control-socket config)
"--pidfile" #$(tribes-system-logging-configuration-pid-file config))))
(stop #~(make-kill-destructor))))))
(define tribes-system-logging-service-type
(service-type
(name 'tribes-system-logging)
(extensions
(list (service-extension activation-service-type logging-activation)
(service-extension shepherd-root-service-type
syslog-ng-shepherd-services)
(service-extension profile-service-type
(compose list
tribes-system-logging-configuration-package))))
(default-value (tribes-system-logging-configuration))
(description "Run syslog-ng and produce conventional plus Tribes JSONL logs.")))
(define (tribes-base-services)
(append
(list (service tribes-system-logging-service-type))
(modify-services %base-services
(delete shepherd-system-log-service-type))))
tribes/services/tribes.scm
+24 -117
View File
@@ -4,28 +4,25 @@
#:use-module (gnu services databases)
#:use-module (gnu services shepherd)
#:use-module (gnu packages admin)
#:use-module (gnu packages linux)
#:use-module (gnu packages rsync)
#:use-module (gnu packages rust-apps)
#:use-module (gnu packages tmux)
#:use-module (gnu packages video)
#:use-module (gnu packages vim)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (tribes packages cli)
#:use-module (tribes packages plugins)
#:use-module (tribes packages sender-runtime)
#:use-module (tribes plugins registry)
#:use-module (tribes packages terminals)
#:export (tribes-configuration
tribes-configuration?
tribes-configuration-package
tribes-configuration-plugins
tribes-configuration-disabled-plugins
tribes-configuration-plugin-catalog
tribes-configuration-user
tribes-configuration-group
tribes-configuration-working-directory
@@ -45,6 +42,7 @@
tribes-configuration-sync-tls-cacertfile
tribes-configuration-host-manifest
tribes-configuration-admin-pubkeys
tribes-configuration-sync-overlap-seconds
tribes-configuration-database-user
tribes-configuration-database-name
tribes-configuration-parrhesia-database-name
@@ -68,8 +66,8 @@
(default #f))
(plugins tribes-configuration-plugins
(default '()))
(disabled-plugins tribes-configuration-disabled-plugins
(default '()))
(plugin-catalog tribes-configuration-plugin-catalog
(default #f))
(user tribes-configuration-user
(default "tribes"))
(group tribes-configuration-group
@@ -108,6 +106,8 @@
(default #f))
(admin-pubkeys tribes-configuration-admin-pubkeys
(default '()))
(sync-overlap-seconds tribes-configuration-sync-overlap-seconds
(default 300))
(database-user tribes-configuration-database-user
(default "tribes"))
(database-name tribes-configuration-database-name
@@ -131,19 +131,12 @@
(extra-environment-variables tribes-configuration-extra-environment-variables
(default '()))
(log-file tribes-configuration-log-file
(default "/var/log/tribes.log"))
(default "/var/log/tribes/tribes.log"))
(open-files-soft-limit tribes-configuration-open-files-soft-limit
(default 32768))
(open-files-hard-limit tribes-configuration-open-files-hard-limit
(default 65535)))
(define %tribes-loopback-release-node
"tribes@127.0.0.1")
(define %tribes-loopback-release-erlang-flags
(string-append "-kernel inet_dist_use_interface {127,0,0,1} "
"inet_dist_listen_min 4370 inet_dist_listen_max 4379"))
(define (tribes-accounts config)
(list
(user-group
@@ -194,7 +187,7 @@
(define (tribes-release-node config)
(or (tribes-configuration-release-node config)
%tribes-loopback-release-node))
(string-append "tribes@" (tribes-configuration-host config))))
(define (tribes-effective-package config)
(let ((package (tribes-configuration-package config))
@@ -210,6 +203,10 @@
(and package
(file-append package "/plugins")))))
(define (tribes-effective-plugin-catalog config)
(or (tribes-configuration-plugin-catalog config)
guix-tribes-plugin-catalog))
(define (tribes-deploy-directory config)
(string-append (tribes-configuration-working-directory config) "/deploy"))
@@ -238,51 +235,21 @@
" #:system-facts-file \"/etc/tribes/system-facts.json\")))\n"))
(define (tribes-migrations-log-file _config)
"/var/log/tribes-migrations.log")
"/var/log/tribes/tribes-migrations.log")
(define (tribes-plugin-profile-packages config)
(append-map tribes-external-plugin-extra-packages
(tribes-configuration-plugins config)))
(define (tribes-runtime-binary-directories config)
(map (lambda (package)
(file-append package "/bin"))
(delete-duplicates
(filter identity
(append (list (tribes-effective-package config)
inotify-tools)
(tribes-plugin-profile-packages config))))))
(define (tribes-profile-package-by-name packages name)
(find (lambda (package)
(string=? (package-name package) name))
packages))
(define (tribes-sender-ffmpeg-package config)
(or (tribes-profile-package-by-name
(tribes-plugin-profile-packages config)
(package-name sender-ffmpeg))
(tribes-profile-package-by-name
(tribes-plugin-profile-packages config)
(package-name ffmpeg))))
(define (tribes-launcher config command args)
(define package
(tribes-effective-package config))
(define distribution
(tribes-configuration-release-distribution config))
(define launch-distribution
(if (string=? command "start") distribution "none"))
(define sender-ffmpeg-package
(tribes-sender-ffmpeg-package config))
(define env-setters
(append
(list
#~(setenv "HOME" #$(tribes-configuration-working-directory config))
#~(setenv "TRIBES_STATE_DIR" #$(tribes-configuration-working-directory config))
#~(setenv "TRIBES_LOG_JSONL_PATH" "/var/log/tribes-combined.jsonl")
#~(setenv "FILESYSTEM_FSINOTIFY_EXECUTABLE_FILE"
#$(file-append inotify-tools "/bin/inotifywait"))
#~(setenv "PHX_SERVER" "true")
#~(setenv "PORT" #$(number->string
(tribes-configuration-listen-port config)))
@@ -296,8 +263,6 @@
config
(tribes-configuration-parrhesia-database-name config)))
#~(setenv "PARRHESIA_RELAY_URL" #$(tribes-relay-url config))
#~(setenv "PARRHESIA_POOL_SIZE" "30")
#~(setenv "PARRHESIA_READ_POOL_SIZE" "30")
#~(setenv "TRIBES_SYNC_HOST" #$(tribes-sync-host config))
#~(setenv "TRIBES_SYNC_PORT"
#$(number->string
@@ -305,10 +270,12 @@
#~(setenv "TRIBES_SYNC_BIND_ADDRESS"
#$(tribes-configuration-sync-bind-address config))
#~(setenv "TRIBES_PLUGIN_DIR" #$(tribes-effective-plugin-directory config))
#~(setenv "TRIBES_DISABLED_PLUGINS"
#$(string-join (tribes-configuration-disabled-plugins config) ","))
#~(setenv "TRIBES_PLUGIN_CATALOG" #$(tribes-effective-plugin-catalog config))
#~(setenv "TRIBES_LOCAL_CONTROL_SOCKET"
#$(tribes-local-control-socket-file config))
#~(setenv "TRIBES_SYNC_OVERLAP_SECONDS"
#$(number->string
(tribes-configuration-sync-overlap-seconds config)))
#~(setenv "TRIBES_ADMIN_PUBKEYS"
#$(string-join
(tribes-configuration-admin-pubkeys config)
@@ -319,27 +286,12 @@
;; application startup. Use interactive mode so packaged external
;; plugins can be loaded after a rollout switches the service profile.
#~(setenv "RELEASE_MODE" "interactive")
#~(setenv "RELEASE_DISTRIBUTION" #$launch-distribution)
#~(setenv "RELEASE_DISTRIBUTION" #$distribution)
#~(setenv "SSL_CERT_DIR" "/etc/ssl/certs")
#~(setenv "SSL_CERT_FILE" "/etc/ssl/certs/ca-certificates.crt")
#~(let ((existing-path (or (getenv "PATH") "")))
(setenv "PATH"
(string-join
(if (string-null? existing-path)
(list #$@(tribes-runtime-binary-directories config))
(append (list #$@(tribes-runtime-binary-directories config))
(list existing-path)))
":"))))
(if sender-ffmpeg-package
(list #~(setenv "SENDER_FFMPEG_EXECUTABLE"
#$(file-append sender-ffmpeg-package "/bin/ffmpeg")))
'())
(if (string=? launch-distribution "none")
#~(setenv "SSL_CERT_FILE" "/etc/ssl/certs/ca-certificates.crt"))
(if (string=? distribution "none")
'()
(list
#~(setenv "RELEASE_NODE" #$(tribes-release-node config))
#~(setenv "ERL_EPMD_ADDRESS" "127.0.0.1")
#~(setenv "ERL_AFLAGS" #$%tribes-loopback-release-erlang-flags)))
(list #~(setenv "RELEASE_NODE" #$(tribes-release-node config))))
(if (tribes-configuration-listen-address config)
(list #~(setenv "BIND_ADDRESS"
#$(tribes-configuration-listen-address config)))
@@ -379,7 +331,6 @@
(string-append "tribes-" command)
#~(begin
(use-modules (ice-9 textual-ports)
(srfi srfi-1)
(srfi srfi-13))
(define (read-secret path)
@@ -438,9 +389,9 @@
(let* ((user (getpwnam #$(tribes-configuration-user config)))
(uid (passwd:uid user))
(gid (passwd:gid user))
(log-dir (dirname #$(tribes-configuration-log-file config)))
(dirs (append
(list #$(tribes-configuration-working-directory config)
(dirname #$(tribes-configuration-log-file config))
(dirname #$(tribes-configuration-secret-key-base-file config))
(dirname #$(tribes-configuration-release-cookie-file config))
(dirname #$(tribes-configuration-token-signing-secret-file config)))
@@ -459,9 +410,6 @@
(mkdir-p dir)
(chown dir uid gid))
dirs)
(unless (string=? log-dir "/var/log")
(mkdir-p log-dir)
(chown log-dir uid gid))
(mkdir-p deploy-dir)
(chown deploy-dir 0 0)
(chmod deploy-dir #o700)
@@ -537,7 +485,6 @@
(provision (list provision))
(requirement '(postgres user-processes))
(one-shot? #t)
(auto-start? #f)
(start
#~(lambda _
(zero? (system* #$logged-launcher))))
@@ -568,7 +515,6 @@
(provision '(tribes))
(requirement '(tribes-local-control tribes-migrations networking
user-processes))
(auto-start? #f)
(start
#~(make-forkexec-constructor
(list #$launcher)
@@ -579,41 +525,6 @@
(stop #~(make-kill-destructor))
(respawn? #f)))))
(define (tribes-boot-start-shepherd-service config)
(let ((secret-key-file (tribes-configuration-secret-key-base-file config))
(token-file (tribes-configuration-token-signing-secret-file config))
(release-cookie-file (tribes-configuration-release-cookie-file config)))
(list
(shepherd-service
(documentation
"Start Tribes on boot once Legion-managed secrets have been installed.")
(provision '(tribes-boot-start))
(requirement '(postgres tribes-local-control networking user-processes))
(one-shot? #t)
(start
#~(lambda _
(define secret-files
(list #$secret-key-file #$token-file #$release-cookie-file))
(define missing
(let loop ((paths secret-files) (missing '()))
(cond
((null? paths) (reverse missing))
((file-exists? (car paths))
(loop (cdr paths) missing))
(else
(loop (cdr paths) (cons (car paths) missing))))))
(if (null? missing)
(start-service (lookup-service 'tribes))
(begin
(for-each
(lambda (path)
(format (current-error-port)
"not starting Tribes at boot; missing secret file: ~a~%"
path))
missing)
#t))))
(respawn? #f)))))
(define (tribes-local-control-launcher config)
(program-file
"tribes-local-control-launcher"
@@ -640,8 +551,7 @@
(requirement '(user-processes))
(start
#~(make-forkexec-constructor
(list #$launcher)
#:log-file "/var/log/tribes-local-control.log"))
(list #$launcher)))
(stop #~(make-kill-destructor))
(respawn? #f)))))
@@ -649,13 +559,11 @@
(append (tribes-migrations-shepherd-service config)
(tribes-plugin-rollback-migrations-shepherd-service config)
(tribes-shepherd-service config)
(tribes-boot-start-shepherd-service config)
(tribes-local-control-shepherd-service config)))
(define (tribes-profile-packages config)
(match (tribes-effective-package config)
(#f (list tribes-command-package
inotify-tools
rsync
ripgrep
fd
@@ -667,7 +575,6 @@
(tribes-plugin-profile-packages config)
(list
tribes-command-package
inotify-tools
rsync
ripgrep
fd
tribes/services/victoriametrics.scm
-245
View File
@@ -1,245 +0,0 @@
(define-module (tribes services victoriametrics)
#:use-module (gnu packages admin)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (gnu system shadow)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (tribes packages monitoring)
#:export (victoriametrics-configuration
victoriametrics-configuration?
victoriametrics-configuration-package
victoriametrics-configuration-user
victoriametrics-configuration-group
victoriametrics-configuration-storage-data-path
victoriametrics-configuration-http-listen-address
victoriametrics-configuration-retention-period
victoriametrics-configuration-extra-options
victoriametrics-configuration-open-files-soft-limit
victoriametrics-configuration-open-files-hard-limit
victoriametrics-service-type
vmagent-configuration
vmagent-configuration?
vmagent-configuration-package
vmagent-configuration-user
vmagent-configuration-group
vmagent-configuration-http-listen-address
vmagent-configuration-promscrape-config
vmagent-configuration-remote-write-url
vmagent-configuration-tmp-data-path
vmagent-configuration-extra-options
vmagent-configuration-open-files-soft-limit
vmagent-configuration-open-files-hard-limit
vmagent-service-type
default-vmagent-scrape-config-text))
(define-record-type* <victoriametrics-configuration>
victoriametrics-configuration make-victoriametrics-configuration
victoriametrics-configuration?
(package victoriametrics-configuration-package
(default victoriametrics))
(user victoriametrics-configuration-user
(default "victoriametrics"))
(group victoriametrics-configuration-group
(default "victoriametrics"))
(storage-data-path victoriametrics-configuration-storage-data-path
(default "/var/lib/victoriametrics"))
(http-listen-address victoriametrics-configuration-http-listen-address
(default "127.0.0.1:8428"))
(retention-period victoriametrics-configuration-retention-period
(default "90d"))
(extra-options victoriametrics-configuration-extra-options
(default '()))
(open-files-soft-limit victoriametrics-configuration-open-files-soft-limit
(default 32768))
(open-files-hard-limit victoriametrics-configuration-open-files-hard-limit
(default 65535)))
(define-record-type* <vmagent-configuration>
vmagent-configuration make-vmagent-configuration
vmagent-configuration?
(package vmagent-configuration-package
(default victoriametrics))
(user vmagent-configuration-user
(default "vmagent"))
(group vmagent-configuration-group
(default "vmagent"))
(http-listen-address vmagent-configuration-http-listen-address
(default "127.0.0.1:8429"))
(promscrape-config vmagent-configuration-promscrape-config
(default #f))
(remote-write-url vmagent-configuration-remote-write-url
(default "http://127.0.0.1:8428/api/v1/write"))
(tmp-data-path vmagent-configuration-tmp-data-path
(default "/var/lib/vmagent"))
(extra-options vmagent-configuration-extra-options
(default '()))
(open-files-soft-limit vmagent-configuration-open-files-soft-limit
(default 32768))
(open-files-hard-limit vmagent-configuration-open-files-hard-limit
(default 65535)))
(define %victoriametrics-accounts
(list
(user-group
(name "victoriametrics")
(system? #t))
(user-account
(name "victoriametrics")
(group "victoriametrics")
(system? #t)
(comment "VictoriaMetrics service user")
(home-directory "/var/lib/victoriametrics")
(shell (file-append shadow "/sbin/nologin")))))
(define %vmagent-accounts
(list
(user-group
(name "vmagent")
(system? #t))
(user-account
(name "vmagent")
(group "vmagent")
(system? #t)
(comment "VictoriaMetrics agent user")
(home-directory "/var/lib/vmagent")
(shell (file-append shadow "/sbin/nologin")))))
(define (chown-directory-gexp directory user group)
#~(begin
(mkdir-p #$directory)
(let ((uid (passwd:uid (getpwnam #$user)))
(gid (group:gid (getgrnam #$group))))
(chown #$directory uid gid))))
(define (victoriametrics-activation config)
#~(begin
(use-modules (guix build utils))
#$(chown-directory-gexp
(victoriametrics-configuration-storage-data-path config)
(victoriametrics-configuration-user config)
(victoriametrics-configuration-group config))))
(define (vmagent-activation config)
#~(begin
(use-modules (guix build utils))
#$(chown-directory-gexp
(vmagent-configuration-tmp-data-path config)
(vmagent-configuration-user config)
(vmagent-configuration-group config))))
(define (option name value)
#~(string-append "-" #$name "=" #$value))
(define (victoriametrics-resource-limits config)
`((nofile
,(victoriametrics-configuration-open-files-soft-limit config)
,(victoriametrics-configuration-open-files-hard-limit config))))
(define (vmagent-resource-limits config)
`((nofile
,(vmagent-configuration-open-files-soft-limit config)
,(vmagent-configuration-open-files-hard-limit config))))
(define (victoriametrics-shepherd-services config)
(match config
(($ <victoriametrics-configuration> package user group storage-data-path
http-listen-address retention-period
extra-options)
(list
(shepherd-service
(documentation "Run VictoriaMetrics single-node storage and query service.")
(provision '(victoria-metrics))
(requirement '(user-processes networking))
(start
#~(make-forkexec-constructor
(list #$(file-append package "/bin/victoria-metrics")
#$(option "storageDataPath" storage-data-path)
#$(option "httpListenAddr" http-listen-address)
#$(option "retentionPeriod" retention-period)
#$@extra-options)
#:user #$user
#:group #$group
#:log-file "/var/log/victoria-metrics.log"
#:resource-limits '#$(victoriametrics-resource-limits config)))
(stop #~(make-kill-destructor)))))))
(define (default-vmagent-scrape-config-text)
(string-append
"global:\n"
" scrape_interval: 15s\n"
"scrape_configs:\n"
" - job_name: node-exporter\n"
" static_configs:\n"
" - targets: [\"127.0.0.1:9100\"]\n"
" - job_name: victoria-metrics\n"
" static_configs:\n"
" - targets: [\"127.0.0.1:8428\"]\n"
" - job_name: tribes\n"
" metrics_path: /metrics\n"
" static_configs:\n"
" - targets: [\"127.0.0.1:4000\"]\n"
" - job_name: vinyl-exporter\n"
" static_configs:\n"
" - targets: [\"127.0.0.1:9131\"]\n"))
(define (vmagent-scrape-config-file config)
(or (vmagent-configuration-promscrape-config config)
(plain-file "vmagent-scrape.yml"
(default-vmagent-scrape-config-text))))
(define (vmagent-shepherd-services config)
(match config
(($ <vmagent-configuration> package user group http-listen-address
_ remote-write-url tmp-data-path extra-options)
(let ((scrape-config (vmagent-scrape-config-file config)))
(list
(shepherd-service
(documentation "Run vmagent to scrape local node metrics.")
(provision '(vmagent))
(requirement '(victoria-metrics user-processes networking))
(start
#~(make-forkexec-constructor
(list #$(file-append package "/bin/vmagent")
#$(option "httpListenAddr" http-listen-address)
#$(option "promscrape.config" scrape-config)
#$(option "remoteWrite.url" remote-write-url)
#$(option "remoteWrite.tmpDataPath" tmp-data-path)
#$@extra-options)
#:user #$user
#:group #$group
#:log-file "/var/log/vmagent.log"
#:resource-limits '#$(vmagent-resource-limits config)))
(stop #~(make-kill-destructor))))))))
(define victoriametrics-service-type
(service-type
(name 'victoria-metrics)
(extensions
(list (service-extension account-service-type
(const %victoriametrics-accounts))
(service-extension activation-service-type
victoriametrics-activation)
(service-extension shepherd-root-service-type
victoriametrics-shepherd-services)
(service-extension profile-service-type
(compose list victoriametrics-configuration-package))))
(default-value (victoriametrics-configuration))
(description "Run VictoriaMetrics single-node storage and query service.")))
(define vmagent-service-type
(service-type
(name 'vmagent)
(extensions
(list (service-extension account-service-type
(const %vmagent-accounts))
(service-extension activation-service-type
vmagent-activation)
(service-extension shepherd-root-service-type
vmagent-shepherd-services)
(service-extension profile-service-type
(compose list vmagent-configuration-package))))
(default-value (vmagent-configuration))
(description "Run vmagent for local metrics scraping.")))
tribes/services/vinyl-exporter.scm
-127
View File
@@ -1,127 +0,0 @@
(define-module (tribes services vinyl-exporter)
#:use-module (gnu services)
#:use-module (gnu services shepherd)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (tribes packages monitoring)
#:use-module (tribes packages web)
#:export (vinyl-exporter-configuration
vinyl-exporter-configuration?
vinyl-exporter-configuration-package
vinyl-exporter-configuration-vinyl-package
vinyl-exporter-configuration-listen-address
vinyl-exporter-configuration-metrics-path
vinyl-exporter-configuration-health-path
vinyl-exporter-configuration-vinyl-workdir
vinyl-exporter-configuration-hls-path-prefix
vinyl-exporter-configuration-hls-stream-components
vinyl-exporter-configuration-hls-playlist-suffixes
vinyl-exporter-configuration-hls-viewer-ttl
vinyl-exporter-configuration-hls-query-params
vinyl-exporter-configuration-hls-cookies
vinyl-exporter-configuration-hls-ip-fallback?
vinyl-exporter-configuration-hls-trusted-proxies
vinyl-exporter-configuration-extra-options
vinyl-exporter-service-type))
(define-record-type* <vinyl-exporter-configuration>
vinyl-exporter-configuration make-vinyl-exporter-configuration
vinyl-exporter-configuration?
(package vinyl-exporter-configuration-package
(default vinyl-exporter))
(vinyl-package vinyl-exporter-configuration-vinyl-package
(default vinyl))
(listen-address vinyl-exporter-configuration-listen-address
(default "127.0.0.1:9131"))
(metrics-path vinyl-exporter-configuration-metrics-path
(default "/metrics"))
(health-path vinyl-exporter-configuration-health-path
(default "/healthz"))
(vinyl-workdir vinyl-exporter-configuration-vinyl-workdir
(default "/var/vinyl/tribes-edge"))
(hls-path-prefix vinyl-exporter-configuration-hls-path-prefix
(default "/"))
(hls-stream-components vinyl-exporter-configuration-hls-stream-components
(default 1))
(hls-playlist-suffixes vinyl-exporter-configuration-hls-playlist-suffixes
(default '(".m3u8")))
(hls-viewer-ttl vinyl-exporter-configuration-hls-viewer-ttl
(default "2m"))
(hls-query-params vinyl-exporter-configuration-hls-query-params
(default '("vsid")))
(hls-cookies vinyl-exporter-configuration-hls-cookies
(default '()))
(hls-ip-fallback? vinyl-exporter-configuration-hls-ip-fallback?
(default #t))
(hls-trusted-proxies vinyl-exporter-configuration-hls-trusted-proxies
(default '()))
(extra-options vinyl-exporter-configuration-extra-options
(default '())))
(define (option name value)
#~(string-append "--" #$name "=" #$value))
(define (bool-option name value)
(option name (if value "true" "false")))
(define (repeatable-options name values)
(map (lambda (value)
(option name value))
values))
(define (vinyl-exporter-shepherd-services config)
(match config
(($ <vinyl-exporter-configuration>
package vinyl-package listen-address metrics-path health-path
vinyl-workdir hls-path-prefix hls-stream-components
hls-playlist-suffixes hls-viewer-ttl hls-query-params hls-cookies
hls-ip-fallback? hls-trusted-proxies extra-options)
(list
(shepherd-service
(documentation "Run the Vinyl Prometheus exporter.")
(provision '(vinyl-exporter))
(requirement '(vinyl-tribes-edge user-processes networking))
(start
#~(make-forkexec-constructor
(list #$(file-append package "/bin/vinyl_exporter")
#$(option "web.listen-address" listen-address)
#$(option "web.telemetry-path" metrics-path)
#$(option "web.health-path" health-path)
#$(option "vinylstat.path"
(file-append vinyl-package "/bin/vinylstat"))
#$(option "vinyllog.path"
(file-append vinyl-package "/bin/vinyllog"))
#$(option "vinyl.workdir" vinyl-workdir)
#$(option "hls.path-prefix" hls-path-prefix)
#$(option "hls.stream-components"
(number->string hls-stream-components))
#$(option "hls.viewer-ttl" hls-viewer-ttl)
#$(bool-option "hls.identity.ip-fallback" hls-ip-fallback?)
#$@(repeatable-options "hls.playlist-suffix"
hls-playlist-suffixes)
#$@(repeatable-options "hls.identity.query-param"
hls-query-params)
#$@(repeatable-options "hls.identity.cookie" hls-cookies)
#$@(repeatable-options "hls.identity.trusted-proxy"
hls-trusted-proxies)
#$@extra-options)
#:log-file "/var/log/vinyl-exporter.log"))
(stop #~(make-kill-destructor)))))))
(define (vinyl-exporter-profile-packages config)
(delete-duplicates
(list (vinyl-exporter-configuration-package config)
(vinyl-exporter-configuration-vinyl-package config))))
(define vinyl-exporter-service-type
(service-type
(name 'vinyl-exporter)
(extensions
(list (service-extension shepherd-root-service-type
vinyl-exporter-shepherd-services)
(service-extension profile-service-type
vinyl-exporter-profile-packages)))
(default-value (vinyl-exporter-configuration))
(description "Run Vinyl Exporter for local Vinyl Cache metrics.")))
tribes/services/vinyl.scm
-1
View File
@@ -114,7 +114,6 @@
(cdr parameter))))
parameters)
#$@extra-options)
#:log-file #$(string-append "/var/log/vinyl-" name ".log")
#:resource-limits '#$(vinyl-resource-limits config)))
(stop #~(make-kill-destructor))))))))
configs))
tribes/system/materialize.scm
+8 -22
View File
@@ -13,7 +13,6 @@
#:use-module (nbde services tang)
#:use-module (nbde system initrd)
#:use-module (nbde system mapped-devices)
#:use-module (srfi srfi-13)
#:use-module (tribes config host)
#:use-module (tribes config system-facts)
#:use-module (tribes system installer)
@@ -37,33 +36,20 @@
(bootloader grub-bootloader)
(targets targets))))))
(define (local-boot-key-file->boot-relative-path local-boot-key-file)
(and (string? local-boot-key-file)
(cond
((string-prefix? "/boot/" local-boot-key-file)
(substring local-boot-key-file (string-length "/boot/")))
((string-prefix? "/" local-boot-key-file)
#f)
(else local-boot-key-file))))
(define (optional-local-boot-key-file system-facts)
(let ((local-boot-key-file
(tribes-system-facts-local-boot-key-file system-facts)))
(and (string? local-boot-key-file)
(file-exists? local-boot-key-file)
(local-file local-boot-key-file))))
(define (clevis-luks-device-kind-from-system-facts system-facts)
(let ((boot-key-file
(local-boot-key-file->boot-relative-path
(tribes-system-facts-local-boot-key-file system-facts)))
(boot-device-uuid
(uuid (tribes-system-facts-boot-partition-uuid system-facts)
(uuid-type-for-file-system
(tribes-system-facts-boot-partition-file-system-type
system-facts))))
(let ((key-file (optional-local-boot-key-file system-facts))
(base clevis-luks-device-mapping))
(mapped-device-kind
(open
(lambda (source targets)
((mapped-device-kind-open base) source targets
#:boot-key-file boot-key-file
#:boot-device-uuid boot-device-uuid
#:boot-file-system-type
(tribes-system-facts-boot-partition-file-system-type system-facts))))
((mapped-device-kind-open base) source targets #:key-file key-file)))
(close (mapped-device-kind-close base))
(modules (mapped-device-kind-modules base))
(check (mapped-device-kind-check base)))))
tribes/system/node.scm
+43 -38
View File
@@ -1,24 +1,18 @@
(define-module (tribes system node)
#:use-module (gnu packages databases)
#:use-module (gnu packages linux)
#:use-module (gnu packages monitoring)
#:use-module (gnu services)
#:use-module (gnu services databases)
#:use-module (gnu services linux)
#:use-module (gnu services monitoring)
#:use-module (gnu services sysctl)
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (tribes packages plugins)
#:use-module (tribes services chrony)
#:use-module (tribes services haproxy)
#:use-module (tribes services hitch)
#:use-module (tribes services lego)
#:use-module (tribes services tribes)
#:use-module (tribes services vinyl)
#:use-module (tribes services vinyl-exporter)
#:use-module (tribes services victoriametrics)
#:export (tribes-edge-configuration
tribes-edge-configuration?
tribes-edge-configuration-certificate-name
@@ -115,8 +109,37 @@
(tribes-edge-configuration-challenge-port edge)))
(acme-enabled? (not self-signed-only?))
(renew-days (tribes-edge-configuration-renew-days edge))
(requirement '(haproxy))
(reload-services '(haproxy)))))
(requirement '(vinyl-tribes-http))
(reload-services '(hitch)))))
(define (edge-http-vcl edge)
(plain-file
"tribes-edge-http.vcl"
(string-append
"vcl 4.1;\n\n"
"backend acme {\n"
" .host = \"" (tribes-edge-configuration-challenge-address edge) "\";\n"
" .port = \"" (number->string
(tribes-edge-configuration-challenge-port edge)) "\";\n"
"}\n\n"
"sub vcl_recv {\n"
" if (req.url ~ \"^/\\.well-known/acme-challenge/\") {\n"
" set req.backend_hint = acme;\n"
" return (pass);\n"
" }\n\n"
" return (synth(750));\n"
"}\n\n"
"sub vcl_synth {\n"
" if (resp.status == 750) {\n"
" set resp.status = 308;\n"
" set resp.http.Location = \"https://\" + req.http.host + req.url;\n"
" return (deliver);\n"
" }\n"
"}\n\n"
"sub vcl_backend_response {\n"
" set beresp.uncacheable = true;\n"
" return (deliver);\n"
"}\n")))
(define (edge-cache-vcl-text edge tribes)
(string-append
@@ -215,6 +238,12 @@
(certificates (list certificate))))
(service vinyl-service-type
(list
(vinyl-configuration
(name "tribes-http")
(vcl (edge-http-vcl edge))
(listen (list (string-append "0.0.0.0:" (number->string http-port))
(string-append "[::]:" (number->string http-port))))
(storage '("malloc,64M")))
(vinyl-configuration
(name "tribes-edge")
(vcl (edge-cache-vcl edge tribes))
@@ -225,27 +254,13 @@
(number->string cache-port))))
(storage (tribes-edge-configuration-cache-storage edge))
(parameters '((max_retries . 5))))))
(service vinyl-exporter-service-type
(vinyl-exporter-configuration
(vinyl-workdir "/var/vinyl/tribes-edge")
(hls-path-prefix "/sender/hls/streams/")
(hls-stream-components 1)
(hls-query-params '("vsid"))
(hls-ip-fallback? #t)
(hls-trusted-proxies '("127.0.0.1" "::1"))))
(service haproxy-service-type
(haproxy-configuration
(backend (format #f "~a:~a"
(service hitch-service-type
(hitch-configuration
(backend (format #f "[~a]:~a"
(tribes-edge-configuration-cache-address edge)
cache-port))
(frontends (list (format #f "0.0.0.0:~a" https-port)
(format #f "[::]:~a v6only" https-port)))
(http-frontends (list (format #f "0.0.0.0:~a" http-port)
(format #f "[::]:~a v6only" http-port)))
(acme-backend
(format #f "~a:~a"
(tribes-edge-configuration-challenge-address edge)
(tribes-edge-configuration-challenge-port edge)))
(frontends (list (format #f "[0.0.0.0]:~a" https-port)
(format #f "[::]:~a" https-port)))
(pem-files (list (lego-certificate-full-pem certificate))))))))
(define (tribes-node-bbr-services config)
@@ -271,21 +286,11 @@
plugins)))
(append
(list
(service chrony-service-type)
(service postgresql-service-type
(tribes-node-configuration-postgresql config))
(simple-service 'tribes-postgresql-roles
postgresql-role-service-type
(tribes-node-postgresql-roles config))
(simple-service 'tribes-node-network-tools
profile-service-type
(list nftables))
(service prometheus-node-exporter-service-type
(prometheus-node-exporter-configuration
(package prometheus-node-exporter)
(web-listen-address "127.0.0.1:9100")))
(service victoriametrics-service-type)
(service vmagent-service-type)
(service tribes-service-type
tribes))
(tribes-node-bbr-services config)