diff --git a/core/src/file.sld b/core/src/file.sld index 7eafbc0..7212c73 100644 --- a/core/src/file.sld +++ b/core/src/file.sld @@ -1,3 +1,4 @@ +;; Helpers to create store paths that contain files, symlinks, and/or directories. (define-library (zilch file) (import (scheme base) (scheme case-lambda) @@ -17,8 +18,8 @@ (define-record-printer ( file out) (if (z-file-executable file) - (fprintf out "#") - (fprintf out "#"))) + (fprintf out "#" (z-file-contents file)) + (fprintf out "#" (z-file-contents file)))) (define-record-type (make-z-directory contents cache) @@ -43,13 +44,13 @@ (define (env-pair` object with given contents and optional `executable` flag. - ;; The contents may either be a string or a ``. + ;; The contents may either be a string or a `zexp`. (define zfile (case-lambda ((contents) (make-z-file contents #f #f)) ((contents executable) (make-z-file contents executable #f)))) - ;; Create a `` record. The target may be any string, *or* a `` containing one. + ;; Create a `` record. The target may be any string, or a `` of a string. (define (zsymlink target) (make-z-symlink target #f)) ;; Create a `` record. The contents is an alist of file name -> zfile/zsymlink/zdir. @@ -188,7 +189,7 @@ ;; Serialize a file-like (`zfile`, `zsymlink`, `zdir`) to a ``. ;; This function should not depend on the system of the builder. ;; - ;; TODO(puck): due to limitations, whatever you pass in ends up at `/-` instead. + ;; Due to limitations, whatever you pass in ends up at `/-` instead. (define (zfile->store val) (define cached (cond diff --git a/core/src/lib/getopt.sld b/core/src/lib/getopt.sld index 2410248..aa61049 100644 --- a/core/src/lib/getopt.sld +++ b/core/src/lib/getopt.sld @@ -7,7 +7,7 @@ ; (single-char char) (required? bool) (value bool) (predicate func) (define (is-long-option value) (and (> (string-length value) 3) (string=? (string-copy value 0 2) "--"))) (define (is-short-option value) (and (> (string-length value) 1) (char=? (string-ref value 0) #\-) (not (char=? (string-ref value 1) #\-)))) - + (define (find-long-option options val) (cond ((eq? options '()) #f) @@ -20,6 +20,34 @@ ((and (> (length (car options)) 2) (list-ref (car options) 2) (char=? (list-ref (car options) 2) val)) (car options)) (else (find-short-option (cdr options) val)))) + ;; Implements a variant of getopt. + ;; + ;; - `options`: a list of arguments that can be set, in the format + ;; `(long-name takes-argument [short-char])`. + ;; - `vals`: A vector of strings forming the command line arguments. + ;; - `help`: A procedure which is called with an error string when an + ;; unknown option is encountered. + ;; + ;; Returns an alist of long-name to their values (or `#f`), and a list of + ;; non-option arguments. Arguments can be passed multiple times; the + ;; resulting alist will then contain multiple pairs with the same `car`. + ;; + ;; ==== + ;; [,scheme] + ;; ---- + ;; (define-values + ;; (args rest) + ;; (getopt '((foo #t) + ;; (bar #f) + ;; (baz #f #\z)) + ;; #("--foo" "quux" "hi" "--bar" "--bar" "-zz" "--" "--foo") + ;; (lambda (msg) (error msg)))) + ;; ;; args -> ((baz . #f) (baz . #f) + ;; ;; (bar . #f) (bar . #f) + ;; ;; (foo . "quux"))))) + ;; ;; rest -> ("hi" "--foo") + ;; ---- + ;; ==== (define (getopt options vals help) (do ((i 0 (+ i 1)) (outputs '() outputs) (rest '() rest)) ((>= i (vector-length vals)) (values outputs (reverse rest))) @@ -52,5 +80,3 @@ (set! i (+ i 1))) (set! outputs (cons (cons (car option) #f) outputs))))) (else (set! rest (cons val rest)))))))) - - diff --git a/core/src/lib/hash.scm b/core/src/lib/hash.scm index aa6e8a1..9a2c995 100644 --- a/core/src/lib/hash.scm +++ b/core/src/lib/hash.scm @@ -7,12 +7,13 @@ (begin (foreign-declare "#include ") - + (define sodium-sha256 (foreign-lambda void "crypto_hash_sha256" nonnull-u8vector nonnull-u8vector unsigned-integer64)) (define sodium-sha256-init (foreign-lambda void "crypto_hash_sha256_init" (nonnull-scheme-pointer "crypto_hash_sha256_state"))) (define sodium-sha256-update (foreign-lambda void "crypto_hash_sha256_update" (nonnull-scheme-pointer "crypto_hash_sha256_state") nonnull-u8vector unsigned-integer64)) (define sodium-sha256-final (foreign-lambda void "crypto_hash_sha256_final" (nonnull-scheme-pointer "crypto_hash_sha256_state") nonnull-u8vector)) + ;; Calculate the sha256 of a bytevector. (define (sha256 buf) (define out (make-bytevector 32)) (cond @@ -29,9 +30,11 @@ (sodium-sha256-update state bbuf bytes-read)))) (else (error "unknown object type passed to ((zilch lib hash) sha256)"))) out) - + (define hexit "0123456789abcdef") + ;; Returns a string containing the hexadecimal representation of the + ;; bytevector. (define (hex bv) (define out (make-string (* (bytevector-length bv) 2) #\!)) (do ((i 0 (+ i 1))) diff --git a/core/src/magic.sld b/core/src/magic.sld index 5a98e3f..4756fe1 100644 --- a/core/src/magic.sld +++ b/core/src/magic.sld @@ -1,6 +1,11 @@ -;; Defines procedures to interact with the Nix store by way of zexpressions. +;; Defines procedures to interact with the Nix store by way of zexps. ;; This library defines the `` record type, which can be used in zexps. -;; A `` unquotes in `zexp`s as its store path. +;; +;; A `` can be unquoted in a `zexp`, and has its store path as a value. +;; +;; This library also implements the logic necessary to build a `zexp` and its context; +;; and should be used wherever a `zexp` needs to be built, as it handles resolving CA +;; derivations and their post-build/fallback hooks. (define-library (zilch magic) (import (scheme base) (scheme file) (scheme lazy) @@ -198,7 +203,7 @@ (define drv (make-ca-derivation name platform input-drvs input-srcs (zexp-evaluation-value collected-builder) (zexp-evaluation-value collected-env) outputs)) (map (lambda (l) (cons (car l) (make-store-path drv (car l) #f))) (derivation-outputs drv))) - ;; Calls either `store-path-for-ca-drv` or `store-path-for-drv` depending on `*use-ca*`. + ;; Calls either `store-path-for-ca-drv` or `store-path-for-drv` depending on ``++*use-ca*++``'s value. (define (store-path-for-ca-drv* name platform builder env outputs) (if (*use-ca*) (store-path-for-ca-drv name platform builder env outputs) (store-path-for-drv name platform builder env outputs))) @@ -262,6 +267,9 @@ (for-each (lambda (output) (set! has-placeholder (or has-placeholder (derivation-output-placeholder? (cdr (assoc output (derivation-outputs drv))))))) outputs) (or has-placeholder (zexp-ctx-has-placeholder (cdr drv-context)))))) + ;; Represents whether a derivation can be safely stored in the Nix store. + ;; A content-addressed derivation is one that is CA, _or_ is a fixed-output + ;; derivation whose dependencies contains a CA derivation. (define (drv-is-ca drv) (define is-ca #f) (for-each (lambda (out) (when (eq? (derivation-output-hash (cdr out)) 'floating) (set! is-ca #t))) (derivation-outputs drv)) @@ -317,6 +325,7 @@ (define-record-printer ( item out) (fprintf out "#" (derivation-path (pending-item-init-ca-drv item)) (pending-item-awaiting-count item))) + ;; Amount of threads that should be used whilst resolving CA derivations. (define ca-thread-count (make-parameter 4)) ; This function is a bit of a misnomer. @@ -564,6 +573,9 @@ (raise build-error) (error "CA build failed"))) root-pend) + + ;; Takes a content-addressed derivation, and rewrites it to use input-addressed derivations, and builds it. + ;; Returns an alist of output name to store path, or `#f` if the derivation is not CA. (define (drv-resolve-ca drv outputs) (if (drv-is-ca drv) (pending-item-resolved-paths (rewrite-ca-stack drv)) @@ -587,6 +599,7 @@ (error "store-path-devirtualise: expression has dependencies on placeholder context, but isn't a string" (list zexpr val)))) (list val drvs srcs)) + ;; Returns a `zexp` representing `zexpr` after CA derivations have been built. (define (store-path-devirtualise zexpr) (define inner (delay (devirtualise-inner zexpr))) (make-zexp @@ -597,6 +610,7 @@ (lambda (out) (fprintf out "#" zexpr)))) + ;; Evaluates `path` (a `` or zexp), and returns its contents, after ensuring it and all its dependencies are built. (define (store-path-realised path) (define devirt (devirtualise-inner path)) (define to-build (list)) @@ -612,6 +626,8 @@ (daemon-wop-build-paths (*daemon*) (list->vector to-build))) val) + ;; Registers a thunk to be called when the `` `path` is failed to build. Should return a new + ;; `` or `` with the same outputs as this one. (define (store-path-register-fallback path fallback-thunk) (define (wrap-fallback) (define new (fallback-thunk)) @@ -622,7 +638,8 @@ (set-derivation-meta! (store-path-drv path) (cons (cons 'fallback wrap-fallback) (or (derivation-meta (store-path-drv path)) '()))) path) - ; Note: this post-build hook is called with a mutex taken. + ;; Registers a thunk to be called when the `` `path` is successfully built. + ;; Only works for CA derivations. (define (store-path-register-post-build path callback) (set-derivation-meta! (store-path-drv path) (cons (cons 'post-build callback) (or (derivation-meta (store-path-drv path)) '()))) path) diff --git a/core/src/nix/daemon.sld b/core/src/nix/daemon.sld index 9eefd10..1273334 100644 --- a/core/src/nix/daemon.sld +++ b/core/src/nix/daemon.sld @@ -16,22 +16,24 @@ daemon-write-bytevector daemon-read-bytevector daemon-write-string daemon-read-string - *logger* - daemon-wop-handshake daemon-wop-set-options - daemon-wop-add-text-to-store daemon-wop-build-paths - daemon-wop-query-derivation-output-map - daemon-wop-query-path-info - daemon-wop-nar-from-path - daemon-wop-add-to-store-nar - nix-activity? nix-activity-id nix-activity-log-level nix-activity-type nix-activity-string nix-activity-fields nix-activity-parent-id + *logger* + + daemon-wop-handshake daemon-wop-set-options + daemon-wop-add-text-to-store daemon-wop-build-paths + daemon-wop-query-derivation-output-map + daemon-wop-nar-from-path + daemon-wop-add-to-store-nar + valid-path-info? valid-path-info-deriver valid-path-info-nar-hash valid-path-info-references valid-path-info-registration-time valid-path-info-nar-size valid-path-info-ultimate - valid-path-info-sigs valid-path-info-ca) + valid-path-info-sigs valid-path-info-ca + + daemon-wop-query-path-info) (begin @@ -51,6 +53,8 @@ (daemon-version daemon-link-daemon-version set-daemon-link-daemon-version!) (settings daemon-link-settings)) + ;; Creates a new ``, setting the internal settings to default + ;; (verbosity at 3, job count at 32, use-substitutes `#t`) (define (make-daemon-link in-port out-port) (internal-make-daemon-link in-port out-port #f #f (make-daemon-link-settings 3 32 #t))) @@ -62,6 +66,8 @@ (define (daemon-read-u64 link) (port-read-u64 (daemon-link-in-port link))) (define (daemon-read-bytevector link) (port-read-bytevector (daemon-link-in-port link))) (define (daemon-read-string link) (port-read-string (daemon-link-in-port link))) + + ;; Flushes the ````'s output port. (define (daemon-flush link) (flush-output-port (daemon-link-out-port link))) (define build-activity #f) @@ -85,9 +91,9 @@ (when (or (> done-builds 0) (> total-builds 1) (> running-builds 0)) (printf "[~S/~S builds, ~S running]\n" done-builds total-builds running-builds)))))))) - ;; Reads a list of log events until STDERR_LAST is called. - ;; This is the client-side equivalent of startWorking / stopWorking on the - ;; server. + ;; Reads a list of log events until `STDERR_LAST` is seen. + ;; This is the client-side equivalent of `startWorking` / `stopWorking` in the + ;; Nix daemon. (define (daemon-read-log-events link) (define val (daemon-read-u64 link)) (case val @@ -175,7 +181,8 @@ (#x1f . "Nix 2.4pre") (#x1f . "Nix 2.4pre") (#x20 . "Nix 2.4-2.6"))) - ;; Send a Nix worker protocol handshake. + + ;; Sends the Nix worker protocol handshake, then sends the default options. (define (daemon-wop-handshake link) (daemon-write-u64 link #x6e697863) (daemon-flush link) @@ -199,6 +206,11 @@ (daemon-read-log-events link) (daemon-wop-set-options link)) + ;; Sets some of the daemon's settings. + ;; + ;; - `verbosity` is the verbosity (amount of `-v` arguments in Nix) + ;; - `max-build-jobs` is the amount of concurrent build jobs for this connection. + ;; - `use-substitutes` defines whether the Nix daemon should check if the output of a Derivation is available in the binary cache. (define daemon-wop-set-options (case-lambda ((link) @@ -250,8 +262,8 @@ (daemon-read-log-events link) (daemon-read-u64 link))) - ;; Write a simple text file to the store. REFS is expected to be sorted. - ;; Returns the store path at which the file has been created. + ;; Write a simple text file to the store. `refs` is expected to be sorted. + ;; Returns the (string) store path at which the file has been created. (define (daemon-wop-add-text-to-store link suffix s refs) (daemon-write-u64 link 8) (daemon-write-string link suffix) @@ -262,6 +274,7 @@ (daemon-read-log-events link) (daemon-read-string link)) + ;; Contains the information Nix stores about a valid store path. (define-record-type (make-valid-path-info deriver nar-hash references registration-time nar-size ultimate sigs ca) valid-path-info? @@ -296,6 +309,7 @@ references registration-time nar-size (= ultimate 1) sigs (if (string=? ca "") #f ca))) + ;; Requests the information the Nix daemon has about a specified store path. Returns a ``. (define (daemon-wop-query-path-info link store-path) (daemon-write-u64 link 26) (daemon-write-string link store-path) @@ -306,16 +320,25 @@ (daemon-read-valid-path-info link) #f)) - ; You are responsible for reading exactly the right amount of bytes from - ; the daemon after this. My condolences. + ;; Requests the daemon send over the contents of a NAR file. The file is not multiplexed, and of unspecified size. + ;; When you call this, you take responsibility to read exactly `nar-size` (from ``) bytes, or one valid NAR file, + ;; from the `daemon-link-in-port`. (define (daemon-wop-nar-from-path link store-path) (daemon-write-u64 link 38) (daemon-write-string link store-path) (daemon-flush link) (daemon-read-log-events link)) - ; `proc` is a procedure taking one argument, which is used to write data into the daemon. - ; The write-blob procedure passed to `proc` looks like (write-blob bv [start [end]]). + ;; Adds a NAR to the daemon's Nix store. + ;; + ;; - `store-path` is the path this nar file should be stored at, and must correspond to the rest of the information provided. + ;; - `deriver` is the (optional) store path containing the information used to derive this store path (usually a `.drv`). + ;; - `nar-hash` is a string containing the nixbase16 representation of the sha256 hash of the NAR. + ;; - `references` is a (sorted) list of store paths that this nar depends on. + ;; - `nar-size` is the amountt of bytes this nar takes up. + ;; - `ca`, if not `#f` is a Nix-style hash describing the content-addressed hash type and hash value. + ;; - `proc` is a procedure taking one argument (`write-blob`), which is used to write data into the daemon. + ;; `write-blob` takes three arguments: a bytevector, and an optional start and end index into it. (define (daemon-wop-add-to-store-nar link store-path deriver nar-hash references nar-size ca proc) (daemon-write-u64 link 39) (daemon-write-string link store-path) @@ -348,6 +371,7 @@ (daemon-read-log-events link) (thread-join! data-thread)) + ;; Requests an alist of output name to output store path for the derivation at `store-path`. (define (daemon-wop-query-derivation-output-map link store-path) (daemon-write-u64 link 41) (daemon-write-string link store-path) diff --git a/core/src/nix/drv.sld b/core/src/nix/drv.sld index b57f531..6c513a1 100644 --- a/core/src/nix/drv.sld +++ b/core/src/nix/drv.sld @@ -7,20 +7,17 @@ (chicken base) (chicken format)) (export + derivation? + derivation-name derivation-outputs derivation-input-drvs + derivation-input-src derivation-system derivation-builder + derivation-args derivation-env derivation-equal? + derivation-meta set-derivation-meta! + %derivation-compatible derivation-output? derivation-output-path derivation-output-hash derivation-output-algo derivation-output-recursive derivation-output-placeholder? derivation-output-path-length - - write-quoted-string - - derivation? - derivation-name derivation-outputs derivation-input-drvs - derivation-input-src derivation-system derivation-builder - derivation-args derivation-env derivation-equal? - - derivation-meta set-derivation-meta! drv-is-fod derivation-serialize derivation-path-references derivation-path derivation-read read-drv-path @@ -28,7 +25,7 @@ modulo-hash-drv-contents) (begin - ;; If `#t`, outputs environment variables not used by Nix, but required for compatibility with Nix's output. + ;; If `#t`, `make-[..]-derivation` will output environment variables not used by Nix, but required for compatibility with Nix's output. ;; This adds `name`, `builder`, and `system` to the environment; as well as `outputHash`, `outputHashAlgo`, ;; and `outputHashMode` for fixed-output derivations. (define %derivation-compatible (make-parameter #t)) @@ -37,11 +34,10 @@ ;; whether or not it the hash is of the NAR file, if it is a content-addressed output. ;; The path can be read using `(derivation-output-path)`. ;; - ;; - `(path #u8() "" #f)` is an input-addressed derivation output. TODO(puck): empty bytevector? - ;; - `(path #f #f #f)` is an input-addressed derivation output. TODO(puck): empty bytevector? + ;; - `(path #u8() "" #f)` is an input-addressed derivation output. + ;; - `(path #f #f #f)` is an input-addressed derivation output. ;; - `(path hash-value hash-algo rec)` is a content-addressed derivation output. ;; - `(#f 'floating hash-algo rec)` is a floating content-addressed derivation output. - ;; - `(#f 'impure hash-algo rec)` is an impure content-addressed derivation output. (define-record-type (make-derivation-output path hash algo recursive) derivation-output? @@ -57,9 +53,11 @@ (derivation-output-algo drvout) (derivation-output-recursive drvout))) + ;; Returns whether the `derivation-output-path` of this output is a placeholder (floating hash) (define (derivation-output-placeholder? drvout) (member (derivation-output-hash drvout) '(floating))) + ;; Returns the final (post-placeholder substitution) length of a derivation's output. (define (derivation-output-path-length drv output-name) ; /nix/store/a0a3n97c93ckfg3a920aqnycxdznbbmi-module-output (+ (string-length (%store-dir)) 34 (string-length (derivation-name drv)) (if (string=? output-name "out") 0 (+ 1 (string-length output-name))))) @@ -74,9 +72,10 @@ (serialized derivation-metadata-serialized set-derivation-metadata-serialized!) (meta derivation-metadata-meta set-derivation-metadata-meta!)) - + ;; An arbitrary Scheme object stored in the ``. (define (derivation-meta drv) (derivation-metadata-meta (derivation-metadata drv))) + ;; Sets the object stored within the ``. (define (set-derivation-meta! drv meta) (set-derivation-metadata-meta! (derivation-metadata drv) meta)) @@ -88,9 +87,11 @@ (not (not (derivation-metadata-serialized drv))))) ;; An entire derivation. - ;; `outputs` is stored as an alist of output name to `` object. - ;; `input-drvs` is stored as an alist of `` to a (sorted) list of its outputs that are used. - ;; The `outputs`, `input-drvs`, `input-src`, and `env` are expected to be sorted. + ;; + ;; - `outputs` is an alist of output name to `` record. + ;; - `input-drvs` is an alist of `` to a (sorted) list of the outputs of said derivation that are depended on. + ;; + ;; `outputs`, `input-drvs`, `input-src`, and `env` are expected to be sorted. (define-record-type (make-derivation name outputs input-drvs input-src system builder args env metadata) derivation? @@ -182,7 +183,7 @@ (define (env-pair< left right) (string`. Checks whether the argument represent the same derivation, not just referential equality. (define (derivation-equal? left right) (define left-cached-path (derivation-metadata-path (derivation-metadata left))) (define right-cached-path (derivation-metadata-path (derivation-metadata right))) @@ -494,8 +496,9 @@ (write-bracket-list (lambda (l) (write-paren-list write-quoted-string (list (car l) (cdr l)))) (derivation-env drv)) (write-u8 #x29))) - ;; Writes the derivation to the specified port, or current-output-port if none is supplied. - ;; If masked is set, writes the derivation using the passed-in input derivations, rather than the default one. + ;; Writes the derivation to the specified port, or `(current-output-port)` if none is supplied. + ;; If `masked` is set, writes the derivation using it as `input-drvs` value, rather than the one stored in the ``. + ;; This is used for generating the modulo-hashed derivation. (define derivation-serialize (case-lambda ((drv) (derivation-serialize drv (current-output-port))) diff --git a/core/src/nix/hash.sld b/core/src/nix/hash.sld index 19f08f6..73afef8 100644 --- a/core/src/nix/hash.sld +++ b/core/src/nix/hash.sld @@ -13,7 +13,7 @@ ((= i (bytevector-length hash)) output-hash) (bytevector-u8-set! output-hash (floor-remainder i 20) (bitwise-xor (bytevector-u8-ref output-hash (floor-remainder i 20)) (bytevector-u8-ref hash i))))) - ;; Turns bytevector HASH to a Nix-style (reversed base32) format. + ;; Turns bytevector `hash` to a Nix-style (reversed base32, custom alphabet) string. (define (as-base32 hash) (do ((len (+ (floor-quotient (- (* 8 (bytevector-length hash)) 1) 5) 1)) (tail '()) (i 0 (+ i 1))) ((= i len) (list->string tail)) @@ -31,7 +31,7 @@ (when (= i 32) (error "unknown character in nixbase32 string" chr)) i))) - ;; Returns a nix-base32 string decoded into a bytevector. + ;; Returns a bytevector containing `hash` decoded (using reversed base32, custom alphabet) (define (from-base32 hash) (do ((i 0 (+ i 1)) (strlen (string-length hash)) diff --git a/core/src/nix/path.sld b/core/src/nix/path.sld index 0a56ffa..e7578d3 100644 --- a/core/src/nix/path.sld +++ b/core/src/nix/path.sld @@ -1,6 +1,7 @@ ;; A series of helpers that help create store paths. ;; ;; These helpers all use the `%store-dir` parameter as base store directory. +;; Where `hash-value` is used, a bytevector containing the raw hash is expected. (define-library (zilch nix path) (import (scheme base) (srfi 152) @@ -8,7 +9,7 @@ (export %store-dir - impure-placeholder make-upstream-output-placeholder make-placeholder + make-upstream-output-placeholder make-placeholder make-store-path-from-parts make-text-path make-fixed-output-path make-output-path make-fixed-output-with-references) @@ -16,12 +17,15 @@ ;; The path to the store dir, as a parameter. (define %store-dir (make-parameter "/nix/store")) - (define impure-placeholder (sha256 "impure")) - + ;; Calculates a string placeholder for a derivation. + ;; + ;; - `drv-hash-string` is the hash part of the derivation's store path + ;; - `drv-name` is the name of the derivation + ;; - `output-name` is the output to calculuate the placeholder for (define (make-upstream-output-placeholder drv-hash-string drv-name output-name) (string-append "/" (as-base32 (sha256 (string-append "nix-upstream-output:" drv-hash-string ":" drv-name (if (string=? output-name "out") "" (string-append "-" output-name))))))) - ;; Makes a placeholder path, which is substituted with the path of the output. + ;; Makes a placeholder path, which is substituted at build-time to be the corresponding output store path for that derivation. (define (make-placeholder output-name) (string-append "/" (as-base32 (sha256 (string->utf8 (string-append "nix-output:" output-name)))))) @@ -32,15 +36,15 @@ ((eqv? references '()) collected) (else (fold-references (cdr references) (string-append collected ":" (car references)))))) - ;; Creates an arbitrary Nix store path. + ;; Creates an arbitrary Nix store path from its constituent parts. (define (make-store-path-from-parts type hash-algo hash-val name) (let* ((inner (string-append type ":" hash-algo ":" (hex hash-val) ":" (%store-dir) ":" name)) (hashed (as-base32 (hash-compress (sha256 (string->utf8 inner)))))) (string-append (%store-dir) "/" hashed "-" name))) - ;; Creates a store path belonging to a derivation output. HASH-ALGO and - ;; HASH-VAL encode the (masked) modulo hash of the derivation. + ;; Creates a store path belonging to a derivation output. `hash-algo` and + ;; `hash-val` encode the (masked) modulo hash of the derivation. (define (make-output-path hash-algo hash-val output-name name) (make-store-path-from-parts (string-append "output:" output-name) @@ -49,7 +53,7 @@ ;; Creates a store path belonging to a text file. Text files may only ;; depend on other text files, and are used in input-srcs rather than - ;; input-drvs. refs is expected to be sorted. + ;; input-drvs. `refs` is expected to be sorted. (define (make-text-path hash-algo hash-value name refs) (make-store-path-from-parts (fold-references refs "text") hash-algo hash-value name)) @@ -64,6 +68,7 @@ (string-append "fixed:out:" (if recursive "r:" "") hash-algo ":" (hex hash-value) ":"))) name))) + ;; Creates a fixed-output store path, that has references to other store paths. (define (make-fixed-output-with-references hash-value name references self-references) (make-store-path-from-parts (string-join (append (cons "source" references) (if self-references '("self") '())) ":") diff --git a/core/src/nixpkgs.sld b/core/src/nixpkgs.sld index 3b22b88..e4c3089 100644 --- a/core/src/nixpkgs.sld +++ b/core/src/nixpkgs.sld @@ -1,3 +1,4 @@ +;; Procedures that interact with nixpkgs, and other non-Zilch Nix derivations and expressions. (define-library (zilch nixpkgs) (import (scheme base) (scheme lazy) (scheme read) @@ -69,6 +70,8 @@ data))) (define raw-eval-cache '()) + + ;; Evaluates some Nix code in the context of nixpkgs, and returns a `` from the store path that the Nix code returned. (define (nixpkgs-eval path) (define val (assoc path raw-eval-cache)) (if (not (eq? val #f)) @@ -101,12 +104,15 @@ (car response)) (values drvs paths (cadr response))) - ;; Parse an arbitrary Nix expression and return it as a zexpr. + ;; Evaluates an arbitrary Nix expression (that will be serialized to JSON) and returns it as a zexpr. + ;; The zexpr will depend on the same derivations that the Nix expression does. (define (nix-eval code) (define data (delay (nix-eval-inner code))) (make-zexp (lambda () (let-values (((drvs paths out) (force data))) (zexp-context-register-items drvs paths) out)) (lambda (p) (fprintf p "nix`~A`" code)))) + ;; Returns a `zexp` containing an alist, representing the shell environment the derivation `drv` is executed in. + ;; `drv` is expected to be a `` or `` of a Nixpkgs derivation using `stdenv`. (define (environment-for-derivation drv) (when (store-path? drv) (set! drv (store-path-drv drv))) (define processor diff --git a/core/src/semver.sld b/core/src/semver.sld index d6ccfa7..a2fc681 100644 --- a/core/src/semver.sld +++ b/core/src/semver.sld @@ -1,14 +1,18 @@ +;; Procedures to deal with Semantic Versions. (define-library (zilch semver) (import (scheme base) (chicken base) (chicken format) (srfi 152)) (export + make-version version-major version-minor version-patch version-prerelease version-build-metadata version-str parse-version version=? version (make-version major minor patch prerelease build-metadata) version? @@ -17,7 +21,8 @@ (patch version-patch) (prerelease version-prerelease) (build-metadata version-build-metadata)) - + + ;; Returns a string representation of a ``. (define (version-str vers) (define out (string-append (number->string (version-major vers)) @@ -34,6 +39,7 @@ (define-record-printer ( version out) (fprintf out "#" (version-str version))) + ;; Parses a string into a ``. (define (parse-version version-string) (define version-string-length (string-length version-string)) (define separators '(#\. #\+ #\-)) @@ -81,6 +87,7 @@ (make-version (string->number (list-ref version-parts 0)) (string->number (list-ref version-parts 1)) (string->number (list-ref version-parts 2)) prerelease-parts build-parts)) + ;; Returns whether `left` and `right` represent an identical version. This ignores the `build-metadata` part of the versions. (define (version=? left right) (when (not (version? left)) (set! left (parse-version left))) @@ -128,6 +135,8 @@ ((string-lexicographicalutf8 str) 0)) close-this-port)) + ;; Creates a status bar. Ensures redraws are limited where necessary, and will erase itself before printing `stdout`. `stderr` output will be put in the statusbar. + ;; if `print-logs` is `#t`, will output stderr to the display. + ;; + ;; Returns a replacement for `out-port`, a replacement for `err-port`, a procedure to set `print-logs`, and a `(zilch nix daemon)` `++*logger*++`. (define (statusbar-logger out-port err-port print-logs) ; Current status bar text (define status-bar "[0/0 builds, 0 running] ...") diff --git a/core/src/vfs.sld b/core/src/vfs.sld index 8899c1f..ab35750 100644 --- a/core/src/vfs.sld +++ b/core/src/vfs.sld @@ -27,12 +27,13 @@ ;; `contents` is a mapping whose keys are a pair (dir . filename) to file contents (e.g. zfile, or store path). ;; The file contents may be the symbol 'directory to indicate there's a directory. ;; - ;; The root directory is specified by `dir` being an empty string. There are no trailing or leading slashes. + ;; The root directory is specified by `dir` being an empty string. There are no trailing or leading slashes in directory paths. (define-record-type (make-vfs contents) vfs? (contents vfs-contents)) + ;; Returns an alist of all the files in the directory `dir` in `vfs`. (define (vfs-dir-files vfs dir) (mapping-map->list (lambda (k v) (cons (cdr k) v)) @@ -41,11 +42,12 @@ (and (not (eq? val 'directory)) (string=? (car key) dir))) (vfs-contents vfs)))) + ;; Returns the file at `dirname`/`filename`, or `#f` if it does not exist. (define (vfs-file-ref vfs dirname filename) (mapping-ref/default (vfs-contents vfs) (cons dirname filename) #f)) ;; Calls the filter with the dir, filename, and contents, for each file. - ;; If filter returns #f, the file in the vfs will be replaced by /dev/null. + ;; If filter returns `#f`, the file in the vfs will be replaced by /dev/null. (define (vfs-dir-filter vfs filter) (make-vfs (mapping-map/monotone @@ -54,7 +56,7 @@ (make-default-comparator) (vfs-contents vfs)))) - ;; Calls the filter for each directory. If the filter returns #f, the directory's files are replaced with `/dev/null`. + ;; Calls the filter for each directory. If the filter returns `#f`, the directory's files (and all its children directories' files) are replaced with symlinks to `/dev/null`. (define (vfs-dir-filter-all filter vfs) (define to-filter-out (set (make-default-comparator))) (mapping-for-each @@ -93,7 +95,7 @@ (zdir contents)) (read-dir "")) - ;; Creates a new VFS that is a subdirectory of the existing + ;; Creates a new VFS that is rooted at the subdirectory of an existing ;; VFS. (define (vfs-subdir vfs subdir) (define subdirprefix (string-append subdir "/")) @@ -134,6 +136,7 @@ (iter-dir "") (make-vfs out)) + ;; Creates a VFS from a store path. (define (vfs-from-store store-path) (if (vfs? store-path) store-path @@ -153,6 +156,10 @@ (find (string-length strval)) (string-concatenate output-parts)) + ;; Generates a string representation of the vfs. + ;; + ;; Each directory is represented by a string `mkdir foo/bar`, and each file is represented by `cp /source/path destination/path`, suffixed with newlines. + ;; Strings are escaped by backslash-escaping spaces, newlines, and backslashes. (define (vfs-to-string vfs) (define output '()) (mapping-for-each @@ -176,7 +183,7 @@ (zexp ,(make-string (zexp-unquote output)))) - ;; Returns a new VFS, with one file added. + ;; Returns a vfs with one file added. (define (vfs-append-file vfs path contents) (define split (string-contains-right path "/")) (define dirname (if split (string-copy path 0 split) "")) diff --git a/core/src/zexpr.sld b/core/src/zexpr.sld index b2949dc..76330de 100644 --- a/core/src/zexpr.sld +++ b/core/src/zexpr.sld @@ -26,12 +26,13 @@ (begin ;; A zexp (concept inspired from Guix g-expressions) is represented as a - ;; thunk that returns the quoted value, and writes the metadata (e.g. string context) necessary + ;; thunk that returns a value, and writes the metadata (e.g. string context) necessary ;; into `++*zexp-context*++`. ;; - ;; `(make-zexp thunk printer)` + - ;; `thunk` `(zexp-thunk zexp)` is the thunk called when evaluating the zexp. + - ;; `printer` `(zexp-printer zexp)` is a thunk that is called with a port to print a representation of the zexp. + + ;; `(make-zexp thunk printer)` + ;; + ;; - `thunk` is the thunk called when evaluating the zexp. + ;; - `printer` is a procedure that is called with a port, when a representation of the zexp is requested. (define-record-type (make-zexp thunk printer) zexp? @@ -45,10 +46,9 @@ ;; The context used to evaluate a zexp, stored in `++*zexp-context*++` during the evaluation. ;; - ;; Stores a list of sources in `zexp-content-srcs` (settable using `set-zexp-context-srcs!`) - ;; and an alist of derivations with a list of their outputs in `zexp-content-drvs` (settable using `set-zexp-context-drvs!`) + ;; Stores a list of sources in `zexp-content-srcs` and an alist of derivations with a list of their outputs in `zexp-content-drvs`. ;; - ;; Prefer using zexp-context-register-items over directly interacting with this record. + ;; Prefer using `zexp-context-register-items` over directly interacting with this record. (define-record-type (make-zexp-context srcs drvs zexp parent) zexp-context? @@ -80,8 +80,7 @@ (zexp-evaluation-srcs zeval))) ;; Adds any new items from a list of sources and an alist of derivations to the current `++*zexp-context*++`. - ;; drvs is an alist of derivation object to output. name. + - ;; TODO(puck): 'spensive? + ;; drvs is an alist of derivation object to output name. (define (zexp-context-register-items drvs srcs) (define ctx (*zexp-context*)) (define ctx-src (and ctx (zexp-context-srcs ctx))) @@ -130,7 +129,7 @@ (iter-unquote-handler val (cdr handlers)) result)))) - ;; Used in the `zexp` macro to zexp-unquote values. + ;; Unquotes a `zexp`. If used outside zexp evaluation context, loses dependencies. Used in the `zexp` macro to zexp-unquote values. (define (zexp-unquote val) (cond ((pair? val) (cons (zexp-unquote (car val)) (zexp-unquote (cdr val)))) @@ -142,7 +141,7 @@ ((or (boolean? val) (char? val) (null? val) (symbol? val) (bytevector? val) (eof-object? val) (number? val) (string? val)) val) (else (iter-unquote-handler val zexp-unquote-handlers)))) - ;; Unwraps a , returning a containing the proper quoted expressions, and its dependencies. + ;; Unwraps a , returning a containing the contents of the evaluated zexp, along with its dependencies. (define (zexp-unwrap val) (parameterize ((*zexp-context* (make-zexp-context '() '() val (*zexp-context*)))) (let ((nval (zexp-unquote val)))