From 2ed428e37d693c2b1263c5ff3dcc2379ba9c804e Mon Sep 17 00:00:00 2001
From: Puck Meerburg <puck@puckipedia.com>
Date: Fri, 4 Oct 2024 15:17:26 +0000
Subject: [PATCH] (zilch nix daemon): make options runtime-configurable

---
 core/src/nix/daemon.sld | 75 ++++++++++++++++++++++++++++-------------
 1 file changed, 52 insertions(+), 23 deletions(-)

diff --git a/core/src/nix/daemon.sld b/core/src/nix/daemon.sld
index 7410a29..2f1b794 100644
--- a/core/src/nix/daemon.sld
+++ b/core/src/nix/daemon.sld
@@ -2,7 +2,7 @@
 ;;
 ;; Currently implements protocol 1.21, from around Nix 2.4.
 (define-library (zilch nix daemon)
-  (import (scheme base) (scheme write) (zilch lib hash) srfi-151
+  (import (scheme base) (scheme write) (scheme case-lambda) (zilch lib hash) srfi-151
           (zilch nix binproto) socket
           (chicken format))
 
@@ -15,17 +15,27 @@
           daemon-write-string daemon-read-string
 
           *logger*
-          daemon-wop-handshake daemon-wop-add-text-to-store
-          daemon-wop-add-to-store-nar daemon-wop-build-paths
-          daemon-wop-query-derivation-output-map)
+          daemon-wop-handshake daemon-wop-set-options
+          daemon-wop-add-text-to-store daemon-wop-add-to-store-nar
+          daemon-wop-build-paths daemon-wop-query-derivation-output-map)
 
   (begin
+   (define-record-type <daemon-link-settings>
+     (make-daemon-link-settings verbosity max-build-jobs use-substitutes)
+     daemon-link-settings?
+     (verbosity daemon-link-settings-verbosity set-daemon-link-settings-verbosity!)
+     (max-build-jobs daemon-link-settings-max-build-jobs set-daemon-link-settings-max-build-jobs!)
+     (use-substitutes daemon-link-settings-use-substitutes set-daemon-link-settings-use-substitutes!))
 
    (define-record-type <daemon-link>
-       (make-daemon-link in-port out-port)
+       (internal-make-daemon-link in-port out-port settings)
        daemon-link?
        (in-port daemon-link-in-port)
-       (out-port daemon-link-out-port))
+       (out-port daemon-link-out-port)
+       (settings daemon-link-settings))
+
+   (define (make-daemon-link in-port out-port)
+     (internal-make-daemon-link in-port out-port (make-daemon-link-settings 3 32 #t)))
 
    ;; Equivalent to port-{read,write}-{u64,bytevector,string} but on the <daemon-link> instead.
    (define (daemon-write-u64 link val) (port-write-u64 val (daemon-link-out-port link)))
@@ -137,25 +147,44 @@
        (daemon-write-u64 link 0)
        (daemon-flush link)
        (daemon-read-log-events link)
+       (daemon-wop-set-options link))
 
-       ; Send wopSetOptions too, to adjust verbosity.
-       (daemon-write-u64 link 19)
-       (daemon-write-u64 link 0) ; keepFailed
-       (daemon-write-u64 link 0) ; keepGoing
-       (daemon-write-u64 link 0) ; tryFallback
-       (daemon-write-u64 link 3) ; verbosity (lvlInfo)
-       (daemon-write-u64 link 30) ; maxBuildJobs
-       (daemon-write-u64 link 0) ; maxSilentTime
-       (daemon-write-u64 link 0) ; obsolete, useBuildHook
-       (daemon-write-u64 link 0) ; verboseBuild (unused?)
-       (daemon-write-u64 link 0) ; obsolete, logType
-       (daemon-write-u64 link 0) ; obsolete, printBuildTrace
-       (daemon-write-u64 link 0) ; buildCores
-       (daemon-write-u64 link 0) ; useSubstitutes
-       (daemon-write-u64 link 0) ; settings overrides
-       (daemon-flush link)
-       (daemon-read-log-events link))
+   (define daemon-wop-set-options
+     (case-lambda
+       ((link)
+        (define settings (daemon-link-settings link))
+        (daemon-wop-set-options link (daemon-link-settings-verbosity settings) (daemon-link-settings-max-build-jobs settings) (daemon-link-settings-use-substitutes settings)))
+       ((link verbosity)
+        (define settings (daemon-link-settings link))
+        (set-daemon-link-settings-verbosity! settings verbosity)
+        (daemon-wop-set-options link verbosity (daemon-link-settings-max-build-jobs settings) (daemon-link-settings-use-substitutes settings)))
+       ((link verbosity max-build-jobs)
+        (define settings (daemon-link-settings link))
+        (set-daemon-link-settings-verbosity! settings verbosity)
+        (set-daemon-link-settings-max-build-jobs! settings max-build-jobs)
+        (daemon-wop-set-options link verbosity max-build-jobs (daemon-link-settings-use-substitutes settings)))
+       ((link verbosity max-build-jobs use-substitutes)
+        (define settings (daemon-link-settings link))
+        (set-daemon-link-settings-verbosity! settings verbosity)
+        (set-daemon-link-settings-max-build-jobs! settings max-build-jobs)
+        (set-daemon-link-settings-use-substitutes! settings use-substitutes)
 
+        (daemon-write-u64 link 19)
+        (daemon-write-u64 link 0) ; keepFailed
+        (daemon-write-u64 link 0) ; keepGoing
+        (daemon-write-u64 link 0) ; tryFallback
+        (daemon-write-u64 link verbosity) ; verbosity (lvlInfo)
+        (daemon-write-u64 link max-build-jobs) ; maxBuildJobs
+        (daemon-write-u64 link 0) ; maxSilentTime
+        (daemon-write-u64 link 0) ; obsolete, useBuildHook
+        (daemon-write-u64 link 0) ; verboseBuild (unused?)
+        (daemon-write-u64 link 0) ; obsolete, logType
+        (daemon-write-u64 link 0) ; obsolete, printBuildTrace
+        (daemon-write-u64 link 0) ; buildCores
+        (daemon-write-u64 link (if use-substitutes 1 0)) ; useSubstitutes
+        (daemon-write-u64 link 0) ; settings overrides
+        (daemon-flush link)
+        (daemon-read-log-events link))))
 
    ;; Request to the daemon that the paths in PATHS have to be built.
    ;; Each path may either be an output path, or `<drv>!<output name>`.