From 84d2f06e9facec9a1646afd53adcbf2b95da4da0 Mon Sep 17 00:00:00 2001 Message-ID: <84d2f06e9facec9a1646afd53adcbf2b95da4da0.1702565894.git.efraim@flashner.co.il> In-Reply-To: References: From: Efraim Flashner Date: Thu, 14 Dec 2023 16:49:58 +0200 Subject: [PATCH 1/2] build: cargo-build-system: Produce registry index files. * guix/build/cargo-build-system.scm (rewrite-deps): New procedure. (package): Obtain output from 'cargo manifest' of the current package when the package will be installed. (install): Don't install cargo crates and source. (install-source): New phase. Install cargo crates. Generate cargo registry index files and install them in a known location. (%standard-phases): Add 'install-source phase after 'install. Change-Id: I6ce6c5b33fe3eb7667f86964daef798320724a25 --- guix/build/cargo-build-system.scm | 102 +++++++++++++++++++++++++----- 1 file changed, 87 insertions(+), 15 deletions(-) diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index ffb2ec898e..f1e35a5c65 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -73,6 +73,21 @@ (define (crate-src? path) " | cut -d/ -f2" " | grep -q '^Cargo.toml$'"))))) +(define (rewrite-deps cargo-deps) + (map (lambda (dependency) + `(@ ("name" . ,(assoc-ref dependency "name")) + ("req" . ,(assoc-ref dependency "req")) + ("features" . ,(assoc-ref dependency "features")) + ("optional" . ,(assoc-ref dependency "optional")) + ("default_features" . ,(assoc-ref dependency + "uses_default_features")) + ("target" . ,(assoc-ref dependency "target")) + ("kind" . ,(match (assoc-ref dependency "kind") + (null? "normal") + (kind kind))) + ("registry" . ,(assoc-ref dependency "registry")))) + cargo-deps)) + (define* (unpack-rust-crates #:key inputs vendor-dir #:allow-other-keys) (define (inputs->rust-inputs inputs) "Filter using the label part from INPUTS." @@ -271,7 +286,8 @@ (define* (package #:key install-source? (cargo-package-flags '("--no-metadata" "--no-verify")) #:allow-other-keys) - "Run 'cargo-package' for a given Cargo package." + "Run 'cargo-package' for a given Cargo package. Also generate metadata so we can +create a package index for the crates." (if install-source? (if skip-build? (begin @@ -322,19 +338,24 @@ (define* (package #:key (delete-file-recursively dir))) (find-files "." "\\.crate$"))))) (format #t "Not installing cargo sources, skipping `cargo package`.~%")) - #t) + + (when install-source? + ;; First generate the metadata so we can create the index file. + ;; https://doc.rust-lang.org/cargo/commands/cargo-metadata.html#json-format + (with-output-to-file "cargo-metadata.json" + (lambda _ + (invoke "cargo" "metadata" + "--manifest-path" "Cargo.toml" + "--format-version" "1" + "--no-deps"))))) (define* (install #:key - inputs outputs skip-build? - install-source? features #:allow-other-keys) "Install a given Cargo package." - (let* ((out (assoc-ref outputs "out")) - (registry (string-append out "/share/cargo/registry")) - (sources (string-append out "/share/cargo/src"))) + (let ((out (assoc-ref outputs "out"))) (mkdir-p out) ;; Make cargo reuse all the artifacts we just built instead @@ -346,21 +367,71 @@ (define* (install #:key (or skip-build? (not (has-executable-target?)) (invoke "cargo" "install" "--no-track" "--path" "." "--root" out - "--features" (string-join features))) + "--features" (string-join features))))) + +(define* (install-sources #:key + name + outputs + install-source? + #:allow-other-keys) + "Install a given Cargo package." + (let* ((out (assoc-ref outputs "out")) + (registry (string-append out "/share/cargo/registry/")) + (name+ver (if (string-prefix? "rust-" name) + (string-drop name 5) + name)) + ;; Strip the version if it exists. + (pkgname (if (char-set-every + (lambda (item) + (char-set-contains? + (list->char-set (list #\- #\.) char-set:digit) item)) + (string->char-set + (string-drop name+ver (string-index-right name+ver #\-)))) + (string-take name+ver (string-index-right name+ver #\-)) + name+ver))) (when install-source? ;; Install crate tarballs and unpacked sources for later use. - ;; TODO: Is there a better format/directory for these files? - (mkdir-p sources) (for-each (lambda (crate) (install-file crate registry)) (find-files "target/package" "\\.crate$")) - (for-each (lambda (crate) - (invoke "tar" "xzf" crate "-C" sources)) - (find-files registry "\\.crate$"))) + (let ((path (match (string-length pkgname) + (1 "1") + (2 "2") + (3 (string-append "3/" (string-take pkgname 1))) + (else (string-append (substring pkgname 0 2) "/" + (substring pkgname 2 4))))) + (cargo-metadata (match (call-with-input-file + "cargo-metadata.json" read-json) + (('@ . alist) alist))) + (sha256sum (read-delimited + " " + (open-pipe* OPEN_READ + "sha256sum" "--" + (first (find-files registry pkgname)))))) - #t)) + ;; Now it's time to generate the actual index file: + ;; https://doc.rust-lang.org/cargo/reference/registry-index.html#json-schema + (call-with-output-file pkgname + (lambda (out) + (write-json + `(@ ("name" . ,(assoc-ref + (first (assoc-ref cargo-metadata "packages")) + "name")) + ("vers" . ,(assoc-ref + (first (assoc-ref cargo-metadata "packages")) + "version")) + ("deps" . ,(rewrite-deps (assoc-ref + (first (assoc-ref cargo-metadata "packages")) + "dependencies"))) + ("cksum" . ,sha256sum) + ("features" . ,(assoc-ref + (first (assoc-ref cargo-metadata "packages")) + "features")) + ("yanked" . #f)) + out))) + (install-file pkgname (string-append registry "/index/" path)))))) (define %standard-phases (modify-phases gnu:%standard-phases @@ -372,7 +443,8 @@ (define %standard-phases (add-after 'build 'package package) (add-after 'unpack 'check-for-pregenerated-files check-for-pregenerated-files) (add-after 'check-for-pregenerated-files 'unpack-rust-crates unpack-rust-crates) - (add-after 'patch-generated-file-shebangs 'patch-cargo-checksums patch-cargo-checksums))) + (add-after 'patch-generated-file-shebangs 'patch-cargo-checksums patch-cargo-checksums) + (add-after 'install 'install-sources install-sources))) (define* (cargo-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- Efraim Flashner רנשלפ םירפא GPG key = A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351 Confidentiality cannot be guaranteed on emails sent or received unencrypted