1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build cargo-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
#:use-module (guix build json)
#:use-module (guix build utils)
#:use-module (guix build cargo-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)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases
cargo-build))
;; Commentary:
;;
;; Builder-side code of the standard Rust package build procedure.
;;
;; Code:
(define (manifest-targets)
"Extract all targets from the Cargo.toml manifest"
(let* ((port (open-input-pipe "cargo read-manifest"))
(data (read-json port))
(targets (or (assoc-ref data "targets") '())))
(close-port port)
targets))
(define (has-executable-target?)
"Check if the current cargo project declares any binary targets."
(let* ((bin? (lambda (kind) (string=? kind "bin")))
(get-kinds (lambda (dep) (assoc-ref dep "kind")))
(bin-dep? (lambda (dep) (find bin? (get-kinds dep)))))
(find bin-dep? (manifest-targets))))
(define (crate-src? path)
"Check if PATH refers to a crate source, namely a gzipped tarball with a
Cargo.toml file present at its root."
(and (gzip-file? path)
;; First we print out all file names within the tarball to see if it
;; looks like the source of a crate. However, the tarball will include
;; an extra path component which we would like to ignore (since we're
;; interested in checking if a Cargo.toml exists at the root of the
;; archive, but not nested anywhere else). We do this by cutting up
;; each output line and only looking at the second component. We then
;; check if it matches Cargo.toml exactly and short circuit if it does.
(zero? (apply system* (list "sh" "-c"
(string-append "tar -tf " path
" | cut -d/ -f2"
" | grep -q '^Cargo.toml$'"))))))
(define* (configure #:key inputs
(vendor-dir "guix-vendor")
#:allow-other-keys)
"Vendor Cargo.toml dependencies as guix inputs."
(chmod "." #o755)
;; Prepare one new directory with all the required dependencies.
;; It's necessary to do this (instead of just using /gnu/store as the
;; directory) because we want to hide the libraries in subdirectories
;; share/rust-source/... instead of polluting the user's profile root.
(mkdir-p vendor-dir)
(for-each
(match-lambda
((name . path)
(let* ((basepath (basename path))
(crate-dir (string-append vendor-dir "/" basepath)))
(and (crate-src? path)
;; Gracefully handle duplicate inputs
(not (file-exists? crate-dir))
(mkdir-p crate-dir)
;; Cargo crates are simply gzipped tarballs but with a .crate
;; extension. We expand the source to a directory name we control
;; so that we can generate any cargo checksums.
;; The --strip-components argument is needed to prevent creating
;; an extra directory within `crate-dir`.
(invoke "tar" "xvf" path "-C" crate-dir "--strip-components" "1")))))
inputs)
;; Configure cargo to actually use this new directory.
(setenv "CARGO_HOME" (string-append (getcwd) "/.cargo"))
(mkdir-p ".cargo")
(let ((port (open-file ".cargo/config" "w" #:encoding "utf-8")))
(display "
[source.crates-io]
replace-with = 'vendored-sources'
[source.vendored-sources]
directory = '" port)
(display (string-append (getcwd) "/" vendor-dir) port)
(display "'
" port)
(close-port port))
;; Lift restriction on any lints: a crate author may have decided to opt
;; into stricter lints (e.g. #![deny(warnings)]) during their own builds
;; but we don't want any build failures that could be caused later by
;; upgrading the compiler for example.
(setenv "RUSTFLAGS" "--cap-lints allow")
(setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc"))
#t)
;; The Cargo.lock file tells the build system which crates are required for
;; building and hardcodes their version and checksum. In order to build with
;; the inputs we provide, we need to recreate the file with our inputs.
(define* (update-cargo-lock #:key
(vendor-dir "guix-vendor")
#:allow-other-keys)
"Regenerate the Cargo.lock file with the current build inputs."
(when (file-exists? "Cargo.lock")
(begin
;; Unfortunately we can't generate a Cargo.lock file until the checksums
;; are generated, so we have an extra round of generate-all-checksums here.
(generate-all-checksums vendor-dir)
(delete-file "Cargo.lock")
(invoke "cargo" "generate-lockfile")))
#t)
;; After the 'patch-generated-file-shebangs phase any vendored crates who have
;; their shebangs patched will have a mismatch on their checksum.
(define* (patch-cargo-checksums #:key
(vendor-dir "guix-vendor")
#:allow-other-keys)
"Patch the checksums of the vendored crates after patching their shebangs."
(generate-all-checksums vendor-dir)
#t)
(define* (build #:key
skip-build?
(cargo-build-flags '("--release"))
#:allow-other-keys)
"Build a given Cargo package."
(or skip-build?
(zero? (apply system* `("cargo" "build" ,@cargo-build-flags)))))
(define* (check #:key
tests?
(cargo-test-flags '("--release"))
#:allow-other-keys)
"Run tests for a given Cargo package."
(if tests?
(zero? (apply system* `("cargo" "test" ,@cargo-test-flags)))
#t))
(define (touch file-name)
(call-with-output-file file-name (const #t)))
(define* (install #:key inputs outputs skip-build? #:allow-other-keys)
"Install a given Cargo package."
(let* ((out (assoc-ref outputs "out")))
(mkdir-p out)
;; Make cargo reuse all the artifacts we just built instead
;; of defaulting to making a new temp directory
(setenv "CARGO_TARGET_DIR" "./target")
;; Only install crates which include binary targets,
;; otherwise cargo will raise an error.
(or skip-build?
(not (has-executable-target?))
(zero? (system* "cargo" "install" "--path" "." "--root" out)))))
(define %standard-phases
(modify-phases gnu:%standard-phases
(delete 'bootstrap)
(replace 'configure configure)
(replace 'build build)
(replace 'check check)
(replace 'install install)
(add-after 'configure 'update-cargo-lock update-cargo-lock)
(add-after 'patch-generated-file-shebangs 'patch-cargo-checksums patch-cargo-checksums)))
(define* (cargo-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"Build the given Cargo package, applying all of PHASES in order."
(apply gnu:gnu-build #:inputs inputs #:phases phases args))
;;; cargo-build-system.scm ends here
|
