From mboxrd@z Thu Jan 1 00:00:00 1970 From: Danny Milosavljevic Subject: WIP patch: build-system: cargo: Make lots and lots of rust packages work Date: Tue, 3 Jan 2017 05:01:57 +0100 Message-ID: <20170103050157.223af717@scratchpost.org> References: <20170103024407.6928-1-dannym@scratchpost.org> <20170103025103.8147-1-dannym@scratchpost.org> Mime-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:37648) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cOGIb-0008NQ-Se for guix-devel@gnu.org; Mon, 02 Jan 2017 23:02:11 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cOGIY-0004hl-KB for guix-devel@gnu.org; Mon, 02 Jan 2017 23:02:09 -0500 Received: from dd1012.kasserver.com ([85.13.128.8]:48956) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cOGIY-0004fx-9r for guix-devel@gnu.org; Mon, 02 Jan 2017 23:02:06 -0500 Received: from localhost (77.116.141.219.wireless.dyn.drei.com [77.116.141.219]) by dd1012.kasserver.com (Postfix) with ESMTPSA id 3EB711CA0078 for ; Tue, 3 Jan 2017 05:01:59 +0100 (CET) In-Reply-To: <20170103025103.8147-1-dannym@scratchpost.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org For it to work, you also have to back out the (cons "src" outputs) (in ./guix/build-system/cargo.scm) and the (assoc-ref outputs "src") (in guix/build/cargo-build-system.scm) starting from current master. --- guix/build/cargo-build-system.scm 2017-01-03 04:31:01.691543854 +0100 +++ /home/dannym/src/guix/guix/build/cargo-build-system.scm 2017-01-03 04:55:26.810917585 +0100 @@ -19,6 +19,8 @@ (define-module (guix build cargo-build-system) #:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module (guix build utils) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) #:use-module (ice-9 ftw) #:use-module (ice-9 format) #:use-module (ice-9 match) @@ -43,35 +45,86 @@ (define* (configure #:key inputs #:allow-other-keys) "Replace Cargo.toml [dependencies] section with guix inputs." - ;; Make sure Cargo.toml is writeable when the crate uses git-fetch. - (chmod "Cargo.toml" #o644) - (let ((port (open-file "Cargo.toml" "a" #:encoding "utf-8"))) - (format port "~%[replace]~%") - (for-each - (match-lambda - ((name . path) - (let ((crate (package-name->crate-name name))) - (when (and crate path) - (match (string-split (basename path) #\-) - ((_ ... version) - (format port "\"~a:~a\" = { path = \"~a/share/rust-source\" }~%" - crate version path))))))) - inputs) - (close-port port)) + (system* "chmod" "+w" "Cargo.toml") + (system* "chmod" "+w" ".") + (if (not (file-exists? "vendor")) + (begin + (if (not (file-exists? "Cargo.lock")) + (substitute* "Cargo.toml" + ((".*32-sys.*") " +") + ((".*winapi.*") " +"))) + (mkdir "vendor") + (for-each + (match-lambda + ((name . path) + (let ((crate (package-name->crate-name name))) + (when (and crate path) + (match (string-split (basename path) #\-) + ((_ ... version) + (symlink (string-append path "/share/rust-source") (string-append "vendor/" (basename path))))))))) + inputs) + (mkdir-p ".cargo") + (let ((port (open-file ".cargo/config" "w" #:encoding "utf-8"))) + (display " +[source.crates-io] +registry = 'https://github.com/rust-lang/crates.io-index' +replace-with = 'vendored-sources' + +[source.vendored-sources] +directory = '" port) + (display (getcwd) port) + (display "/vendor" port) + (display "' +" port) + (close-port port)))) + (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc")) + + ;(setenv "CARGO_HOME" "/gnu/store") + ; (setenv "CMAKE_C_COMPILER" cc) #t) -(define* (build #:key (cargo-build-flags '("--release" "--frozen")) - #:allow-other-keys) +(define* (build #:key (cargo-build-flags '("--release")) #:allow-other-keys) "Build a given Cargo package." (if (file-exists? "Cargo.lock") - (zero? (apply system* `("cargo" "build" ,@cargo-build-flags))) - #t)) + (zero? (apply system* `("cargo" "build" ,@cargo-build-flags))) + #t)) (define* (check #:key tests? #:allow-other-keys) "Run tests for a given Cargo package." - (if (and tests? (file-exists? "Cargo.lock")) - (zero? (system* "cargo" "test")) - #t)) + (when tests? + (zero? (system* "cargo" "test")))) + +(define (file-sha256 file-name) + (let ((port (open-pipe* OPEN_READ + "sha256sum" + "--" + file-name))) + (let ((result (read-delimited " " port))) + (close-pipe port) + result))) + +;; Example /gnu/store/hwlr49riz3la33m6in2n898ly045ylld-rust-rand-0.3.15: ; generally not a lot of store items. +(define (generate-checksums dir-name src-name) + (let* ((file-names (find-files dir-name ".")) + (dir-prefix-name (string-append dir-name "/")) + (dir-prefix-name-len (string-length dir-prefix-name)) + (checksums-file-name (string-append dir-name "/.cargo-checksum.json"))) + (call-with-output-file checksums-file-name + (lambda (port) + (display "{\"files\":{" port) + (let ((sep "")) + (for-each (lambda (file-name) + (let ((file-relative-name (string-drop file-name dir-prefix-name-len))) + (display sep port) + (set! sep ",") + (write file-relative-name port) + (display ":" port) + (write (file-sha256 file-name) port))) file-names)) + (display "},\"package\":" port) + (write (file-sha256 src-name) port) + (display "}" port))))) (define* (install #:key inputs outputs #:allow-other-keys) "Install a given Cargo package." @@ -87,15 +140,17 @@ ;; references in Cargo.toml with store paths. (copy-recursively "src" (string-append rsrc "/src")) (install-file "Cargo.toml" rsrc) + (system* "touch" (string-append rsrc "/.cargo-ok")) + (generate-checksums rsrc src) ;; When the package includes executables we install ;; it using cargo install. This fails when the crate ;; doesn't contain an executable. (if (file-exists? "Cargo.lock") (system* "cargo" "install" "--root" out) - (mkdir out)))) + (mkdir out)) + #t)) (define %standard-phases - ;; 'configure' phase is not needed. (modify-phases gnu:%standard-phases (replace 'configure configure) (replace 'build build)