(zilch lang ninja): support swapping out the build phase of nixpkgs-style drv

Change-Id: I6a6a69649c5c37c67dbe05a0795356b78caff528
This commit is contained in:
puck 2025-05-11 22:21:07 +00:00
parent c6504571e8
commit 23ce8304f5
5 changed files with 203 additions and 11 deletions

View file

@ -7,8 +7,9 @@
chickenPackages.chicken
r7rs
json
srfi-152
srfi-113
srfi-132
srfi-152
srfi-207
(callPackage ../../core {})
(callPackage ../../planner {})

View file

@ -364,7 +364,7 @@
(define edge-ref
(lambda (path)
(define edge (mapping-ref/default edges path #f))
(define edge (mapping-ref edges path (lambda () (error "Target doesn't exist" path))))
(cons (if (promise? (car edge)) (force (car edge)) (car edge)) (force (cdr edge)))))
(define defaults (build-file-default-targets file))
(values edge-ref defaults))))

View file

@ -1,12 +1,13 @@
(define-library (zilch lang ninja config)
(import
(scheme base) (scheme eval)
(zilch nixpkgs) (zilch vfs))
(zilch magic) (zilch nixpkgs) (zilch vfs)
(prefix (only scheme eval) scheme-))
(export
ninja-build-config?
ninja-build-config-environment ninja-build-config-root-dir
ninja-build-config-patches ninja-build-config-targets
ninja-build-config-environment ninja-build-config-environment-drv
ninja-build-config-root-dir ninja-build-config-patches ninja-build-config-targets
set-ninja-build-config-root-dir! set-ninja-build-config-environment!
@ -14,9 +15,10 @@
(begin
(define-record-type <ninja-build-config>
(make-ninja-build-config environment root-dir patches targets)
(make-ninja-build-config environment environment-drv root-dir patches targets)
ninja-build-config?
(environment ninja-build-config-environment set-ninja-build-config-environment!)
(environment-drv ninja-build-config-environment-drv set-ninja-build-config-environment-drv!)
(root-dir ninja-build-config-root-dir set-ninja-build-config-root-dir!)
(patches ninja-build-config-patches set-ninja-build-config-patches!)
(targets ninja-build-config-targets set-ninja-build-config-targets!))
@ -28,7 +30,11 @@
(else
(case (car data)
((#:env #:environment)
(set-ninja-build-config-environment! conf (if (string? (list-ref data 1)) (environment-for-derivation (cdar (nixpkgs-eval (list-ref data 1)))) (list-ref data 1)))
(if (string? (list-ref data 1))
(let ((drv (cdar (nixpkgs-eval (list-ref data 1)))))
(set-ninja-build-config-environment! conf (environment-for-derivation drv))
(set-ninja-build-config-environment-drv! conf (store-path-drv drv)))
(set-ninja-build-config-environment! conf (list-ref data 1)))
(parse-config-inner conf (cddr data)))
((#:root)
(set-ninja-build-config-root-dir! conf (if (string? (list-ref data 1)) (vfs-from-directory (list-ref data 1)) (list-ref data 1)))
@ -41,7 +47,7 @@
((string? patch-base)
(lambda (target) patch-base))
((list? patch-base)
(eval patch-base (environment '(scheme base) '(zilch lang ninja))))
(scheme-eval patch-base))
(else patch-base))))
(set-ninja-build-config-patches! conf (cons processed-patch (ninja-build-config-patches conf))))
(parse-config-inner conf (cddr data)))
@ -58,4 +64,4 @@
(define (parse-ninja-config config)
(unless (list? config)
(error "expected Zilch Ninja config to be a list"))
(parse-config-inner (make-ninja-build-config #f #f '() #f) config))))
(parse-config-inner (make-ninja-build-config #f #f #f '() #f) config))))

182
lang/ninja/src/nixpkgs.sld Normal file
View file

@ -0,0 +1,182 @@
(define-library (zilch lang ninja nixpkgs)
(import
(scheme base) (chicken format) (scheme lazy)
(zilch lang ninja) (zilch lang ninja build)
(zilch lang ninja config)
(zilch magic) (zilch nixpkgs) (zilch vfs)
(zilch nix drv)
(zilch zexpr)
(srfi 132) (srfi 152))
(export
setup-ninja-environment
build-nixpkgs-drv-reproducibly)
(begin
(define coreutils (cdr (assoc "out" (nixpkgs "coreutils"))))
; Shellcode to run instead of the default stdenv genericBuild();
; This takes the source and configuration of our derivation and prepares
; a proper environment to build inside.
(define configure-builder
(string-append
"export DETERMINISTIC_BUILD=1\n"
"export PYTHONHASHSEED=0\n"
"zilchPreConfigure() {\n"
" cd $NIX_BUILD_TOP; mkdir bdir; mv $sourceRoot bdir/src; sourceRoot=bdir/src; cd $sourceRoot\n"
"}\n"
"mesonBuildDir=$NIX_BUILD_TOP/bdir/build\n"
"phases=\"${prePhases[*]:-} unpackPhase patchPhase ${preConfigurePhases[*]:-} zilchPreConfigure configurePhase ${preBuildPhases[*]:-}\"\n"
"for curPhase in ${phases[*]}; do runPhase \"$curPhase\"; done\n"
"find . '(' -name cmake_trace.txt -o -name meson-log.txt -o -name CMakeConfigureLog.yaml ')' -delete\n"
"find . -name '*.bin' -exec strip -S '{}' ';' || true\n"
"rm -rf meson-info\n"
"cd $NIX_BUILD_TOP; mv bdir $zilch_out"))
; Patch the passed in .drv by appending to the environment
; and changing the list of outputs.
(define (patch-drv drv append-env outputs)
(define ctx (zexp-unwrap (zexp (zexp-unquote append-env))))
(define new-env (list))
(for-each
(lambda (kv)
(define mem (assoc (car kv) (zexp-evaluation-value ctx)))
(cond
(mem (set! new-env (cons mem new-env)))
((member (car kv) '("allowedReferences" "disallowedReferences" "allowedRequisites" "disallowedRequisites")) #f)
(else (set! new-env (cons kv new-env)))))
(derivation-env drv))
(for-each
(lambda (kv)
(unless (assoc (car kv) new-env) (set! new-env (cons kv new-env))))
(zexp-evaluation-value ctx))
(define reprocessed
(make-input-addressed-derivation
(derivation-name drv)
(derivation-system drv)
(list-sort
(lambda (l r) (string<? (derivation-path (car l)) (derivation-path (car r))))
(append (zexp-evaluation-drvs ctx) (derivation-input-drvs drv)))
(list-sort string<?
(append (zexp-evaluation-srcs ctx) (derivation-input-src drv)))
(cons (derivation-builder drv) (derivation-args drv))
new-env
(or outputs (map car (derivation-outputs drv)))))
(map (lambda (l) (cons (car l) (make-store-path reprocessed (car l) #f))) (derivation-outputs reprocessed)))
(define base-placeholder "zilchplaceholderdonotuseanywhere-")
; Create a placeholder store path that is unique
(define (make-fake-store-path name output)
(when (> (string-length output) 32)
(set! output (string-copy output 0 32)))
(string-append "/nix/store/" output (string-copy base-placeholder (string-length output)) name (if (string=? output "out") "" (string-append "-" output))))
(define (setup-ninja-environment conf)
(define initial-drv (ninja-build-config-environment-drv conf))
(when (store-path? initial-drv)
(set! initial-drv (store-path-drv initial-drv)))
(define name (derivation-name initial-drv))
(define placeholders (map (lambda (output-and-info) (cons (car output-and-info) (make-fake-store-path name (car output-and-info)))) (derivation-outputs initial-drv)))
(define existing-env (ninja-build-config-environment conf))
; Override output environment variables with our placeholders.
(set-ninja-build-config-environment! conf #~,(map (lambda (v) (or (assoc (car v) placeholders) v)) #$existing-env))
; Take the initially requested .drv, replace its buildCommand, and set a single ("zilch_out") output path.
(define configured-drv
(cdar
(patch-drv initial-drv
(append
`(("buildCommand" . ,configure-builder))
placeholders)
'("zilch_out"))))
; This VFS contains two directories: `src` (source tree) and `build` (Ninja build files).
(define configured-vfs (vfs-from-store configured-drv))
(set-ninja-build-config-root-dir! conf configured-vfs)
(define ninja-file
(read-ninja-file
(call-with-port (store-path-open (vfs-file-ref configured-vfs "build" "build.ninja"))
(lambda (p) (read-bytevector (* 20 1024 1024) p)))))
; Process the build.ninja file.
(define-values (edge-ref defaults) (process-ninja-file ninja-file conf "build"))
(values initial-drv configured-drv placeholders edge-ref defaults))
(define (build-nixpkgs-drv-reproducibly conf)
(define-values (initial-drv configured-drv placeholders edge-ref defaults) (setup-ninja-environment conf))
; Build all store paths necessary for installing. This assumes Meson.
(define preinstall-state (force (built-edge-out-drv (cdr (edge-ref "all")))))
(define fix-placeholders-command "")
(define copy-in-place-command "")
; Append the necessary commands to fix up the fake store paths post-install but pre-everything-else.
(for-each
(lambda (plc)
(set! fix-placeholders-command
(string-append fix-placeholders-command
"zilchFixPlaceholder \"" (cdr plc) "\" \"$" (car plc) "\"\n"))
(set! copy-in-place-command
(string-append copy-in-place-command
"cp -rf ../out" (cdr plc) " \"$" (car plc) "\" || mkdir \"$" (car plc) "\"\n")))
placeholders)
; Turn the original `src` and `build` into a known store path.
(define realised-store (store-path-devirtualise configured-drv))
; Turn the `.drv` containing all the paths that are built into a known store path.
; This is necessary because these paths may be CA, and we can't guarantee daemon support for that past this point.
(define realised-built (store-path-devirtualise preinstall-state))
; Prepare the post-build builder. This puts everything in its place and runs the post-build phases from the original .drv.
(define postbuild-builder
#~,(string-append
"zilchPlace() {\n"
"cd $NIX_BUILD_TOP; cp -rf --no-preserve=ownership " #$realised-store " bdir\n"
"chmod ugo+rw -R bdir\n"
"cp -rf --no-preserve=ownership " #$realised-built "/* bdir/build\n"
"cd bdir/build\n"
"}\n"
"mesonBuildDir=$NIX_BUILD_TOP/bdir/build\n"
"installPhase=zilchInstall; checkPhase=mesonCheckPhase\n"
"zilchFixPlaceholder() {\n"
" find ../out -type f -exec sed -i -e \"s|$1|$2|g\" \"{}\" \";\" || exit 1\n"
" find \"../out\" -type l | while read link; do\n"
" target=\"$(readlink \"$link\")\"; rewritten=\"$(printf \"%s\" \"$target\" | sed -e \"s|$1|$2|g\")\"\n"
" rm \"$link\" && ln -s \"$rewritten\" \"$link\" || exit 1\n"
" done\n"
"}\n"
"zilchFixup() {\n"
fix-placeholders-command
copy-in-place-command
"}\n"
"zilchInstall() {\n"
" runHook preInstall\n"
" local flagsArray=()\n"
" if [[ -n \"$mesonInstallTags\" ]]; then\n"
" flagsArray+=(\"--tags\" \"$(concatStringsSep \",\" mesonInstallTags)\")\n"
" fi\n"
" concatTo flagsArray mesonInstallFlags mesonInstallFlagsArray\n"
" DESTDIR=$NIX_BUILD_TOP/bdir/out meson install --no-rebuild \"${flagsArray[@]}\"\n"
" zilchFixup\n"
" runHook postInstall\n"
"}\n"
"phases=\"zilchPlace checkPhase ${preInstallPhases[*]:-} installPhase ${preFixupPhases[*]:-} fixupPhase installCheckPhase ${preDistPhases[*]:-} distPhase ${postPhases[*]:-}\"\n"
"for curPhase in ${phases[*]}; do runPhase \"$curPhase\"; done\n"))
; Patch the original .drv to run the postbuild-builder command.
(patch-drv initial-drv
(append
`(("buildCommand" . ,postbuild-builder))
placeholders)
(map car placeholders)))))

View file

@ -1,7 +1,7 @@
((version "0.0.1")
(synopsis "Nix. Noppes. Nada.")
(author "puck")
(dependencies r7rs json zilch zilch.planner srfi-207)
(dependencies r7rs json zilch zilch.planner srfi-132 srfi-152 srfi-207)
(component-options
(csc-options "-X" "r7rs" "-X" "zilch.zexpr" "-R" "r7rs" "-optimize-level" "3"))
(components
@ -11,4 +11,7 @@
(source "src/build.sld")
(component-dependencies zilch.lang.ninja zilch.lang.ninja.config))
(extension zilch.lang.ninja.config
(source "src/config.sld"))))
(source "src/config.sld"))
(extension zilch.lang.ninja.nixpkgs
(source "src/nixpkgs.sld")
(component-dependencies zilch.lang.ninja zilch.lang.ninja.build zilch.lang.ninja.config))))