Commitc9492e38Recorded4 Aug 2026Repositoryvigil

WIP: out-of-process checks, liveness endpoint, watchdog, 0.18.2

Message

Checkpoint before the /healthz red-gate sabotage test. See the task note for the reproduction and measurements behind these changes.

Changed
 deploy/vigil-watchdog.sh | 159 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 package.sgl              |  62 ++++++++++++++---------
 sigil.lock               | 123 +++++++++++++++++++++++++++++++++++++++++++++
 src/vigil/alert.sgl      |  71 +++++++++++++++++++++-----
 src/vigil/build-info.sgl |  26 ++++++++++
 src/vigil/checker.sgl    | 455 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------
 src/vigil/config.sgl     |   7 +++
 src/vigil/main.sgl       | 261 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------
 src/vigil/state.sgl      |  40 ++++++++++++++-
 src/vigil/views.sgl      |  11 ++++-
 src/vigil/web.sgl        |  65 ++++++++++++++++++++++++
 11 files changed, 1110 insertions(+), 170 deletions(-)
Diff
deploy/vigil-watchdog.shadded
@@ -0,0 +1,159 @@
+1
#!/bin/sh
+2
#
+3
# vigil-watchdog — the check that distinguishes LISTENING from ANSWERING.
+4
#
+5
# WHY THIS EXISTS
+6
#
+7
# On 2026-06-10 vigil stopped monitoring anything and nobody noticed for 55
+8
# days. Every health surface was green the whole time and every one of them
+9
# was telling the truth:
+10
#
+11
# rcctl said started — the process existed
+12
# the port said LISTEN — the listening socket was open
+13
# the process was alive — it was, in read(fd, buf, 5), forever
+14
#
+15
# What none of them could say is whether the service ANSWERS. It did not.
+16
# Clients connected, sent their requests, and sat in CLOSE_WAIT with their
+17
# bytes unread.
+18
#
+19
# So this watchdog does the one thing those surfaces cannot: it makes a real
+20
# request with a hard client-side deadline and requires a real response.
+21
# A timeout IS the failure signal, not an inconvenience to be retried away.
+22
#
+23
# Run from cron every minute:
+24
# * * * * * /usr/local/bin/vigil-watchdog.sh >/dev/null 2>&1
+25
#
+26
# Exit codes:
+27
# 0 vigil answered correctly
+28
# 1 vigil did not answer correctly (probe red)
+29
# 2 the watchdog could not run its own probe (tooling/config fault)
+30
#
+31
# Note that 1 and 2 are DELIBERATELY different. "vigil is wedged" and "I was
+32
# unable to find out whether vigil is wedged" are different facts, and a
+33
# watchdog that reports them identically is how you end up trusting a probe
+34
# that never ran.
+35
+36
set -u
+37
+38
VIGIL_URL="${VIGIL_URL:-http://10.11.0.1:8400/healthz}"
+39
VIGIL_TIMEOUT="${VIGIL_TIMEOUT:-5}"
+40
VIGIL_STATE="${VIGIL_STATE:-/var/db/vigil-watchdog.state}"
+41
VIGIL_LOG="${VIGIL_LOG:-/var/log/vigil-watchdog.log}"
+42
VIGIL_FAIL_THRESHOLD="${VIGIL_FAIL_THRESHOLD:-3}"
+43
VIGIL_RESTART="${VIGIL_RESTART:-auto}"
+44
+45
CHECK_ONLY=0
+46
[ "${1:-}" = "--check-only" ] && CHECK_ONLY=1
+47
+48
log() {
+49
printf '%s %s\n' "$(date -u +%FT%TZ)" "$*" >> "$VIGIL_LOG" 2>/dev/null
+50
printf '%s %s\n' "$(date -u +%FT%TZ)" "$*"
+51
}
+52
+53
# ── The instrument must prove itself before its answer means anything ──
+54
#
+55
# A missing tool does not error, it degrades to a weaker test: `curl` absent
+56
# would make every probe "fail" and this watchdog would restart vigil in a
+57
# loop forever, blaming a healthy service. Refuse to run instead.
+58
if ! command -v curl >/dev/null 2>&1; then
+59
log "FAULT curl not found; cannot probe. Watchdog refusing to run."
+60
exit 2
+61
fi
+62
+63
# ── Probe ──────────────────────────────────────────────────────────────
+64
#
+65
# Both signals are load-bearing and neither alone is sufficient:
+66
# curl_rc — 28 means the deadline passed with no response. THIS is the
+67
# signal that catches a wedge; an HTTP code would never arrive.
+68
# http_code— 200 means answering; 503 means vigil itself reports its
+69
# checkers have stalled; 000 means no response was parsed.
+70
http_code="$(curl -sS --max-time "$VIGIL_TIMEOUT" \
+71
-o /dev/null -w '%{http_code}' "$VIGIL_URL" 2>/dev/null)"
+72
curl_rc=$?
+73
+74
if [ "$curl_rc" -eq 0 ] && [ "$http_code" = "200" ]; then
+75
verdict="GREEN"
+76
elif [ "$curl_rc" -eq 28 ]; then
+77
verdict="RED"
+78
reason="no response within ${VIGIL_TIMEOUT}s (curl 28) — listening but not answering"
+79
elif [ "$curl_rc" -ne 0 ]; then
+80
verdict="RED"
+81
reason="curl exit ${curl_rc} (connection refused / unreachable)"
+82
else
+83
verdict="RED"
+84
reason="HTTP ${http_code} — vigil answered but reports itself unhealthy"
+85
fi
+86
+87
# ── Consecutive-failure state ──────────────────────────────────────────
+88
fails=0
+89
if [ -r "$VIGIL_STATE" ]; then
+90
fails="$(cat "$VIGIL_STATE" 2>/dev/null)"
+91
case "$fails" in
+92
''|*[!0-9]*) fails=0 ;;
+93
esac
+94
fi
+95
+96
if [ "$verdict" = "GREEN" ]; then
+97
if [ "$fails" -gt 0 ]; then
+98
log "RECOVERED $VIGIL_URL answering again after $fails consecutive failures"
+99
fi
+100
echo 0 > "$VIGIL_STATE" 2>/dev/null
+101
exit 0
+102
fi
+103
+104
fails=$((fails + 1))
+105
echo "$fails" > "$VIGIL_STATE" 2>/dev/null
+106
log "RED $VIGIL_URL: $reason (consecutive=$fails/$VIGIL_FAIL_THRESHOLD)"
+107
+108
[ "$CHECK_ONLY" -eq 1 ] && exit 1
+109
[ "$fails" -lt "$VIGIL_FAIL_THRESHOLD" ] && exit 1
+110
+111
# ── Threshold reached: alert, then restart ─────────────────────────────
+112
+113
alert() {
+114
# Best effort and deliberately non-fatal. Never let the notifier's own
+115
# network call decide whether the restart happens.
+116
[ -n "${VIGIL_WATCHDOG_TELEGRAM_TOKEN:-}" ] || return 0
+117
[ -n "${VIGIL_WATCHDOG_TELEGRAM_CHAT_ID:-}" ] || return 0
+118
curl -sS --max-time 10 -o /dev/null \
+119
"https://api.telegram.org/bot${VIGIL_WATCHDOG_TELEGRAM_TOKEN}/sendMessage" \
+120
--data-urlencode "chat_id=${VIGIL_WATCHDOG_TELEGRAM_CHAT_ID}" \
+121
--data-urlencode "text=$1" 2>/dev/null || \
+122
log "WARN telegram alert failed (continuing to restart anyway)"
+123
}
+124
+125
restart_cmd=""
+126
case "$VIGIL_RESTART" in
+127
auto)
+128
# Which supervisor is actually in charge is a fact about the host,
+129
# not something to assume: vigil moved from rc.d to runit, and both
+130
# sets of files still exist. Detect, log what was detected, and say
+131
# so when neither is present rather than silently doing nothing.
+132
if [ -d /etc/service/vigil ] && command -v sv >/dev/null 2>&1; then
+133
restart_cmd="sv restart vigil"
+134
elif command -v rcctl >/dev/null 2>&1; then
+135
restart_cmd="rcctl restart vigil"
+136
fi
+137
;;
+138
none) restart_cmd="" ;;
+139
*) restart_cmd="$VIGIL_RESTART" ;;
+140
esac
+141
+142
alert "🔴 vigil watchdog: $VIGIL_URL $reason (${fails} consecutive). Restarting."
+143
+144
if [ -z "$restart_cmd" ]; then
+145
log "FAULT no supervisor found (no /etc/service/vigil + sv, no rcctl) and VIGIL_RESTART unset; cannot restart"
+146
exit 2
+147
fi
+148
+149
log "RESTART threshold reached; running: $restart_cmd"
+150
if $restart_cmd >> "$VIGIL_LOG" 2>&1; then
+151
log "RESTART command exited 0"
+152
else
+153
log "FAULT restart command failed (exit $?)"
+154
fi
+155
+156
# Reset so the next window is judged fresh rather than restarting every
+157
# minute while the service is still coming up.
+158
echo 0 > "$VIGIL_STATE" 2>/dev/null
+159
exit 1
package.sglmodified
@@ -1,14 +1,18 @@
1
;;; Vigil - Lightweight service monitoring dashboard
2
;;;
−3
;;; Monitors running services via health checks (HTTP, TCP, process, command)
−4
;;; and provides a real-time web dashboard with SSE-powered live updates.
−5
−6
(define sigil-repo "codeberg:sigil/sigil#v0.8.0")
+3
;;; Monitors running services via health checks (HTTP) and provides a
+4
;;; real-time web dashboard with SSE-powered live updates.
+5
;;;
+6
;;; Checks run OUT OF PROCESS with a wall-clock kill. See
+7
;;; `src/vigil/checker.sgl` and the folio topic note
+8
;;; `topics/vigil-out-of-process-check-isolation` for why.
9
10
(package
11
name: "vigil"
−10
version: "0.1.0"
+12
version: "0.2.0"
+13
sigil: "^0.18"
14
description: "Lightweight service monitoring dashboard"
+15
url: "https://codeberg.org/sigil/vigil"
16
license: "BSD-3-Clause"
17
authors: (list "David Wilson <david@daviwil.com>")
18
@@ -25,7 +29,7 @@
29
(config
30
name: 'release
31
output-dir: "build/release"
−28
static?: #f
+32
backend: 'native
33
debug?: #f
34
optimize: 2
35
bundle?: #t)
@@ -40,26 +44,36 @@
44
bundle?: #t))
45
46
dependencies: (list
−43
(from-git url: sigil-repo package: "sigil-run")
−44
(from-git url: sigil-repo package: "sigil-stdlib")
−45
(from-git url: sigil-repo package: "sigil-tls")
−46
(from-git url: sigil-repo package: "sigil-http")
−47
(from-git url: "codeberg:sigil/sigil-web#v0.8.0"
−48
package: "sigil-web")
−49
(from-git url: sigil-repo package: "sigil-json")
−50
(from-git url: "codeberg:sigil/sigil-sxml#v0.8.0"
−51
package: "sigil-sxml")
−52
(from-git url: "codeberg:sigil/sigil-css#v0.9.0"
−53
package: "sigil-css")
−54
(from-git url: sigil-repo package: "sigil-ansi")
−55
(from-git url: sigil-repo package: "sigil-args")
−56
(from-git url: "codeberg:sigil/sigil-web-styles#v0.1.0"
−57
package: "sigil-web-styles")
−58
(from-git url: "codeberg:sigil/sigil-telegram#v0.8.0"
−59
package: "sigil-telegram"))
+47
;; Explicit sigil-lib pin, declared FIRST. Two reasons:
+48
;; 1. Without it, sigil-lib is derived transitively and does not track
+49
;; the `sigil:` field, so a relock can silently leave the C runtime
+50
;; behind while `sigil deps install` exits 0.
+51
;; 2. Declaration ORDER matters (t-86ec): a runtime pin declared after
+52
;; another monorepo package can hard-error with a version conflict
+53
;; naming an incompatibility that does not exist.
+54
;; Verify in sigil.lock via the `version:`/`sha:` fields, not `ref:`.
+55
(from-git url: "codeberg:sigil/sigil"
+56
package: "sigil-lib" version: "^0.18")
+57
(from-git url: "codeberg:sigil/sigil" package: "sigil-run" version: "^0.18.0")
+58
+59
;; sigil-http ^0.18 is load-bearing, not cosmetic: it is the first line
+60
;; carrying `timeout:` / `connect-timeout:` on the client at all. The
+61
;; 0.7.0 line vigil shipped on had no timeout support whatsoever --
+62
;; the string "timeout" occurs zero times in that file.
+63
(from-git url: "codeberg:sigil/sigil-http" version: "^0.18.0")
+64
(from-git url: "codeberg:sigil/sigil-web" version: "^0.16.0")
+65
(from-git url: "codeberg:sigil/sigil-json" version: "^0.16.0")
+66
(from-git url: "codeberg:sigil/sigil-sxml" version: "^0.15.0")
+67
(from-git url: "codeberg:sigil/sigil-web-styles" version: "^0.2.0")
+68
(from-git url: "codeberg:sigil/sigil-telegram" version: "^0.10.0"))
69
+70
;; sigil-test is held at ^0.17 while the runtime is on ^0.18: sigil-http,
+71
;; sigil-tls, sigil-crypto and sigil-web-styles each declare a dev-dependency
+72
;; on sigil-test ^0.17 and the resolver unifies across the whole graph.
+73
;; Test harness only -- the shipped runtime is unaffected. See t-9484.
74
dev-dependencies: (list
−62
(from-git url: sigil-repo package: "sigil-test"))
+75
(from-git url: "codeberg:sigil/sigil" package: "sigil-test" version: "^0.17")
+76
(from-git url: "codeberg:sigil/sigil" package: "sigil-test-runner" version: "^0.17"))
77
78
tasks: (list
79
(task
sigil.lockadded
@@ -0,0 +1,123 @@
+1
;; Auto-generated by sigil deps install. Do not edit.
+2
(lock
+3
(package name: "sigil-stdlib"
+4
url: "codeberg:sigil/sigil"
+5
ref: "^0.18"
+6
sha: "7e7c8873d45338a8e892aa3982b6991d9a1fa5a5"
+7
package-selector: "sigil-stdlib"
+8
version: "0.18.2")
+9
(package name: "sigil-lib"
+10
url: "codeberg:sigil/sigil"
+11
ref: "^0.18"
+12
sha: "7e7c8873d45338a8e892aa3982b6991d9a1fa5a5"
+13
package-selector: "sigil-lib"
+14
version: "0.18.2")
+15
(package name: "sigil-run"
+16
url: "codeberg:sigil/sigil"
+17
ref: "^0.18.0"
+18
sha: "7e7c8873d45338a8e892aa3982b6991d9a1fa5a5"
+19
package-selector: "sigil-run"
+20
version: "0.18.2")
+21
(package name: "sigil-http"
+22
url: "codeberg:sigil/sigil-http"
+23
ref: "^0.18.0"
+24
sha: "1ad4063a9540ca91fbb15fc7d32936e232eb621c"
+25
version: "0.18.2")
+26
(package name: "sigil-web"
+27
url: "codeberg:sigil/sigil-web"
+28
ref: "^0.16.0"
+29
sha: "34f1f6e8c01f45272c6a6f83fa1282ad2cdb68a1"
+30
version: "0.16.1")
+31
(package name: "sigil-json"
+32
url: "codeberg:sigil/sigil-json"
+33
ref: "^0.16.0"
+34
sha: "55c9e74712b5f79b45d41c65cfe0aef2c8f7e155"
+35
version: "0.16.0")
+36
(package name: "sigil-sxml"
+37
url: "codeberg:sigil/sigil-sxml"
+38
ref: "^0.15.0"
+39
sha: "5a4f043247600f58bdabae19de55664d759a30c9"
+40
version: "0.15.0")
+41
(package name: "sigil-web-styles"
+42
url: "codeberg:sigil/sigil-web-styles"
+43
ref: "^0.2.0"
+44
sha: "bc68dcd491b717904e9b1dbc2894d27774a0d0a7"
+45
version: "0.2.2")
+46
(package name: "sigil-telegram"
+47
url: "codeberg:sigil/sigil-telegram"
+48
ref: "^0.10.0"
+49
sha: "67862220e42d5fdffe44824143d9b7f72ff0b934"
+50
version: "0.10.5")
+51
(package name: "sigil-test"
+52
url: "codeberg:sigil/sigil"
+53
ref: "^0.17"
+54
sha: "070f133a3524142b4febfd7c287385186b616252"
+55
package-selector: "sigil-test"
+56
version: "0.17.20")
+57
(package name: "sigil-test-runner"
+58
url: "codeberg:sigil/sigil"
+59
ref: "^0.17"
+60
sha: "070f133a3524142b4febfd7c287385186b616252"
+61
package-selector: "sigil-test-runner"
+62
version: "0.17.20")
+63
(package name: "sigil-socket"
+64
url: "codeberg:sigil/sigil-socket"
+65
ref: "^0.16.0"
+66
sha: "6b9e36eb4d4a944b463e5f6826bd711186ba6710"
+67
version: "0.16.0")
+68
(package name: "sigil-tls"
+69
url: "codeberg:sigil/sigil-tls"
+70
ref: "^0.16.0"
+71
sha: "baf05e45ed4090406c2990debadabfcd8253d834"
+72
version: "0.16.4")
+73
(package name: "sigil-nrepl"
+74
url: "codeberg:sigil/sigil-nrepl"
+75
ref: "^0.16"
+76
sha: "e5618482fb4adb2ed3851bef980bef91d3ad2ff7"
+77
version: "0.16.2")
+78
(package name: "sigil-css"
+79
url: "codeberg:sigil/sigil-css"
+80
ref: "^0.9.1"
+81
sha: "80d333278d45ae81567001afb352d3d4f69bea92"
+82
version: "0.9.2")
+83
(package name: "sigil-ansi"
+84
url: "codeberg:sigil/sigil-ansi"
+85
ref: "^0.16.0"
+86
sha: "1e14b6f9d034ca8ef9f404e2ded316d0780ad7cf"
+87
version: "0.16.0")
+88
(package name: "sigil-version"
+89
url: "codeberg:sigil/sigil-version"
+90
ref: "^0.16.0"
+91
sha: "2d2c9ef9c2694466f65abc14cddf9bfb9cada4a4"
+92
version: "0.16.0")
+93
(package name: "sigil-git"
+94
url: "codeberg:sigil/sigil-git"
+95
ref: "^0.16.0"
+96
sha: "2d54eb99d3ca0597b3ccd9d4829d312c54721086"
+97
version: "0.16.1")
+98
(package name: "sigil-crypto"
+99
url: "codeberg:sigil/sigil-crypto"
+100
ref: "^0.16"
+101
sha: "964eec2fad375834e2b49da454209fabc059ca30"
+102
version: "0.16.4")
+103
(package name: "sigil-repl"
+104
url: "codeberg:sigil/sigil-repl"
+105
ref: "^0.16.0"
+106
sha: "cffebf24367e226aead63ef8e974329b59e10e69"
+107
version: "0.16.1")
+108
(package name: "sigil-hooks"
+109
url: "codeberg:sigil/sigil-hooks"
+110
ref: "^0.16.0"
+111
sha: "0953f39460030b799c92604e66115225324b07d6"
+112
version: "0.16.1")
+113
(package name: "sigil-docs"
+114
url: "codeberg:sigil/sigil-docs"
+115
ref: "^0.16.0"
+116
sha: "105327cf559c31945fa3239b770460ca323ea8ed"
+117
version: "0.16.1")
+118
(package name: "sigil-args"
+119
url: "codeberg:sigil/sigil-args"
+120
ref: "^0.16.0"
+121
sha: "e8f9427990df5da509d08ea39f24a79f19f7e432"
+122
version: "0.16.0")
+123
)
src/vigil/alert.sglmodified
@@ -3,6 +3,20 @@
3
;;; Sends notifications when services go down or recover.
4
;;; Includes flap protection to avoid alert spam when services
5
;;; bounce rapidly between states.
+6
;;;
+7
;;; TWO CONSTRUCTION MODES, and the difference is load-bearing:
+8
;;;
+9
;;; `make-alerter-out-of-process` — used by `serve`. Delivery is delegated
+10
;;; to a `sender` procedure that spawns a child process. `tg-send-message`
+11
;;; makes an ordinary blocking outbound HTTPS call, and in the serving
+12
;;; process that is one more unbounded blocking segment on the cooperative
+13
;;; scheduler that also runs the dashboard: exactly the defect that wedged
+14
;;; production for 55 days, one layer above the checks. An alert fires
+15
;;; precisely when something is already wrong, so it is the worst possible
+16
;;; moment to block the accept loop.
+17
;;;
+18
;;; `make-alerter` — used by the `notify` child subcommand, which IS the
+19
;;; isolated process, and therefore may block freely.
20
21
(define-library (vigil alert)
22
(import (sigil core)
@@ -13,8 +27,10 @@
27
(vigil state))
28
29
(export make-alerter
+30
make-alerter-out-of-process
31
alerter?
−17
alerter-send!)
+32
alerter-send!
+33
alerter-deliver!)
34
35
(begin
36
@@ -23,12 +39,13 @@
39
;; ============================================================
40
41
(define-struct alerter
−26
(client default: #f)
+42
(client default: #f) ;; child mode: a live telegram client
+43
(sender default: #f) ;; parent mode: (lambda (message) ...)
44
(config default: #f)
45
(tracking default: '()))
46
47
(define (make-alerter cfg)
−31
;; cfg is a telegram-config from (vigil config).
+48
;; Child mode. cfg is a telegram-config from (vigil config).
49
;; Returns an alerter, or #f if token/chat-id are missing.
50
(if (and cfg
51
(telegram-config-token cfg)
@@ -39,6 +56,24 @@
56
tracking: (list '()))
57
#f))
58
+59
;;; Parent mode. `sender` is invoked with the message string and is
+60
;;; responsible for delivering it WITHOUT blocking this process.
+61
;;;
+62
;;; Note the credentials check still happens here, against the same
+63
;;; config the child will load, so a credential-less deployment produces
+64
;;; #f (alerts disabled) rather than a stream of child processes that
+65
;;; each start up only to discover they have nothing to send.
+66
(define (make-alerter-out-of-process cfg sender)
+67
(if (and cfg
+68
(telegram-config-token cfg)
+69
(telegram-config-chat-id cfg)
+70
sender)
+71
(alerter
+72
sender: sender
+73
config: cfg
+74
tracking: (list '()))
+75
#f))
+76
77
;; ============================================================
78
;; Tracking State Access
79
;; ============================================================
@@ -117,15 +152,27 @@
152
(define (send-recovery! alerter name result old-status)
153
(send-telegram! alerter (format "🟢 ~a is UP" name)))
154
+155
;; Parent mode delegates to `sender` (which must not block); child mode
+156
;; talks to Telegram directly. Either way a delivery failure is logged
+157
;; and swallowed: a monitoring system must not die because its notifier
+158
;; is unreachable.
159
(define (send-telegram! alerter msg)
−121
(let ((client (alerter-client alerter))
−122
(chat-id (telegram-config-chat-id (alerter-config alerter))))
−123
(guard (exn (#t
−124
(display (format " Alert send failed: ~a\n"
−125
(if (error-object? exn)
−126
(error-object-message exn)
−127
exn))
−128
(current-error-port))))
−129
(tg-send-message client chat-id msg))))
+160
(guard (exn (#t
+161
(display (format " Alert send failed: ~a\n"
+162
(if (error-object? exn)
+163
(error-object-message exn)
+164
exn))
+165
(current-error-port))))
+166
(let ((sender (alerter-sender alerter)))
+167
(if sender
+168
(sender msg)
+169
(alerter-deliver! alerter msg)))))
+170
+171
;;; Deliver a message to Telegram from THIS process. Blocking, and only
+172
;;; safe in the isolated `notify` child.
+173
(define (alerter-deliver! alerter msg)
+174
(tg-send-message (alerter-client alerter)
+175
(telegram-config-chat-id (alerter-config alerter))
+176
msg))
177
178
))
src/vigil/build-info.sgladded
@@ -0,0 +1,26 @@
+1
;;; (vigil build-info) - Versions vigil reports about itself.
+2
;;;
+3
;;; `sigil-runtime-version` is a hand-maintained constant, which means it
+4
;;; CAN drift from the runtime actually linked in. A self-report that is
+5
;;; free to lie is worse than no self-report, so it is not left on trust:
+6
;;; `scripts/gate.sh` asserts this string equals the sigil-lib and
+7
;;; sigil-stdlib versions recorded in `sigil.lock`, and goes red if a
+8
;;; relock moves the runtime without this file following.
+9
;;;
+10
;;; Derive it from the lock, never from memory:
+11
;;; grep -A2 '"sigil-stdlib"' sigil.lock
+12
+13
(define-library (vigil build-info)
+14
(import (sigil core))
+15
+16
(export vigil-version
+17
sigil-runtime-version)
+18
+19
(begin
+20
+21
(define vigil-version "0.2.0")
+22
+23
;; Must match sigil.lock's sigil-lib / sigil-stdlib `version:` fields.
+24
(define sigil-runtime-version "0.18.2")
+25
+26
))
src/vigil/checker.sglmodified
@@ -1,7 +1,36 @@
−1
;;; (vigil checker) - Health check runner.
+1
;;; (vigil checker) - Health check runner with out-of-process isolation.
2
;;;
−3
;;; Implements HTTP health checks with response time measurement.
−4
;;; Each check returns a check-record with status, latency, and error info.
+3
;;; WHY CHECKS RUN OUT OF PROCESS
+4
;;;
+5
;;; Vigil serves its dashboard and runs its checks as `go` tasks under a
+6
;;; single `(sigil async)` scheduler. That scheduler is COOPERATIVE: a task
+7
;;; yields only at an explicit yield point. Any blocking syscall therefore
+8
;;; freezes the accept loop too, and no in-process watchdog can rescue it,
+9
;;; because the watchdog can only run if the scheduler runs.
+10
;;;
+11
;;; On 2026-06-10 that is exactly what happened: a monitored endpoint
+12
;;; accepted the TCP connection and then never sent a byte. The process sat
+13
;;; in `read(fd, buf, 5)` -- the five-byte TLS record header -- inside the
+14
;;; mbedTLS handshake, for 55 days, while the port stayed open and every
+15
;;; health surface reported the service healthy.
+16
;;;
+17
;;; An in-process deadline cannot fix that in general. Auditing the 0.18.x
+18
;;; client shows five blocking segments on a check, of which only ONE is
+19
;;; bounded by the library's own knobs:
+20
;;;
+21
;;; DNS getaddrinfo unbounded
+22
;;; TCP connect bounded for https via connect-timeout:; unbounded for http
+23
;;; TLS handshake unbounded <- the segment that wedged production
+24
;;; request write unbounded
+25
;;; response read bounded via timeout:
+26
;;;
+27
;;; So the check runs in a CHILD PROCESS and the parent enforces a wall-clock
+28
;;; budget it can always honour, because killing a child does not require the
+29
;;; child's cooperation. The library timeouts below are still set: they make
+30
;;; the common case exit cleanly without a kill. They are defence in depth,
+31
;;; not the guarantee.
+32
;;;
+33
;;; See folio topics/vigil-out-of-process-check-isolation.
34
35
(define-library (vigil checker)
36
(import (sigil core)
@@ -9,88 +38,402 @@
38
(sigil math)
39
(sigil async)
40
(sigil time)
+41
(sigil io)
+42
(sigil fs)
+43
(sigil process)
44
(sigil http client)
45
(vigil config)
46
(vigil state))
47
−16
(export run-check
−17
check-loop)
+48
(export ;; Parent side
+49
resolve-checker-executable
+50
checker-self-test!
+51
run-check-supervised
+52
run-notify-supervised
+53
check-loop
+54
+55
;; Child side (the `check-url` subcommand)
+56
run-check-direct
+57
check-record->line
+58
parse-check-line
+59
+60
;; Constants other modules report on
+61
default-connect-timeout
+62
default-read-timeout
+63
default-wall-clock-budget
+64
selftest-marker
+65
result-marker)
66
67
(begin
68
69
;; ============================================================
−22
;; Check Execution
+70
;; Budgets
71
;; ============================================================
72
−25
(define (run-check svc)
−26
(: service? -> check-record?)
−27
(let ((spec (service-check svc)))
−28
(case (check-spec-type spec)
−29
((http) (run-http-check spec))
−30
(else
−31
(check-record
−32
status: 'down
−33
latency: 0
−34
error: (format "Unknown check type: ~a" (check-spec-type spec))
−35
timestamp: (current-second))))))
+73
;; Library-level knobs, applied inside the child. These bound the two
+74
;; segments the library can bound. They exist so the ordinary case
+75
;; terminates on its own; they are NOT what makes the design safe.
+76
(define default-connect-timeout 5) ;; seconds, TCP/TLS connect phase
+77
(define default-read-timeout 10) ;; seconds, response read phase
+78
+79
;; The guarantee. The parent kills the child at this deadline no matter
+80
;; which segment it is stuck in. Must exceed connect+read comfortably so
+81
;; a normal slow-but-working endpoint is not killed while it is making
+82
;; progress.
+83
(define default-wall-clock-budget 20) ;; seconds
+84
+85
;; Poll cadence while waiting on the child. `sleep` here is
+86
;; `(sigil time)`'s async-aware sleep: inside `with-async` it YIELDS to
+87
;; the scheduler, which is what keeps the dashboard answering while a
+88
;; check is hung. Outside async it degrades to a kernel sleep, which is
+89
;; correct for the one-shot CLI paths.
+90
(define poll-interval 0.05)
+91
+92
;; A child parked in a blocking mbedTLS read will not honour a polite
+93
;; shutdown, so SIGTERM gets only a short grace period before SIGKILL.
+94
(define term-grace 0.5) ;; seconds
+95
(define kill-grace 2) ;; seconds
+96
+97
;; Refuse to accumulate unbounded output from a runaway child.
+98
(define max-child-output 65536) ;; bytes
+99
+100
;; Markers. Both are asserted on, never merely assumed, so a child that
+101
;; produces nothing is a distinguishable outcome rather than a silent one.
+102
(define result-marker "VIGIL-CHECK-RESULT")
+103
(define selftest-marker "VIGIL-CHECK-SELFTEST-OK")
104
105
;; ============================================================
−38
;; HTTP Check
+106
;; Time helpers
107
;; ============================================================
108
−41
(define (run-http-check spec)
−42
(let ((url (check-spec-url spec)))
−43
(guard (exn (#t
−44
(check-record
−45
status: 'down
−46
latency: 0
−47
error: (if (error-object? exn)
−48
(error-object-message exn)
−49
(format "~a" exn))
−50
timestamp: (current-second))))
−51
(let* ((start (current-jiffy))
−52
(response (http-get url))
−53
(end (current-jiffy))
−54
(elapsed-ms (quotient (* 1000 (- end start))
−55
(jiffies-per-second))))
−56
(if (not (http-response? response))
+109
(define (seconds->jiffies s)
+110
(exact (round (* s (jiffies-per-second)))))
+111
+112
(define (elapsed-ms since)
+113
(quotient (* 1000 (- (current-jiffy) since)) (jiffies-per-second)))
+114
+115
(define (exn-message exn)
+116
(if (error-object? exn)
+117
(error-object-message exn)
+118
(format "~a" exn)))
+119
+120
;; ============================================================
+121
;; CHILD SIDE -- runs in the `check-url` subcommand
+122
;; ============================================================
+123
+124
;;; Perform one HTTP(S) check in this process and return a check-record.
+125
;;; Only ever called in a child; the supervising parent never calls it.
+126
(define (run-check-direct url connect-timeout read-timeout)
+127
(guard (exn (#t
+128
(check-record
+129
status: 'down
+130
latency: 0
+131
error: (exn-message exn)
+132
timestamp: (current-second))))
+133
(let* ((start (current-jiffy))
+134
(response (http-get url
+135
timeout: read-timeout
+136
connect-timeout: connect-timeout))
+137
(ms (elapsed-ms start)))
+138
(if (not (http-response? response))
+139
(check-record
+140
status: 'down
+141
latency: ms
+142
error: "Connection failed"
+143
timestamp: (current-second))
+144
(let ((code (http-response-status response)))
145
(check-record
−58
status: 'down
−59
latency: elapsed-ms
−60
error: "Connection failed"
−61
timestamp: (current-second))
−62
(let ((status-code (http-response-status response)))
+146
status: (cond ((< code 400) 'up)
+147
((>= code 500) 'down)
+148
(else 'degraded))
+149
latency: ms
+150
error: (if (>= code 400) (format "HTTP ~a" code) #f)
+151
timestamp: (current-second)))))))
+152
+153
;; Wire format, one line:
+154
;; VIGIL-CHECK-RESULT <status> <latency-ms> <error text to end of line>
+155
;; The error is last and unquoted so it can contain spaces. Newlines are
+156
;; flattened so one result is always exactly one line.
+157
(define (check-record->line r)
+158
(string-append
+159
result-marker " "
+160
(symbol->string (check-record-status r)) " "
+161
(number->string (check-record-latency r)) " "
+162
(flatten-newlines (or (check-record-error r) ""))
+163
"\n"))
+164
+165
(define (flatten-newlines s)
+166
(list->string
+167
(map (lambda (c) (if (or (char=? c #\newline) (char=? c #\return)) #\space c))
+168
(string->list s))))
+169
+170
;;; Parse the child's output back into a check-record.
+171
;;; Returns #f when no well-formed result line is present -- which the
+172
;;; caller must treat as a distinct failure, not as a healthy default.
+173
(define (parse-check-line text)
+174
(let loop ((lines (string-split text "\n")))
+175
(cond
+176
((null? lines) #f)
+177
((and (>= (string-length (car lines)) (string-length result-marker))
+178
(string=? (substring (car lines) 0 (string-length result-marker))
+179
result-marker))
+180
(parse-result-fields (car lines)))
+181
(else (loop (cdr lines))))))
+182
+183
(define (parse-result-fields line)
+184
(let ((parts (split-first-3 (substring line (+ 1 (string-length result-marker))
+185
(string-length line)))))
+186
(and parts
+187
(let ((status (string->symbol (car parts)))
+188
(latency (string->number (cadr parts)))
+189
(err (caddr parts)))
+190
(and (memq status '(up down degraded timeout unknown))
+191
(number? latency)
+192
(check-record
+193
status: status
+194
latency: latency
+195
error: (if (string=? err "") #f err)
+196
timestamp: (current-second)))))))
+197
+198
;; Split "up 123 some error text" into ("up" "123" "some error text").
+199
;; Only the first two spaces are separators; the remainder is free text.
+200
(define (split-first-3 s)
+201
(let* ((len (string-length s))
+202
(i (index-of-space s 0 len)))
+203
(and i
+204
(let ((j (index-of-space s (+ i 1) len)))
+205
(and j
+206
(list (substring s 0 i)
+207
(substring s (+ i 1) j)
+208
(substring s (+ j 1) len)))))))
+209
+210
(define (index-of-space s start end)
+211
(let loop ((i start))
+212
(cond ((>= i end) #f)
+213
((char=? (string-ref s i) #\space) i)
+214
(else (loop (+ i 1))))))
+215
+216
;; ============================================================
+217
;; PARENT SIDE -- executable resolution
+218
;; ============================================================
+219
+220
;;; Resolve the path this process was started from, so we can re-exec
+221
;;; ourselves as a check child.
+222
;;;
+223
;;; Returns a path string, or #f. #f MUST be treated as fatal by the
+224
;;; caller. Silently falling back to in-process checks would restore the
+225
;;; exact defect this module exists to remove, in the safe-LOOKING
+226
;;; direction, where nothing would complain until the next 55-day
+227
;;; silence.
+228
(define (resolve-checker-executable)
+229
(let ((argv (command-line)))
+230
(and (pair? argv)
+231
(let ((argv0 (car argv)))
+232
(cond
+233
((and (string-contains? argv0 "/") (file-exists? argv0)) argv0)
+234
((command-exists? argv0) argv0)
+235
(else #f))))))
+236
+237
;; ============================================================
+238
;; PARENT SIDE -- self-test
+239
;; ============================================================
+240
+241
;;; Prove the out-of-process mechanism actually works on THIS host with
+242
;;; THIS executable path, BEFORE any check depends on it.
+243
;;;
+244
;;; Without this, a spawn that always fails is indistinguishable from a
+245
;;; target that is always down: both produce a red dashboard and no
+246
;;; error. An instrument has to demonstrate it can produce a positive
+247
;;; result before its negative results mean anything.
+248
;;;
+249
;;; Returns #t on success, or a string describing the failure.
+250
(define (checker-self-test! exe)
+251
(let ((proc (guard (exn (#t #f))
+252
(process-spawn-pipe exe "check-selftest" die-with-parent: #t))))
+253
(if (not proc)
+254
(format "could not spawn '~a check-selftest'" exe)
+255
(let ((out (collect-child-output proc 15)))
+256
(cond
+257
((eq? (car out) 'timeout)
+258
"check-selftest did not finish within 15s")
+259
((string-contains? (cdr out) selftest-marker) #t)
+260
(else
+261
(format "check-selftest produced no ~a marker (got: ~a)"
+262
selftest-marker
+263
(truncate-for-log (cdr out) 200))))))))
+264
+265
(define (truncate-for-log s n)
+266
(let ((flat (flatten-newlines s)))
+267
(if (> (string-length flat) n)
+268
(string-append (substring flat 0 n) "...")
+269
flat)))
+270
+271
;; ============================================================
+272
;; PARENT SIDE -- supervised execution
+273
;; ============================================================
+274
+275
;;; Run one check in a child process under a wall-clock budget.
+276
;;; Always returns a check-record. Never blocks the scheduler for longer
+277
;;; than `poll-interval` at a time.
+278
(define (run-check-supervised exe url budget)
+279
(let* ((start (current-jiffy))
+280
(proc (guard (exn (#t #f))
+281
(process-spawn-pipe exe "check-url" url
+282
"--connect-timeout"
+283
(number->string default-connect-timeout)
+284
"--read-timeout"
+285
(number->string default-read-timeout)
+286
die-with-parent: #t))))
+287
(if (not proc)
+288
(check-record
+289
status: 'down
+290
latency: 0
+291
error: "could not spawn check process"
+292
timestamp: (current-second))
+293
(let ((out (collect-child-output proc budget)))
+294
(if (eq? (car out) 'timeout)
+295
;; A DISTINCT outcome. "the check timed out" and "the target
+296
;; is down" are different facts, and conflating them would
+297
;; hide precisely the class of failure being fixed here.
298
(check-record
−64
status: (cond
−65
((< status-code 400) 'up)
−66
((>= status-code 500) 'down)
−67
(else 'degraded))
−68
latency: elapsed-ms
−69
error: (if (>= status-code 400)
−70
(format "HTTP ~a" status-code)
−71
#f)
−72
timestamp: (current-second))))))))
+299
status: 'timeout
+300
latency: (elapsed-ms start)
+301
error: (format "no result within ~as wall-clock budget; check process killed"
+302
budget)
+303
timestamp: (current-second))
+304
(or (parse-check-line (cdr out))
+305
(check-record
+306
status: 'down
+307
latency: (elapsed-ms start)
+308
error: (format "check process produced no result line (~a)"
+309
(truncate-for-log (cdr out) 120))
+310
timestamp: (current-second))))))))
+311
+312
;;; Deliver an alert through a child process, under the same wall-clock
+313
;;; budget as a check.
+314
;;;
+315
;;; An alert fires exactly when something is already wrong, which is the
+316
;;; worst moment for the notifier's own outbound HTTPS call to block the
+317
;;; scheduler that serves the dashboard. Returns #t if the child reported
+318
;;; delivery, #f otherwise; the caller logs and continues either way.
+319
(define (run-notify-supervised exe config-path message budget)
+320
(let ((proc (guard (exn (#t #f))
+321
(process-spawn-pipe exe "notify"
+322
"--config" config-path
+323
message
+324
die-with-parent: #t))))
+325
(if (not proc)
+326
(begin
+327
(display " Alert send failed: could not spawn notify process\n"
+328
(current-error-port))
+329
#f)
+330
(let ((out (collect-child-output proc budget)))
+331
(cond
+332
((eq? (car out) 'timeout)
+333
(display (format " Alert send failed: notify exceeded ~as budget; killed\n"
+334
budget)
+335
(current-error-port))
+336
#f)
+337
((string-contains? (cdr out) "VIGIL-NOTIFY-SENT") #t)
+338
(else
+339
(display (format " Alert send failed: ~a\n"
+340
(truncate-for-log (cdr out) 200))
+341
(current-error-port))
+342
#f))))))
+343
+344
;;; Drain a child's stdout under a deadline.
+345
;;; Returns (done . output-string) or (timeout . partial-output).
+346
;;; On any exit path the child is dead and reaped.
+347
(define (collect-child-output proc budget)
+348
(let ((deadline (+ (current-jiffy) (seconds->jiffies budget))))
+349
(let loop ((acc ""))
+350
(let ((chunk (guard (exn (#t 'read-error))
+351
(process-pipe-read proc 4096))))
+352
(cond
+353
((eq? chunk 'read-error)
+354
(hard-kill! proc)
+355
(cons 'done acc))
+356
+357
((eof-object? chunk)
+358
(settle-child! proc)
+359
(cons 'done acc))
+360
+361
((and (bytevector? chunk) (> (bytevector-length chunk) 0))
+362
(let ((acc2 (string-append acc (utf8->string chunk))))
+363
(cond
+364
((> (string-length acc2) max-child-output)
+365
(hard-kill! proc)
+366
(cons 'done acc2))
+367
((>= (current-jiffy) deadline)
+368
(hard-kill! proc)
+369
(cons 'timeout acc2))
+370
(else (loop acc2)))))
+371
+372
((>= (current-jiffy) deadline)
+373
(hard-kill! proc)
+374
(cons 'timeout acc))
+375
+376
(else
+377
;; Yields to the scheduler. This is the line that keeps the
+378
;; dashboard answering while a check is hung.
+379
(sleep poll-interval)
+380
(loop acc)))))))
+381
+382
;; Child closed stdout. Give it a moment to exit on its own, then reap.
+383
;; If it does not exit, kill it: a child that closes stdout and then
+384
;; hangs would otherwise turn `process-wait` into a new wedge.
+385
(define (settle-child! proc)
+386
(if (wait-for-exit proc term-grace)
+387
(reap! proc)
+388
(hard-kill! proc)))
+389
+390
;;; Wall-clock kill. SIGTERM first as a courtesy, but with a short fuse:
+391
;;; a process blocked in a kernel read may never act on it, and waiting
+392
;;; for graceful exit would inherit the wedge one level up.
+393
(define (hard-kill! proc)
+394
(guard (exn (#t #f))
+395
(process-signal! proc 'term)
+396
(unless (wait-for-exit proc term-grace)
+397
(process-signal! proc 'kill)
+398
(wait-for-exit proc kill-grace))
+399
(reap! proc)))
+400
+401
;; Poll for exit with a deadline. Returns #t if the child is gone.
+402
;; Never calls a blocking wait.
+403
(define (wait-for-exit proc seconds)
+404
(let ((deadline (+ (current-jiffy) (seconds->jiffies seconds))))
+405
(let loop ()
+406
(cond
+407
((not (guard (exn (#t #f)) (process-alive? proc))) #t)
+408
((>= (current-jiffy) deadline) #f)
+409
(else (sleep poll-interval) (loop))))))
+410
+411
;; Reap ONLY a child already observed to be dead. `process-wait` blocks,
+412
;; so calling it on a live child would reintroduce the wedge.
+413
(define (reap! proc)
+414
(guard (exn (#t #f))
+415
(and (not (process-alive? proc))
+416
(begin (process-wait proc) #t))))
417
418
;; ============================================================
419
;; Check Loop
420
;; ============================================================
421
−78
(define (check-loop svc st interval on-check)
−79
;; Runs forever, checking the service every `interval` seconds.
−80
;; Calls on-check callback with (name, result, old-status) after each check.
+422
;;; Run `svc`'s check every `interval` seconds, forever.
+423
;;; `exe` must be a verified checker executable (see
+424
;;; `resolve-checker-executable` and `checker-self-test!`).
+425
(define (check-loop svc st interval on-check exe budget)
426
;; Initial delay lets the HTTP server finish binding.
427
(sleep 2)
428
(let loop ()
429
(guard (exn (#t
430
(display (format " Check error (~a): ~a\n"
−86
(service-name svc)
−87
(if (error-object? exn)
−88
(error-object-message exn)
−89
exn))
+431
(service-name svc) (exn-message exn))
432
(current-error-port))))
433
(let* ((name (service-name svc))
434
(old-status (state-get-status st name))
−93
(result (run-check svc)))
+435
(result (run-check-supervised
+436
exe (check-spec-url (service-check svc)) budget)))
437
(state-record-check! st name result)
438
(when on-check
439
(on-check name result old-status))))
src/vigil/config.sglmodified
@@ -16,6 +16,7 @@
16
vigil-config-host
17
vigil-config-port
18
vigil-config-check-interval
+19
vigil-config-check-timeout
20
vigil-config-services
21
vigil-config-telegram
22
@@ -49,6 +50,11 @@
50
(host default: "0.0.0.0")
51
(port default: 8400)
52
(check-interval default: 30)
+53
;; Wall-clock budget for ONE check, enforced by killing the check
+54
;; child. Must comfortably exceed the library connect+read timeouts
+55
;; (5s + 10s) so a slow-but-progressing endpoint is not killed while
+56
;; it is still making progress.
+57
(check-timeout default: 20)
58
(services default: '())
59
(telegram default: #f))
60
@@ -110,6 +116,7 @@
116
host: (config-keyword-ref args 'host "0.0.0.0")
117
port: (config-keyword-ref args 'port 8400)
118
check-interval: (config-keyword-ref args 'check-interval 30)
+119
check-timeout: (config-keyword-ref args 'check-timeout 20)
120
services: (parse-services (config-keyword-ref args 'services '()))
121
telegram: (parse-telegram-config
122
(config-keyword-ref args 'telegram #f)))))
src/vigil/main.sglmodified
@@ -1,17 +1,26 @@
1
;;; (vigil main) - CLI entry point, config loading, server startup.
2
;;;
−3
;;; Provides the CLI interface for Vigil. `serve` starts the monitoring
−4
;;; dashboard with periodic health checks and SSE live updates.
+3
;;; `serve` starts the monitoring dashboard with periodic health checks and
+4
;;; SSE live updates. Checks do NOT run in this process: `serve` re-execs
+5
;;; this same binary as `check-url` for each check and enforces a wall-clock
+6
;;; budget on it. See (vigil checker) for why.
+7
;;;
+8
;;; Subcommands used by the parent, not by humans:
+9
;;; check-url <url> --connect-timeout S --read-timeout S
+10
;;; check-selftest
+11
;;; notify --config PATH <message>
12
13
(define-library (vigil main)
14
(import (sigil core)
15
(sigil string)
16
(sigil process)
+17
(sigil io)
18
(sigil async)
19
(sigil channels)
20
(sigil time)
21
(sigil http server)
22
(sigil http response)
+23
(vigil build-info)
24
(vigil config)
25
(vigil checker)
26
(vigil state)
@@ -29,10 +38,13 @@
38
((null? args)
39
(print-usage)
40
(error "exiting"))
−32
((string=? (car args) "serve") (cmd-serve (cdr args)))
−33
((string=? (car args) "status") (cmd-status (cdr args)))
−34
((string=? (car args) "check") (cmd-check (cdr args)))
−35
((string=? (car args) "version") (display "vigil 0.1.0\n"))
+41
((string=? (car args) "serve") (cmd-serve (cdr args)))
+42
((string=? (car args) "status") (cmd-status (cdr args)))
+43
((string=? (car args) "check") (cmd-check (cdr args)))
+44
((string=? (car args) "check-url") (cmd-check-url (cdr args)))
+45
((string=? (car args) "check-selftest") (cmd-check-selftest))
+46
((string=? (car args) "notify") (cmd-notify (cdr args)))
+47
((string=? (car args) "version") (cmd-version))
48
(else
49
(display (format "vigil: unknown command '~a'\n" (car args)))
50
(print-usage)
@@ -49,6 +61,58 @@
61
(display "Options:\n")
62
(display " --config PATH Config file (default: vigil.sgl)\n"))
63
+64
(define (cmd-version)
+65
(display (format "vigil ~a (sigil runtime ~a)\n"
+66
vigil-version sigil-runtime-version)))
+67
+68
;; ============================================================
+69
;; Child subcommands
+70
;; ============================================================
+71
+72
;; One check, in this process, result on stdout. The parent kills this
+73
;; process if it does not finish in time, so it needs no self-discipline
+74
;; beyond the library timeouts it is handed.
+75
(define (cmd-check-url args)
+76
(when (null? args)
+77
(display "Usage: vigil check-url <url> [--connect-timeout S] [--read-timeout S]\n"
+78
(current-error-port))
+79
(error "exiting"))
+80
(let* ((url (car args))
+81
(ct (or (flag-number (cdr args) "--connect-timeout")
+82
default-connect-timeout))
+83
(rt (or (flag-number (cdr args) "--read-timeout")
+84
default-read-timeout))
+85
(result (run-check-direct url ct rt)))
+86
(display (check-record->line result))
+87
(flush-output-port (current-output-port))))
+88
+89
;; Proves the spawn path works. Deliberately does no I/O of its own:
+90
;; if this cannot run, nothing about a check result is trustworthy.
+91
(define (cmd-check-selftest)
+92
(display (string-append selftest-marker "\n"))
+93
(flush-output-port (current-output-port)))
+94
+95
;; Out-of-process Telegram alert. The Telegram client makes an ordinary
+96
;; blocking outbound HTTPS call, which in the parent would be one more
+97
;; unbounded segment on the scheduler that serves the dashboard --
+98
;; the same defect as the checks themselves, one layer over.
+99
(define (cmd-notify args)
+100
(let* ((config-path (find-config-path args))
+101
(message (last-non-flag args)))
+102
(if (not message)
+103
(begin
+104
(display "Usage: vigil notify --config PATH <message>\n"
+105
(current-error-port))
+106
(error "exiting"))
+107
(let* ((cfg (load-vigil-config config-path))
+108
(alerter (make-alerter (vigil-config-telegram cfg))))
+109
(if alerter
+110
(begin
+111
(alerter-deliver! alerter message)
+112
(display "VIGIL-NOTIFY-SENT\n"))
+113
(display "VIGIL-NOTIFY-SKIPPED no telegram credentials\n"))
+114
(flush-output-port (current-output-port))))))
+115
116
;; ============================================================
117
;; serve
118
;; ============================================================
@@ -59,61 +123,87 @@
123
(services (vigil-config-services cfg))
124
(st (make-service-state services))
125
(bc (make-status-broadcast))
−62
(alerter (make-alerter (vigil-config-telegram cfg)))
−63
(log-services (services-with-logs services))
−64
(log-st (if (null? log-services)
−65
#f
−66
(make-log-state
−67
(map service-name log-services) 500)))
−68
(handler (make-vigil-app cfg st bc log-st))
−69
(port (vigil-config-port cfg))
+126
(budget (vigil-config-check-timeout cfg))
127
(interval (vigil-config-check-interval cfg))
−71
(host (vigil-config-host cfg))
−72
(server (make-http-server handler port: port host: host)))
−73
(let ((err (current-error-port)))
−74
(display (format "Vigil v0.1.0\n") err)
+128
(err (current-error-port))
+129
(exe (resolve-checker-executable)))
+130
+131
;; ------------------------------------------------------------
+132
;; Refuse to start if the out-of-process mechanism is not usable.
+133
;;
+134
;; Falling back to in-process checks here would restore the exact
+135
;; defect this design removes, in the direction that LOOKS safe:
+136
;; the dashboard would come up, checks would appear to run, and the
+137
;; next stalled endpoint would take the service down silently. A
+138
;; monitor that cannot isolate its checks must say so loudly rather
+139
;; than quietly become the thing that failed for 55 days.
+140
;; ------------------------------------------------------------
+141
(unless exe
+142
(display "vigil: cannot resolve own executable path from argv[0];\n" err)
+143
(display " checks cannot be isolated. Refusing to start.\n" err)
+144
(error "exiting"))
+145
+146
(display (format "Vigil ~a (sigil runtime ~a)\n"
+147
vigil-version sigil-runtime-version) err)
+148
(display (format "Check isolation: out-of-process via ~a\n" exe) err)
+149
+150
;; Assert the instrument works before any result from it is believed.
+151
(let ((selftest (checker-self-test! exe)))
+152
(unless (eq? selftest #t)
+153
(display (format "vigil: check-process self-test FAILED: ~a\n" selftest) err)
+154
(display " Refusing to start: a spawn failure is\n" err)
+155
(display " indistinguishable from every target being down.\n" err)
+156
(error "exiting")))
+157
(display "Check isolation self-test: OK\n" err)
+158
+159
(let* ((alerter (make-alerter-out-of-process
+160
(vigil-config-telegram cfg)
+161
(lambda (message)
+162
(run-notify-supervised exe config-path message budget))))
+163
(log-services (services-with-logs services))
+164
(log-st (if (null? log-services)
+165
#f
+166
(make-log-state (map service-name log-services) 500)))
+167
(handler (make-vigil-app cfg st bc log-st))
+168
(port (vigil-config-port cfg))
+169
(host (vigil-config-host cfg))
+170
(server (make-http-server handler port: port host: host)))
+171
172
(display (format "Monitoring ~a service~a\n"
−76
(length services)
−77
(if (= (length services) 1) "" "s")) err)
−78
(display (format "Check interval: ~as\n" interval) err)
+173
(length services)
+174
(if (= (length services) 1) "" "s")) err)
+175
(display (format "Check interval: ~as, wall-clock budget: ~as\n"
+176
interval budget) err)
177
(when alerter
−80
(display "Telegram alerts: enabled\n" err))
+178
(display "Telegram alerts: enabled (out-of-process)\n" err))
179
(unless (null? log-services)
180
(display (format "Log tailing: ~a service~a\n"
−83
(length log-services)
−84
(if (= (length log-services) 1) "" "s")) err))
−85
(display (format "Dashboard: http://~a:~a\n\n" host port) err))
−86
(with-async
−87
;; Start the HTTP server
−88
(go (http-server-start server))
−89
;; Start health check loops
−90
(for-each
−91
(lambda (svc)
−92
(display (format " Starting checker for ~a\n" (service-name svc))
−93
(current-error-port))
−94
(go (check-loop svc st interval
−95
(lambda (name result old-status)
−96
(notify-status-change bc st name result)
−97
(alerter-send! alerter name result old-status)))))
−98
services)
−99
;; Start log tailers
−100
(when log-st
+181
(length log-services)
+182
(if (= (length log-services) 1) "" "s")) err))
+183
(display (format "Dashboard: http://~a:~a\n" host port) err)
+184
(display (format "Liveness: http://~a:~a/healthz\n\n" host port) err)
+185
+186
(with-async
+187
(go (http-server-start server))
188
(for-each
189
(lambda (svc)
−103
(start-file-tailer! log-st
−104
(service-name svc)
−105
(log-spec-path (service-logs svc))))
−106
log-services))
−107
;; Start SSE heartbeat to detect stale connections.
−108
;; sigil-http's start-sse-heartbeat! accepts a list of
−109
;; broadcasts; it broadcasts the heartbeat sentinel on each
−110
;; one every 30s and the SSE broadcast loop converts it to
−111
;; an SSE comment write — failed writes unsubscribe dead
−112
;; clients automatically.
−113
(start-sse-heartbeat!
−114
(cons bc
−115
(if log-st (log-state-all-broadcasts log-st) '())))
−116
(display "\n" (current-error-port)))))
+190
(display (format " Starting checker for ~a\n" (service-name svc)) err)
+191
(go (check-loop svc st interval
+192
(lambda (name result old-status)
+193
(notify-status-change bc st name result)
+194
(alerter-send! alerter name result old-status))
+195
exe budget)))
+196
services)
+197
(when log-st
+198
(for-each
+199
(lambda (svc)
+200
(start-file-tailer! log-st
+201
(service-name svc)
+202
(log-spec-path (service-logs svc))))
+203
log-services))
+204
(start-sse-heartbeat!
+205
(cons bc (if log-st (log-state-all-broadcasts log-st) '())))
+206
(display "\n" err)))))
207
208
;; ============================================================
209
;; status
@@ -127,12 +217,12 @@
217
(for-each
218
(lambda (svc)
219
(display (format " ~a ~a\n"
−130
(pad-right (service-name svc) 20)
−131
(service-description svc))))
+220
(pad-right (service-name svc) 20)
+221
(service-description svc))))
222
services)))
223
224
;; ============================================================
−135
;; check
+225
;; check (one-shot, human-facing)
226
;; ============================================================
227
228
(define (cmd-check args)
@@ -142,20 +232,29 @@
232
(let* ((name (car args))
233
(config-path (find-config-path (cdr args)))
234
(cfg (load-vigil-config config-path))
−145
(svc (find-service (vigil-config-services cfg) name)))
−146
(if svc
−147
(with-async
−148
(let ((result (run-check svc)))
−149
(display (format "~a: ~a (~ams)\n"
−150
(service-name svc)
−151
(check-record-status result)
−152
(check-record-latency result)))
−153
(when (check-record-error result)
−154
(display (format " error: ~a\n"
−155
(check-record-error result))))))
−156
(begin
−157
(display (format "Unknown service: ~a\n" name))
−158
(error "exiting")))))
+235
(svc (find-service (vigil-config-services cfg) name))
+236
(exe (resolve-checker-executable)))
+237
(cond
+238
((not svc)
+239
(display (format "Unknown service: ~a\n" name))
+240
(error "exiting"))
+241
((not exe)
+242
(display "vigil: cannot resolve own executable path; cannot isolate check\n"
+243
(current-error-port))
+244
(error "exiting"))
+245
(else
+246
;; Same supervised path `serve` uses, so `vigil check` exercises
+247
;; the mechanism rather than a parallel, untested one.
+248
(with-async
+249
(let ((result (run-check-supervised
+250
exe (check-spec-url (service-check svc))
+251
(vigil-config-check-timeout cfg))))
+252
(display (format "~a: ~a (~ams)\n"
+253
(service-name svc)
+254
(check-record-status result)
+255
(check-record-latency result)))
+256
(when (check-record-error result)
+257
(display (format " error: ~a\n" (check-record-error result))))))))))
258
259
;; ============================================================
260
;; Helpers
@@ -165,17 +264,29 @@
264
(filter (lambda (svc) (service-logs svc)) services))
265
266
(define (find-config-path args)
−168
(or (get-flag args "--config")
−169
"vigil.sgl"))
+267
(or (get-flag args "--config") "vigil.sgl"))
268
269
(define (get-flag args flag)
270
(let loop ((args args))
271
(cond
272
((null? args) #f)
−175
((and (string=? (car args) flag) (pair? (cdr args)))
−176
(cadr args))
+273
((and (string=? (car args) flag) (pair? (cdr args))) (cadr args))
274
(else (loop (cdr args))))))
275
+276
(define (flag-number args flag)
+277
(let ((v (get-flag args flag)))
+278
(and v (string->number v))))
+279
+280
;; Last argument that is neither a flag nor a flag's value.
+281
(define (last-non-flag args)
+282
(let loop ((rest args) (found #f))
+283
(cond
+284
((null? rest) found)
+285
((and (>= (string-length (car rest)) 2)
+286
(string=? (substring (car rest) 0 2) "--"))
+287
(loop (if (pair? (cdr rest)) (cddr rest) '()) found))
+288
(else (loop (cdr rest) (car rest))))))
+289
290
(define (find-service services name)
291
(let loop ((svcs services))
292
(cond
src/vigil/state.sglmodified
@@ -34,6 +34,10 @@
34
service-entry-last-change
35
service-entry-last-latency
36
service-entry-uptime
+37
service-entry-last-completed
+38
+39
;; Liveness
+40
state-stale-services
41
42
;; Utilities
43
take-up-to)
@@ -60,7 +64,14 @@
64
(history default: '())
65
(last-change default: 0)
66
(last-latency default: 0)
−63
(uptime default: 1.0))
+67
(uptime default: 1.0)
+68
;; Wall-clock second at which this service's check loop last COMPLETED
+69
;; a cycle. Distinct from `last-change`, and deliberately advanced even
+70
;; when the check failed or timed out: it answers "is the checker still
+71
;; running?", not "is the target healthy?". Those are different
+72
;; questions, and conflating them is how a monitor reports itself fine
+73
;; while monitoring nothing. 0 means "has never completed a cycle".
+74
(last-completed default: 0))
75
76
(define max-history 100)
77
@@ -138,7 +149,32 @@
149
history: new-history
150
last-change: (if changed? now (service-entry-last-change entry))
151
last-latency: (check-record-latency result)
−141
uptime: (calculate-uptime new-history)))))
+152
uptime: (calculate-uptime new-history)
+153
last-completed: (current-second)))))
+154
+155
;; ============================================================
+156
;; Liveness
+157
;; ============================================================
+158
+159
;;; Names of services whose check loop has not completed a cycle within
+160
;;; `budget` seconds. Empty list means every checker is still turning.
+161
;;;
+162
;;; A service that has NEVER completed a cycle (last-completed 0) counts
+163
;;; as stale once `started-at + budget` has passed -- otherwise a process
+164
;;; whose checkers never started at all would report healthy forever,
+165
;;; which is the failure mode this whole endpoint exists to catch.
+166
(define (state-stale-services st budget now started-at)
+167
(let loop ((entries (state-all-entries st)) (stale '()))
+168
(cond
+169
((null? entries) (reverse stale))
+170
(else
+171
(let* ((e (car entries))
+172
(last (service-entry-last-completed e))
+173
(reference (if (= last 0) started-at last)))
+174
(loop (cdr entries)
+175
(if (> (- now reference) budget)
+176
(cons (service-entry-name e) stale)
+177
stale)))))))
178
179
(define (calculate-uptime history)
180
(if (null? history)
src/vigil/views.sglmodified
@@ -80,6 +80,8 @@
80
.log-container.filter-info .log-line:not(.log-line-info) { display: none; }
81
.log-container.filter-debug .log-line:not(.log-line-debug) { display: none; }
82
.sg-sse-connector { display: none; }
+83
.status-timeout { background: var(--color-warning); color: #000; }
+84
.dot-timeout { background: var(--color-warning); }
85
")
86
87
(define vigil-supplemental-css
@@ -160,12 +162,19 @@
162
(list 'span '(@ (class "service-latency"))
163
(format-latency latency))))))
164
−163
;; Map status to accent class name
+165
;; Map status to accent class name.
+166
;;
+167
;; `timeout` is its own status and must NOT be folded into `down`.
+168
;; "the target is down" and "we could not find out whether the target is
+169
;; down, and had to kill the check" are different facts. Collapsing them
+170
;; would hide exactly the class of failure vigil was blind to for 55
+171
;; days -- a check that never returns.
172
(define (status->accent status)
173
(cond
174
((string=? status "up") "success")
175
((string=? status "down") "error")
176
((string=? status "degraded") "warning")
+177
((string=? status "timeout") "warning")
178
(else "primary")))
179
180
;; ============================================================
src/vigil/web.sglmodified
@@ -23,6 +23,7 @@
23
(sigil web routes)
24
(sigil web middleware)
25
(sigil web ui)
+26
(vigil build-info)
27
(vigil config)
28
(vigil state)
29
(vigil logs)
@@ -85,6 +86,11 @@
86
(route method: GET pattern: "/style.css"
87
handler: css-handler)
88
+89
;; Liveness. Deliberately the cheapest handler in the router:
+90
;; pure in-memory reads, no I/O, nothing that can block.
+91
(route method: GET pattern: "/healthz"
+92
handler: (healthz-handler cfg st))
+93
94
;; Sigil Web UI client library
95
(route method: GET pattern: "/js/sigil-web-ui.js"
96
handler: (sigil-web-ui-handler))
@@ -107,6 +113,65 @@
113
(route method: GET pattern: "/api/service/:name/logs"
114
handler: (api-service-logs-handler log-st))))))))
115
+116
;; ============================================================
+117
;; Liveness
+118
;; ============================================================
+119
;;
+120
;; WHAT THIS IS FOR, and what it deliberately is NOT.
+121
;;
+122
;; On 2026-06-10 vigil stopped monitoring anything for 55 days while
+123
;; `rcctl status` said started, the port said LISTEN, and the process
+124
;; said alive. All three were true and all three were useless: the
+125
;; service was accepting connections and never answering them.
+126
;;
+127
;; This endpoint closes half of that gap. It goes red when the check
+128
;; loops stop turning while the server still answers.
+129
;;
+130
;; It CANNOT close the other half by itself. In the exact pid-5826
+131
;; state, nothing answers -- including this. That is not a flaw to be
+132
;; engineered around in-process; it is the reason the check must be made
+133
;; FROM OUTSIDE, with a hard client-side timeout, by
+134
;; `deploy/vigil-watchdog.sh`. A fetch that times out is the red.
+135
;;
+136
;; So: 200 means "checkers are turning". Anything else -- 503, a
+137
;; connection refused, or a timeout -- means "do not trust this monitor".
+138
+139
;; A checker is stale once it has missed roughly three cycles, plus one
+140
;; full wall-clock budget for a check that is currently being killed,
+141
;; plus a small constant so a busy host does not flap.
+142
(define (staleness-budget cfg)
+143
(+ (* 3 (vigil-config-check-interval cfg))
+144
(vigil-config-check-timeout cfg)
+145
10))
+146
+147
(define (healthz-handler cfg st)
+148
(let ((started-at (current-second)))
+149
(lambda (req)
+150
(let* ((now (current-second))
+151
(budget (staleness-budget cfg))
+152
(stale (state-stale-services st budget now started-at))
+153
(healthy? (null? stale)))
+154
(http-response/json (if healthy? 200 503)
+155
(json-encode
+156
(dict status: (if healthy? "ok" "stale")
+157
vigil: vigil-version
+158
sigil: sigil-runtime-version
+159
uptime-seconds: (- now started-at)
+160
check-interval: (vigil-config-check-interval cfg)
+161
check-timeout: (vigil-config-check-timeout cfg)
+162
staleness-budget: budget
+163
stale-checkers: stale
+164
checkers: (map (lambda (e)
+165
(dict name: (service-entry-name e)
+166
status: (symbol->string
+167
(service-entry-status e))
+168
last-completed: (service-entry-last-completed e)
+169
seconds-since-check:
+170
(if (= (service-entry-last-completed e) 0)
+171
-1
+172
(- now (service-entry-last-completed e)))))
+173
(state-all-entries st)))))))))
+174
175
;; ============================================================
176
;; Dashboard Handlers
177
;; ============================================================