Mirror of GNU Guix
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

321 lines
14 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
  4. ;;;
  5. ;;; This file is part of GNU Guix.
  6. ;;;
  7. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; GNU Guix is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  19. (define-module (guix scripts build)
  20. #:use-module (guix ui)
  21. #:use-module (guix store)
  22. #:use-module (guix derivations)
  23. #:use-module (guix packages)
  24. #:use-module (guix utils)
  25. #:use-module (guix monads)
  26. #:use-module (ice-9 format)
  27. #:use-module (ice-9 match)
  28. #:use-module (ice-9 vlist)
  29. #:use-module (srfi srfi-1)
  30. #:use-module (srfi srfi-11)
  31. #:use-module (srfi srfi-26)
  32. #:use-module (srfi srfi-34)
  33. #:use-module (srfi srfi-37)
  34. #:autoload (gnu packages) (find-best-packages-by-name)
  35. #:export (guix-build))
  36. (define %store
  37. (make-parameter #f))
  38. (define (derivation-from-expression str package-derivation
  39. system source?)
  40. "Read/eval STR and return the corresponding derivation path for SYSTEM.
  41. When SOURCE? is true and STR evaluates to a package, return the derivation of
  42. the package source; otherwise, use PACKAGE-DERIVATION to compute the
  43. derivation of a package."
  44. (match (read/eval str)
  45. ((? package? p)
  46. (if source?
  47. (let ((source (package-source p)))
  48. (if source
  49. (package-source-derivation (%store) source)
  50. (leave (_ "package `~a' has no source~%")
  51. (package-name p))))
  52. (package-derivation (%store) p system)))
  53. ((? procedure? proc)
  54. (run-with-store (%store) (proc) #:system system))))
  55. (define (specification->package spec)
  56. "Return a package matching SPEC. SPEC may be a package name, or a package
  57. name followed by a hyphen and a version number. If the version number is not
  58. present, return the preferred newest version."
  59. (let-values (((name version)
  60. (package-name->name+version spec)))
  61. (match (find-best-packages-by-name name version)
  62. ((p) ; one match
  63. p)
  64. ((p x ...) ; several matches
  65. (warning (_ "ambiguous package specification `~a'~%") spec)
  66. (warning (_ "choosing ~a from ~a~%")
  67. (package-full-name p)
  68. (location->string (package-location p)))
  69. p)
  70. (_ ; no matches
  71. (if version
  72. (leave (_ "~A: package not found for version ~a~%")
  73. name version)
  74. (leave (_ "~A: unknown package~%") name))))))
  75. ;;;
  76. ;;; Command-line options.
  77. ;;;
  78. (define %default-options
  79. ;; Alist of default option values.
  80. `((system . ,(%current-system))
  81. (substitutes? . #t)
  82. (max-silent-time . 3600)
  83. (verbosity . 0)))
  84. (define (show-help)
  85. (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
  86. Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
  87. (display (_ "
  88. -e, --expression=EXPR build the package or derivation EXPR evaluates to"))
  89. (display (_ "
  90. -S, --source build the packages' source derivations"))
  91. (display (_ "
  92. -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
  93. (display (_ "
  94. --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
  95. (display (_ "
  96. -d, --derivations return the derivation paths of the given packages"))
  97. (display (_ "
  98. -K, --keep-failed keep build tree of failed builds"))
  99. (display (_ "
  100. -n, --dry-run do not build the derivations"))
  101. (display (_ "
  102. --fallback fall back to building when the substituter fails"))
  103. (display (_ "
  104. --no-substitutes build instead of resorting to pre-built substitutes"))
  105. (display (_ "
  106. --max-silent-time=SECONDS
  107. mark the build as failed after SECONDS of silence"))
  108. (display (_ "
  109. -c, --cores=N allow the use of up to N CPU cores for the build"))
  110. (display (_ "
  111. -r, --root=FILE make FILE a symlink to the result, and register it
  112. as a garbage collector root"))
  113. (display (_ "
  114. --verbosity=LEVEL use the given verbosity LEVEL"))
  115. (display (_ "
  116. --log-file return the log file names for the given derivations"))
  117. (newline)
  118. (display (_ "
  119. -h, --help display this help and exit"))
  120. (display (_ "
  121. -V, --version display version information and exit"))
  122. (newline)
  123. (show-bug-report-information))
  124. (define %options
  125. ;; Specifications of the command-line options.
  126. (list (option '(#\h "help") #f #f
  127. (lambda args
  128. (show-help)
  129. (exit 0)))
  130. (option '(#\V "version") #f #f
  131. (lambda args
  132. (show-version-and-exit "guix build")))
  133. (option '(#\S "source") #f #f
  134. (lambda (opt name arg result)
  135. (alist-cons 'source? #t result)))
  136. (option '(#\s "system") #t #f
  137. (lambda (opt name arg result)
  138. (alist-cons 'system arg
  139. (alist-delete 'system result eq?))))
  140. (option '("target") #t #f
  141. (lambda (opt name arg result)
  142. (alist-cons 'target arg
  143. (alist-delete 'target result eq?))))
  144. (option '(#\d "derivations") #f #f
  145. (lambda (opt name arg result)
  146. (alist-cons 'derivations-only? #t result)))
  147. (option '(#\e "expression") #t #f
  148. (lambda (opt name arg result)
  149. (alist-cons 'expression arg result)))
  150. (option '(#\K "keep-failed") #f #f
  151. (lambda (opt name arg result)
  152. (alist-cons 'keep-failed? #t result)))
  153. (option '(#\c "cores") #t #f
  154. (lambda (opt name arg result)
  155. (let ((c (false-if-exception (string->number arg))))
  156. (if c
  157. (alist-cons 'cores c result)
  158. (leave (_ "~a: not a number~%") arg)))))
  159. (option '(#\n "dry-run") #f #f
  160. (lambda (opt name arg result)
  161. (alist-cons 'dry-run? #t result)))
  162. (option '("fallback") #f #f
  163. (lambda (opt name arg result)
  164. (alist-cons 'fallback? #t
  165. (alist-delete 'fallback? result))))
  166. (option '("no-substitutes") #f #f
  167. (lambda (opt name arg result)
  168. (alist-cons 'substitutes? #f
  169. (alist-delete 'substitutes? result))))
  170. (option '("max-silent-time") #t #f
  171. (lambda (opt name arg result)
  172. (alist-cons 'max-silent-time (string->number* arg)
  173. result)))
  174. (option '(#\r "root") #t #f
  175. (lambda (opt name arg result)
  176. (alist-cons 'gc-root arg result)))
  177. (option '("verbosity") #t #f
  178. (lambda (opt name arg result)
  179. (let ((level (string->number arg)))
  180. (alist-cons 'verbosity level
  181. (alist-delete 'verbosity result)))))
  182. (option '("log-file") #f #f
  183. (lambda (opt name arg result)
  184. (alist-cons 'log-file? #t result)))))
  185. ;;;
  186. ;;; Entry point.
  187. ;;;
  188. (define (guix-build . args)
  189. (define (parse-options)
  190. ;; Return the alist of option values.
  191. (args-fold* args %options
  192. (lambda (opt name arg result)
  193. (leave (_ "~A: unrecognized option~%") name))
  194. (lambda (arg result)
  195. (alist-cons 'argument arg result))
  196. %default-options))
  197. (define (register-root paths root)
  198. ;; Register ROOT as an indirect GC root for all of PATHS.
  199. (let* ((root (string-append (canonicalize-path (dirname root))
  200. "/" root)))
  201. (catch 'system-error
  202. (lambda ()
  203. (match paths
  204. ((path)
  205. (symlink path root)
  206. (add-indirect-root (%store) root))
  207. ((paths ...)
  208. (fold (lambda (path count)
  209. (let ((root (string-append root
  210. "-"
  211. (number->string count))))
  212. (symlink path root)
  213. (add-indirect-root (%store) root))
  214. (+ 1 count))
  215. 0
  216. paths))))
  217. (lambda args
  218. (leave (_ "failed to create GC root `~a': ~a~%")
  219. root (strerror (system-error-errno args)))))))
  220. (with-error-handling
  221. ;; Ask for absolute file names so that .drv file names passed from the
  222. ;; user to 'read-derivation' are absolute when it returns.
  223. (with-fluids ((%file-port-name-canonicalization 'absolute))
  224. (let ((opts (parse-options)))
  225. (define package->derivation
  226. (match (assoc-ref opts 'target)
  227. (#f package-derivation)
  228. (triplet
  229. (cut package-cross-derivation <> <> triplet <>))))
  230. (parameterize ((%store (open-connection)))
  231. (let* ((src? (assoc-ref opts 'source?))
  232. (sys (assoc-ref opts 'system))
  233. (drv (filter-map (match-lambda
  234. (('expression . str)
  235. (derivation-from-expression
  236. str package->derivation sys src?))
  237. (('argument . (? derivation-path? drv))
  238. (call-with-input-file drv read-derivation))
  239. (('argument . (? store-path?))
  240. ;; Nothing to do; maybe for --log-file.
  241. #f)
  242. (('argument . (? string? x))
  243. (let ((p (specification->package x)))
  244. (if src?
  245. (let ((s (package-source p)))
  246. (package-source-derivation
  247. (%store) s))
  248. (package->derivation (%store) p sys))))
  249. (_ #f))
  250. opts))
  251. (roots (filter-map (match-lambda
  252. (('gc-root . root) root)
  253. (_ #f))
  254. opts)))
  255. (unless (assoc-ref opts 'log-file?)
  256. (show-what-to-build (%store) drv
  257. #:use-substitutes? (assoc-ref opts 'substitutes?)
  258. #:dry-run? (assoc-ref opts 'dry-run?)))
  259. ;; TODO: Add more options.
  260. (set-build-options (%store)
  261. #:keep-failed? (assoc-ref opts 'keep-failed?)
  262. #:build-cores (or (assoc-ref opts 'cores) 0)
  263. #:fallback? (assoc-ref opts 'fallback?)
  264. #:use-substitutes? (assoc-ref opts 'substitutes?)
  265. #:max-silent-time (assoc-ref opts 'max-silent-time)
  266. #:verbosity (assoc-ref opts 'verbosity))
  267. (cond ((assoc-ref opts 'log-file?)
  268. (for-each (lambda (file)
  269. (let ((log (log-file (%store) file)))
  270. (if log
  271. (format #t "~a~%" log)
  272. (leave (_ "no build log for '~a'~%")
  273. file))))
  274. (delete-duplicates
  275. (append (map derivation-file-name drv)
  276. (filter-map (match-lambda
  277. (('argument
  278. . (? store-path? file))
  279. file)
  280. (_ #f))
  281. opts)))))
  282. ((assoc-ref opts 'derivations-only?)
  283. (format #t "~{~a~%~}" (map derivation-file-name drv))
  284. (for-each (cut register-root <> <>)
  285. (map (compose list derivation-file-name) drv)
  286. roots))
  287. ((not (assoc-ref opts 'dry-run?))
  288. (and (build-derivations (%store) drv)
  289. (for-each (lambda (d)
  290. (format #t "~{~a~%~}"
  291. (map (match-lambda
  292. ((out-name . out)
  293. (derivation->output-path
  294. d out-name)))
  295. (derivation-outputs d))))
  296. drv)
  297. (for-each (cut register-root <> <>)
  298. (map (lambda (drv)
  299. (map cdr
  300. (derivation->output-paths drv)))
  301. drv)
  302. roots))))))))))