guix-profile := ~/.guix-home/profile
guix-store := /gnu/store
-guix-version := $(shell guix show guix | sed -n '/^version/s/^.*: //gp')
+
+# Strip the GUILE_* variables before running guix: sourced profile
+# files put the system profile's guix modules ahead of the current
+# guix's, which makes the latter fail with record ABI mismatches.
+guix-env := env -u GUILE_LOAD_PATH -u GUILE_LOAD_COMPILED_PATH \
+ -u GUILE_EXTENSIONS_PATH
+
+guix-version := $(shell $(guix-env) guix show guix | sed -n '/^version/s/^.*: //gp')
home-nonfree:
- GUIX_PACKAGE_PATH=`pwd` PROFILE=nonfree guix home reconfigure home.scm
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=nonfree \
+ guix home reconfigure home.scm
. $(guix-profile)/etc/profile
home-libre:
- GUIX_PACKAGE_PATH=`pwd` PROFILE=libre guix home reconfigure home.scm
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=libre \
+ guix home reconfigure home.scm
. $(guix-profile)/etc/profile
system-nonfree:
- sudo GUIX_PACKAGE_PATH=`pwd` PROFILE=nonfree guix system reconfigure system.scm
+ sudo $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=nonfree \
+ guix system reconfigure system.scm
system-libre:
- sudo GUIX_PACKAGE_PATH=`pwd` PROFILE=libre guix system reconfigure system.scm
+ sudo $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=libre \
+ guix system reconfigure system.scm
vps-home:
- GUIX_PACKAGE_PATH=`pwd` guix home reconfigure \
- -L `pwd` -e '(@ (vps-home) vps-home-environment)'
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix home reconfigure \
+ -L $(CURDIR) -e '(@ (vps-home) vps-home-environment)'
. $(guix-profile)/etc/profile
vps-system:
- sudo GUIX_PACKAGE_PATH=`pwd` guix system reconfigure \
- -L `pwd` -e '(@ (vps-system) vps-operating-system)' --substitute-urls="https://substitutes.nonguix.org https://bordeaux.guix.gnu.org https://ci.guix.gnu.org"
+ sudo $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix system reconfigure \
+ -L $(CURDIR) -e '(@ (vps-system) vps-operating-system)' \
+ --substitute-urls="https://substitutes.nonguix.org https://bordeaux.guix.gnu.org https://ci.guix.gnu.org"
# Build-only targets — validate configuration without activating.
# these on non-main branches; on main it runs the reconfigure
# targets directly.
build-home-nonfree:
- GUIX_PACKAGE_PATH=`pwd` PROFILE=nonfree \
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=nonfree \
guix home build home.scm
build-home-libre:
- GUIX_PACKAGE_PATH=`pwd` PROFILE=libre \
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=libre \
guix home build home.scm
build-system-nonfree:
- GUIX_PACKAGE_PATH=`pwd` PROFILE=nonfree \
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=nonfree \
guix system build system.scm
build-system-libre:
- GUIX_PACKAGE_PATH=`pwd` PROFILE=libre \
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) PROFILE=libre \
guix system build system.scm
build-vps-system:
- GUIX_PACKAGE_PATH=`pwd` guix system build \
- -L `pwd` -e '(@ (vps-system) vps-operating-system)'
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix system build \
+ -L $(CURDIR) -e '(@ (vps-system) vps-operating-system)'
build-vps-home:
- GUIX_PACKAGE_PATH=`pwd` guix home build \
- -L `pwd` -e '(@ (vps-home) vps-home-environment)'
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix home build \
+ -L $(CURDIR) -e '(@ (vps-home) vps-home-environment)'
build-vps: build-vps-system build-vps-home
# runs all test cases. Uses cache by default; tests are
# deterministic for given inputs.
test-vps: build-vps-system build-vps-home
- @out=$$(GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
+ @out=$$($(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
-e '(@ (tests vps-base) %test-vps)' 2>/dev/null); \
if [ -n "$$out" ] && [ -e "$$out" ]; then \
echo "📋 Cached: $$out"; \
echo " Run 'make test-vps-fresh' to re-execute."; \
else \
- GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
-e '(@ (tests vps-base) %test-vps)'; \
fi
# Force fresh tests — delete cached result and rebuild.
test-vps-fresh: build-vps-system build-vps-home
- @out=$$(GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
+ @out=$$($(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
-e '(@ (tests vps-base) %test-vps)' 2>/dev/null); \
[ -n "$$out" ] && [ -e "$$out" ] \
&& guix gc --delete "$$out" 2>/dev/null; \
- GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
+ $(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
-e '(@ (tests vps-base) %test-vps)'
-# Live rehearsal of claude-proxy against the real DeepSeek API:
-# starts the built proxy pointed at https://api.deepseek.com/anthropic
-# and sends one streaming and one non-streaming request through it.
-# The API key is read from the per-user runtime cache
-# (/run/user/$(id -u)/claude-apikey); without a key the requests
-# still exercise the chain and expect relayed 401s. Not hermetic —
-# never part of the deterministic suite.
-test-vps-live:
- @key=""; \
- keyfile="/run/user/$$(id -u)/claude-apikey"; \
+# Live rehearsal of claude-proxy against the real DeepSeek API — only
+# for claude-proxy changes. Runs the current tree's proxy against
+# https://api.deepseek.com/anthropic and sends one streaming and one
+# non-streaming request through it. The API key is read from the
+# per-user runtime cache (/run/user/$(id -u)/claude-apikey); without
+# a key the requests still exercise the chain and expect relayed
+# 401s. The stamp makes the probe run only when
+# conf/common/claude-proxy.scm changed since the last run. Not
+# hermetic — never part of the deterministic suite.
+stamp := .claude/.stamp-claude-proxy-live
+
+$(stamp): conf/common/claude-proxy.scm
+ @keyfile="/run/user/$$(id -u)/claude-apikey"; \
+ key=""; \
if [ -r "$$keyfile" ] && [ -s "$$keyfile" ]; then \
- key="$$(/run/current-system/profile/bin/tr -d '\n' < "$$keyfile")"; \
+ key="$$(cat "$$keyfile")"; \
fi; \
- proxy="$$(GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
- -e '(@ (conf common claude-proxy) claude-proxy-script)' \
- 2>/dev/null)"; \
+ proxy="$$($(guix-env) GUIX_PACKAGE_PATH=$(CURDIR) guix build -L $(CURDIR) \
+ -e '(@ (conf common claude-proxy) claude-proxy-script)')"; \
log="/tmp/claude-proxy-live.log"; \
rm -f "$$log"; \
- env -u GUILE_LOAD_PATH -u GUILE_LOAD_COMPILED_PATH \
- PROXY_PORT=16998 \
+ PROXY_PORT=16998 \
CLAUDE_PROXY_UPSTREAM=https://api.deepseek.com/anthropic \
CLAUDE_PROXY_TIMEOUT=60 "$$proxy" > "$$log" 2>&1 & \
pid=$$!; \
trap 'kill $$pid 2>/dev/null' EXIT; \
sleep 1; \
+ cat "$$log"; \
auth=""; \
if [ -n "$$key" ]; then auth="x-api-key: $$key"; fi; \
- echo "--- proxy log:"; \
- /run/current-system/profile/bin/cat "$$log"; \
- body='{"stream":false,"model":"deepseek-chat","max_tokens":32,"messages":[{"role":"user","content":"Reply with the single word OK"}]}'; \
+ probe() { \
+ curl -sS -N -m 90 -w '\nHTTP %{http_code} in %{time_total}s\n' \
+ http://127.0.0.1:16998/v1/messages \
+ -H 'content-type: application/json' \
+ $${auth:+-H "$$auth"} -d "$$2" | head -c "$$3"; \
+ echo; \
+ }; \
echo "--- non-stream request:"; \
- /home/dak/.guix-profile/bin/curl -sS -m 90 \
- -w '\nHTTP %{http_code} in %{time_total}s\n' \
- http://127.0.0.1:16998/v1/messages \
- -H 'content-type: application/json' \
- $${auth:+-H "$$auth"} \
- -d "$$body" | /run/current-system/profile/bin/head -c 1500; \
- echo; \
- body='{"stream":true,"model":"deepseek-chat","max_tokens":32,"messages":[{"role":"user","content":"Reply with the single word OK"}]}'; \
+ probe plain '{"stream":false,"model":"deepseek-chat","max_tokens":32,"messages":[{"role":"user","content":"Reply with the single word OK"}]}' 1500; \
echo "--- stream request:"; \
- /home/dak/.guix-profile/bin/curl -sS -N -m 90 \
- -w '\nHTTP %{http_code} in %{time_total}s\n' \
- http://127.0.0.1:16998/v1/messages \
- -H 'content-type: application/json' \
- $${auth:+-H "$$auth"} \
- -d "$$body" | /run/current-system/profile/bin/head -c 2500; \
- echo; \
+ probe stream '{"stream":true,"model":"deepseek-chat","max_tokens":32,"messages":[{"role":"user","content":"Reply with the single word OK"}]}' 2500; \
echo "--- proxy log events:"; \
- /run/current-system/profile/bin/grep -o 'event=[a-z-]*' "$$log" \
- | /run/current-system/profile/bin/sort \
- | /run/current-system/profile/bin/uniq -c
+ grep -o 'event=[a-z-]*' "$$log" | sort | uniq -c; \
+ touch "$@"
+
+.PHONY: test-claude-proxy-live
+test-claude-proxy-live: $(stamp)
tags:
find $(guix-store) -wholename "*guix-$(guix-version)*.scm" -or \
;; Copyright (c) 2026 Jakub Czajka <jakub@ekhem.eu.org>
;; License: GPL-3.0 or later.
;;
-;; Guile HTTP proxy for Claude Code: forwards Anthropic-format
-;; requests to DeepSeek, injects thinking:disabled on non-streaming
-;; requests without a thinking field, streams responses back
-;; incrementally, and bounds every wait with an idle timeout. Every
-;; request logs one line per event, traceable by req=<id>.
+;; Guile HTTP proxy for Claude Code: forwards Anthropic-format requests to
+;; DeepSeek, injects thinking:disabled on non-streaming requests without a
+;; thinking field, streams responses back incrementally, and bounds every wait
+;; with an idle timeout. Every request logs one line per event, traceable by
+;; req=<id>.
;;
;; Reads PROXY_PORT, CLAUDE_PROXY_UPSTREAM, CLAUDE_PROXY_TIMEOUT and
-;; CLAUDE_PROXY_WATCHDOG_SECONDS from the environment in the
-;; Configuration block at the top of the script body. The
-;; program-file wraps the code in with-extensions, putting the
-;; off-prefix (gnutls) and (json) modules on the load path.
+;; CLAUDE_PROXY_WATCHDOG_SECONDS from the environment in the Configuration block
+;; at the top of the script body. The program-file wraps the code in
+;; with-extensions, putting the off-prefix (gnutls) and (json) modules on the
+;; load path.
(define-module (conf common claude-proxy)
#:use-module (gnu packages guile)
#:export (claude-proxy-script claude-proxy-daemon-service))
(define claude-proxy-code
- ;; One top-level (begin ...): use-modules resolves at expansion
- ;; time, after the with-extensions prologue (see
- ;; claude-proxy-script) has put (gnutls) and (json) on the load
- ;; paths.
+ ;; One top-level (begin ...): use-modules resolves at expansion time, after
+ ;; the with-extensions prologue (see claude-proxy-script) has put (gnutls) and
+ ;; (json) on the load paths.
#~(begin
(use-modules (gnutls)
(web client)
(ice-9 regex)
(srfi srfi-1))
- ;; Make the GnuTLS bindings visible to (web client) so its
- ;; internal TLS helpers (certificate verification) resolve.
- (catch #t
- (lambda ()
- (module-use! (resolve-module '(web client))
- (resolve-interface '(gnutls)))
- (format (current-error-port) "[claude-proxy] gnutls loaded~%"))
- (lambda _
- (format (current-error-port)
- "[claude-proxy] gnutls NOT available~%")))
+ ;; (web client) is built without gnutls; its certificate helpers resolve
+ ;; only after its own loader links the (gnutls) interface into the module.
+ ;; The upstream is https-only, so a missing gnutls is fatal: the
+ ;; 'gnutls-not-available error aborts startup and shepherd respawns (see
+ ;; the bind-failure path below).
+ ((@@ (web client) load-gnutls))
;; ── Configuration ───────────────────────────────
(string->uri (or (getenv "CLAUDE_PROXY_UPSTREAM")
"https://api.deepseek.com/anthropic")))
- ;; Idle timeout in seconds: bounds connect, waiting for
- ;; upstream response headers, and every gap in a streamed
- ;; response. Long generations survive as long as bytes flow.
+ ;; Idle timeout in seconds: bounds connect, waiting for upstream response
+ ;; headers, and every gap in a streamed response. Long generations
+ ;; survive as long as bytes flow.
(define idle-timeout
(or (and=> (getenv "CLAUDE_PROXY_TIMEOUT") string->number) 60))
;; ── Deadline port ───────────────────────────────
;;
- ;; Every network read and write goes through this custom
- ;; port. Before pulling from the underlying socket the port
- ;; waits on select(2) with an idle deadline; each pull drains
- ;; everything that is available (a whole TLS record for
- ;; https upstreams) so select never hides data buffered at a
- ;; lower layer.
+ ;; Every network read and write goes through this custom port. Before
+ ;; pulling from the underlying socket the port waits on select(2) with an
+ ;; idle deadline; each pull drains everything that is available (a whole
+ ;; TLS record for https upstreams) so select never hides data buffered at
+ ;; a lower layer.
(define stage-size
65536)
(throw 'claude-proxy-timeout kind))
(let* ((read? (eq? kind
'read))
- ;; SELECT returns lists of fds; the single fd shows
- ;; up in the first list when readable and in the
- ;; second when writable.
+ ;; SELECT returns lists of fds; the single fd shows up in the
+ ;; first list when readable and in the second when writable.
(ready (select (if read?
(list fdes)
'())
(and session
(eq? err error/premature-termination)))
(define (tls-again? err)
- ;; GnuTLS consumed bytes that do not yet form a complete
- ;; record; select cannot see them, so wait for more and
- ;; retry instead of reporting an error.
+ ;; GnuTLS consumed bytes that do not yet form a complete record;
+ ;; select cannot see them, so wait for more and retry instead of
+ ;; reporting an error.
(and session
(eq? err error/again)))
(define (fill! deadline-ms)
(define (wrap-tls sock host)
(define session
(make-session connection-end/client))
- (if (module-defined? (resolve-interface '(gnutls))
- 'set-session-server-name!)
- (set-session-server-name! session server-name-type/dns host))
+ (set-session-server-name! session server-name-type/dns host)
(set-session-transport-fd! session
(fileno sock))
(set-session-default-priority! session)
session)
(define (uri-effective-port url)
- ;; Portless URLs fall back to the scheme default, as guile's
- ;; own (web client) does.
+ ;; Portless URLs fall back to the scheme default, as guile's own (web
+ ;; client) does.
(or (uri-port url)
(match (uri-scheme url)
((or 'http
(_ #f))))
(define (host-header url)
- ;; Host as a (host . port) pair — the shape guile validates —
- ;; with the port omitted when it is the scheme default.
+ ;; Host as a (host . port) pair — the shape guile validates — with the
+ ;; port omitted when it is the scheme default.
(let ((p (uri-effective-port url)))
(if (or (and (eq? (uri-scheme url)
'https)
(cons (uri-host url) p))))
(define (open-upstream url)
- ;; Connect in a worker thread, bounded by IDLE-TIMEOUT;
- ;; throws 'claude-proxy-timeout on expiry.
+ ;; Connect in a worker thread, bounded by IDLE-TIMEOUT; throws
+ ;; 'claude-proxy-timeout on expiry.
(define host
(uri-host url))
(define svc
(lambda ()
(let ((sock (socket PF_INET SOCK_STREAM 0)))
(set-car! sock-cell sock)
- ;; Backstop for GnuTLS's own C-level reads and
- ;; writes; the select-based deadline port is the
- ;; primary bound.
+ ;; Backstop for GnuTLS's own C-level reads and writes; the
+ ;; select-based deadline port is the primary bound.
(setsockopt sock SOL_SOCKET SO_RCVTIMEO
(cons idle-timeout 0))
(setsockopt sock SOL_SOCKET SO_SNDTIMEO
(unlock-mutex result-mutex))))
(define worker-thread
(call-with-new-thread worker))
- ;; Re-check RESULT before waiting: the worker may publish and
- ;; signal before the wait starts, and a signal with no waiter
- ;; is lost. WAIT-CONDITION-VARIABLE returns #t when awakened
- ;; and #f once the absolute DEADLINE has passed.
+ ;; Re-check RESULT before waiting: the worker may publish and signal
+ ;; before the wait starts, and a signal with no waiter is lost.
+ ;; WAIT-CONDITION-VARIABLE returns #t when awakened and #f once the
+ ;; absolute DEADLINE has passed.
(lock-mutex result-mutex)
(let* ((t0 (gettimeofday))
(deadline (cons (+ (car t0) idle-timeout)
(cadr result)
(cddr result))))
(begin
- ;; Closing the socket bounds the damage if the worker
- ;; is still blocked in connect(2) or the handshake;
- ;; cancel-thread cannot interrupt C-level blocking.
+ ;; Closing the socket bounds the damage if the worker is still
+ ;; blocked in connect(2) or the handshake; cancel-thread cannot
+ ;; interrupt C-level blocking.
(cancel-thread worker-thread)
(let ((sock (car sock-cell)))
(when (port? sock)
;; ── Request rewriting ───────────────────────────
(define (prepare-payload json id)
- ;; DeepSeek reasoning models default to thinking on, which
- ;; stalls non-streaming calls behind full reasoning time.
+ ;; DeepSeek reasoning models default to thinking on, which stalls
+ ;; non-streaming calls behind full reasoning time.
(let ((stream? (eq? (assoc-ref json "stream") #t))
(thinking (assoc-ref json "thinking")))
(cond
(define ct
(assoc-ref (response-headers rsp)
'content-type))
- ;; The parsed header value is a list whose car is the
- ;; media-type symbol, e.g. (text/event-stream).
+ ;; The parsed header value is a list whose car is the media-type symbol,
+ ;; e.g. (text/event-stream).
(define sse?
(and (pair? ct)
(eq? (car ct)
(put-string cp
(string-append "HTTP/1.1 "
(number->string status) " " reason "\r\n"))
- ;; Content-type arrives parsed (e.g. (text/event-stream));
- ;; write-header knows how to serialize that form.
+ ;; Content-type arrives parsed (e.g. (text/event-stream)); write-header
+ ;; knows how to serialize that form.
(when ct
(write-header 'content-type ct cp))
(put-string cp
(let ((chunked? (equal? version
'(1 . 1))))
(define (emit bv count)
- ;; One client chunk (HTTP/1.1) or raw (HTTP/1.0), flushed
- ;; directly: make-chunked-output-port buffers instead of
- ;; relaying incrementally.
+ ;; One client chunk (HTTP/1.1) or raw (HTTP/1.0), flushed directly:
+ ;; make-chunked-output-port buffers instead of relaying
+ ;; incrementally.
(when chunked?
(put-string cp
(string-append (number->string count 16) "\r\n")))
(emit buf n)
(loop (- left n))))))))
(define (decode-chunked)
- ;; Exact-count reads keep chunk data from bleeding into
- ;; the next chunk header.
+ ;; Exact-count reads keep chunk data from bleeding into the next
+ ;; chunk header.
(let loop
()
(let* ((line (attempt (lambda ()
(attempt (lambda ()
(throw 'bad-chunk-size))))
((zero? size)
- ;; Final chunk: swallow the closing CRLF; any
- ;; trailers are ignored, the connection closes.
+ ;; Final chunk: swallow the closing CRLF; any trailers are
+ ;; ignored, the connection closes.
(attempt (lambda ()
(get-bytevector-n! up buf 0 2)))
'done)
(cond
((response-must-not-include-body? rsp)
'done)
- ;; Response-transfer-encoding holds a list of codings,
- ;; e.g. ((chunked)); match guile's response-body-port.
+ ;; Response-transfer-encoding holds a list of codings, e.g.
+ ;; ((chunked)); match guile's response-body-port.
((member '(chunked)
(response-transfer-encoding rsp))
(decode-chunked))
(lambda (len)
(read-exact! len)))
(else
- ;; No framing at all: relay bytes until the upstream
- ;; closes the connection.
+ ;; No framing at all: relay bytes until the upstream closes the
+ ;; connection.
(let loop
()
(let ((chunk (attempt (lambda ()
(bytevector-length chunk))
(loop))))))))
(define (emit-error-frame reason)
- ;; Leading newline keeps the frame line-aligned; the
- ;; client sees a typed error, not a truncated stream.
+ ;; Leading newline keeps the frame line-aligned; the client sees a
+ ;; typed error, not a truncated stream.
(let* ((msg (case reason
((claude-proxy-timeout)
"upstream idle timeout")
"event=done status=~d bytes=~d ms=~d" status
total
(- (ms-now) t0)) #t)
- ;; The throw argument is the abort
- ;; reason; see ATTEMPT and PREMATURE!.
+ ;; The throw argument is the abort reason; see
+ ;; ATTEMPT and PREMATURE!.
(lambda (key reason)
(req-log id
"event=aborted status=~d bytes=~d ms=~d"
status total
(- (ms-now) t0))
- ;; SSE clients get a typed error event
- ;; and a well-formed body; everything
- ;; else keeps the hard truncation.
+ ;; SSE clients get a typed error event and a
+ ;; well-formed body; everything else keeps the
+ ;; hard truncation.
(if sse?
(try-error-frame reason) #f)))))
(when (and clean? chunked?)
- ;; Clean end: HTTP/1.1 bodies close with the final zero
- ;; chunk; HTTP/1.0 clients end at the close. Non-SSE
- ;; aborts close without it so the client sees an
- ;; incomplete body.
+ ;; Clean end: HTTP/1.1 bodies close with the final zero chunk;
+ ;; HTTP/1.0 clients end at the close. Non-SSE aborts close
+ ;; without it so the client sees an incomplete body.
(false-if-exception (put-string cp "0\r\n\r\n")))
(when clean?
(force-output cp))
hdrs
payload)
;; UP is read raw: RELAY decodes the framing itself, since
- ;; http-request's body port would swallow whole small bodies
- ;; before yielding a single byte.
+ ;; http-request's body port would swallow whole small bodies before
+ ;; yielding a single byte.
(let* ((up (open-upstream url))
(request (lambda ()
(http-request url
"{\"error\":\"method not allowed\"}"))
((let ((cl (assoc-ref (request-headers request)
'content-length)))
- ;; read-headers decodes content-length to an
- ;; integer; clients that omit it leave no header.
+ ;; read-headers decodes content-length to an integer; clients
+ ;; that omit it leave no header.
(and cl
(> (if (number? cl) cl
(or (string->number cl) 0)) max-body)))
(sigaction SIGPIPE SIG_IGN)
(let ((listener (socket PF_INET SOCK_STREAM 0))
(start-ppid (getppid)))
- ;; One handler for TERM and INT: log, close the listener,
- ;; die cleanly. PRIMITIVE-EXIT, not EXIT: a handler can run
- ;; on any thread, and EXIT only unwinds its own thread (it
- ;; is a THROW to 'quit).
+ ;; One handler for TERM and INT: log, close the listener, die cleanly.
+ ;; PRIMITIVE-EXIT, not EXIT: a handler can run on any thread, and EXIT
+ ;; only unwinds its own thread (it is a THROW to 'quit).
(for-each (lambda (sig)
(sigaction sig
(lambda (sig)
(make-socket-address AF_INET INADDR_LOOPBACK port))
(listen listener 64))
(lambda args
- ;; One line, no backtrace; shepherd respawns and
- ;; retries until the port is free again.
+ ;; One line, no backtrace; shepherd respawns and retries
+ ;; until the port is free again.
(log "bind failed port=~d: ~a (errno ~d); exiting" port
(strerror (system-error-errno args))
(system-error-errno args))
(log "startup listen=~d ppid=~d upstream=~a timeout=~d" port
start-ppid
(uri->string upstream) idle-timeout)
- ;; Orphan watchdog: when the launching shepherd dies without
- ;; stopping us (guix home reconfigure kills the daemon), we
- ;; are reparented; free the port so the next daemon's
- ;; respawn can bind. Dormant when the parent is PID 1.
+ ;; Orphan watchdog: when the launching shepherd dies without stopping
+ ;; us (guix home reconfigure kills the daemon), we are reparented;
+ ;; free the port so the next daemon's respawn can bind. Dormant when
+ ;; the parent is PID 1.
(when (> start-ppid 1)
(call-with-new-thread (lambda ()
(let loop
(primitive-exit 0)))))))
(let loop
()
- ;; SELECT, not ACCEPT: a blocked select runs pending
- ;; signal asyncs on EINTR, so the TERM/INT handlers
- ;; fire even while the server idles in the kernel
- ;; wait (a blocked accept swallows the interrupt).
+ ;; SELECT, not ACCEPT: a blocked select runs pending signal asyncs
+ ;; on EINTR, so the TERM/INT handlers fire even while the server
+ ;; idles in the kernel wait (a blocked accept swallows the
+ ;; interrupt).
(when (pair? (car (select (list listener)
'()
'() 60.0)))
(let ((client (accept listener)))
- ;; One thread per connection; handle-connection takes
- ;; care of its own errors and cleanup.
+ ;; One thread per connection; handle-connection takes care of
+ ;; its own errors and cleanup.
(call-with-new-thread (lambda ()
(handle-connection (car client)
(cdr client))))))
(define claude-proxy-service
(shepherd-service (provision '(claude-proxy))
(start claude-proxy-start)
- ;; Explicit TERM with a short SIGKILL escalation:
- ;; the proxy's signal handler exits promptly, and
- ;; the grace period covers any handler latency.
+ ;; Explicit TERM with a short SIGKILL escalation: the
+ ;; proxy's signal handler exits promptly, and the grace
+ ;; period covers any handler latency.
(stop #~(make-kill-destructor SIGTERM
#:grace-period 3))
- ;; Respawn with a 5-second pace: a guix home
- ;; reconfigure overlaps two shepherd daemons for
- ;; tens of seconds while the old proxy still holds
- ;; the port, and slow retries keep the default
- ;; 5-in-7s respawn limit from disabling the
- ;; service before the port frees. (respawn-limit
- ;; cannot express that here: guix emits the value
- ;; unquoted into shepherd.conf, so a pair is a
- ;; syntax error and an integer crashes shepherd's
- ;; respawn bookkeeping.)
+ ;; Respawn with a 5-second pace: a guix home reconfigure
+ ;; overlaps two shepherd daemons for tens of seconds while
+ ;; the old proxy still holds the port, and slow retries keep
+ ;; the default 5-in-7s respawn limit from disabling the
+ ;; service before the port frees. (respawn-limit cannot
+ ;; express that here: guix emits the value unquoted into
+ ;; shepherd.conf, so a pair is a syntax error and an integer
+ ;; crashes shepherd's respawn bookkeeping.)
(respawn? #t)
(respawn-delay 5)
(auto-start? #t)
projects / guix.git / commitdiff