summaryrefslogtreecommitdiff
path: root/guix/build/cargo-build-system.scm
blob: f52444f61c7d09adacb150f20feb34a1c0560e59 (plain)
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
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 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
            generate-checksums))

;; Commentary:
;;
;; Builder-side code of the standard Rust package build procedure.
;;
;; Code:

;; FIXME: Needs to be parsed from url not package name.
(define (package-name->crate-name name)
  "Return the crate name of NAME."
  (match (string-split name #\-)
    (("rust" rest ...)
     (string-join rest "-"))
    (_ #f)))

(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)
  (chmod "." #o755)
  (if (not (file-exists? "vendor"))
    (if (not (file-exists? "Cargo.lock"))
      (begin
        (substitute* "Cargo.toml"
          ((".*32-sys.*") "
")
          ((".*winapi.*") "
")
          ((".*core-foundation.*") "
"))
        ;; 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 "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)
        ;; Configure cargo to actually use this new directory.
        (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"))
                #:allow-other-keys)
  "Build a given Cargo package."
  (zero? (apply system* `("cargo" "build" ,@cargo-build-flags))))

(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))

(define (file-sha256 file-name)
  "Calculate the hexdigest of the sha256 checksum of FILE-NAME and return it."
  (let ((port (open-pipe* OPEN_READ
                          "sha256sum"
                          "--"
                          file-name)))
    (let ((result (read-delimited " " port)))
      (close-pipe port)
      result)))

(define (generate-checksums dir-name src-name)
  "Given DIR-NAME, a store directory, checksum all the files in it one
by one and put the result into the file \".cargo-checksum.json\" in
the same directory.  Also includes the checksum of an extra file
SRC-NAME as if it was part of the directory DIR-NAME with name
\"package\"."
  (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 (touch file-name)
  (call-with-output-file file-name (const #t)))

(define* (install #:key inputs outputs #:allow-other-keys)
  "Install a given Cargo package."
  (let* ((out (assoc-ref outputs "out"))
         (src (assoc-ref inputs "source"))
         (rsrc (string-append (assoc-ref outputs "src")
                              "/share/rust-source")))
    (mkdir-p rsrc)
    ;; Rust doesn't have a stable ABI yet. Because of this
    ;; Cargo doesn't have a search path for binaries yet.
    ;; Until this changes we are working around this by
    ;; distributing crates as source and replacing
    ;; references in Cargo.toml with store paths.
    (copy-recursively "src" (string-append rsrc "/src"))
    (touch (string-append rsrc "/.cargo-ok"))
    (generate-checksums rsrc src)
    (install-file "Cargo.toml" rsrc)
    ;; 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")
        (zero? (system* "cargo" "install" "--root" out))
        (begin
          (mkdir out)
          #t))))

(define %standard-phases
  (modify-phases gnu:%standard-phases
    (delete 'bootstrap)
    (replace 'configure configure)
    (replace 'build build)
    (replace 'check check)
    (replace 'install install)))

(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