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.

197 lines
7.3 KiB

  1. #!/bin/sh
  2. # aside from this initial boilerplate, this is actually -*- scheme -*- code
  3. GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH"
  4. export GUILE_LOAD_COMPILED_PATH
  5. main='(module-ref (resolve-interface '\''(guix-build)) '\'guix-build')'
  6. exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
  7. -c "(apply $main (cdr (command-line)))" "$@"
  8. !#
  9. ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
  10. ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
  11. ;;;
  12. ;;; This file is part of Guix.
  13. ;;;
  14. ;;; Guix is free software; you can redistribute it and/or modify it
  15. ;;; under the terms of the GNU General Public License as published by
  16. ;;; the Free Software Foundation; either version 3 of the License, or (at
  17. ;;; your option) any later version.
  18. ;;;
  19. ;;; Guix is distributed in the hope that it will be useful, but
  20. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  22. ;;; GNU General Public License for more details.
  23. ;;;
  24. ;;; You should have received a copy of the GNU General Public License
  25. ;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
  26. (define-module (guix-build)
  27. #:use-module (guix store)
  28. #:use-module (guix derivations)
  29. #:use-module (guix packages)
  30. #:use-module (ice-9 format)
  31. #:use-module (ice-9 match)
  32. #:use-module (srfi srfi-1)
  33. #:use-module (srfi srfi-26)
  34. #:use-module (srfi srfi-37)
  35. #:autoload (distro) (find-packages-by-name)
  36. #:export (guix-build))
  37. (define _ (cut gettext <> "guix"))
  38. (define N_ (cut ngettext <> <> <> "guix"))
  39. (define %store
  40. (open-connection))
  41. (define (derivations-from-package-expressions exp)
  42. "Eval EXP and return the corresponding derivation path."
  43. (let ((p (eval exp (current-module))))
  44. (if (package? p)
  45. (package-derivation %store p)
  46. (begin
  47. (format (current-error-port)
  48. (_ "expression `~s' does not evaluate to a package")
  49. exp)
  50. (exit 1)))))
  51. ;;;
  52. ;;; Command-line options.
  53. ;;;
  54. (define %default-options
  55. ;; Alist of default option values.
  56. '())
  57. (define-syntax-rule (leave fmt args ...)
  58. "Format FMT and ARGS to the error port and exit."
  59. (begin
  60. (format (current-error-port) fmt args ...)
  61. (exit 1)))
  62. (define (show-version)
  63. (display "guix-build (@PACKAGE_NAME@) @PACKAGE_VERSION@\n"))
  64. (define (show-help)
  65. (display (_ "Usage: guix-build [OPTION]... PACKAGE-OR-DERIVATION...
  66. Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
  67. (display (_ "
  68. -e, --expression=EXPR build the package EXPR evaluates to"))
  69. (display (_ "
  70. -K, --keep-failed keep build tree of failed builds"))
  71. (display (_ "
  72. -n, --dry-run do not build the derivations"))
  73. (display (_ "
  74. -c, --cores=N allow the use of up to N CPU cores for the build"))
  75. (newline)
  76. (display (_ "
  77. -h, --help display this help and exit"))
  78. (display (_ "
  79. -V, --version display version information and exit"))
  80. (newline)
  81. (format #t (_ "
  82. Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
  83. (define %options
  84. ;; Specifications of the command-line options.
  85. (list (option '(#\h "help") #f #f
  86. (lambda args
  87. (show-help)
  88. (exit 0)))
  89. (option '(#\V "version") #f #f
  90. (lambda args
  91. (show-version)
  92. (exit 0)))
  93. (option '(#\e "expression") #t #f
  94. (lambda (opt name arg result)
  95. (alist-cons 'expression
  96. (call-with-input-string arg read)
  97. result)))
  98. (option '(#\K "keep-failed") #f #f
  99. (lambda (opt name arg result)
  100. (alist-cons 'keep-failed? #t result)))
  101. (option '(#\c "cores") #t #f
  102. (lambda (opt name arg result)
  103. (let ((c (false-if-exception (string->number arg))))
  104. (if c
  105. (alist-cons 'cores c result)
  106. (leave (_ "~a: not a number~%") arg)))))
  107. (option '(#\n "dry-run") #f #F
  108. (lambda (opt name arg result)
  109. (alist-cons 'dry-run? #t result)))))
  110. ;;;
  111. ;;; Entry point.
  112. ;;;
  113. (define (guix-build . args)
  114. (define (parse-options)
  115. ;; Return the alist of option values.
  116. (args-fold args %options
  117. (lambda (opt name arg result)
  118. (leave (_ "~A: unrecognized option~%") opt))
  119. (lambda (arg result)
  120. (alist-cons 'argument arg result))
  121. %default-options))
  122. (setlocale LC_ALL "")
  123. (textdomain "guix")
  124. (setvbuf (current-output-port) _IOLBF)
  125. (setvbuf (current-error-port) _IOLBF)
  126. (let* ((opts (parse-options))
  127. (drv (filter-map (match-lambda
  128. (('expression . exp)
  129. (derivations-from-package-expressions exp))
  130. (('argument . (? derivation-path? drv))
  131. drv)
  132. (('argument . (? string? x))
  133. (match (find-packages-by-name x)
  134. ((p _ ...)
  135. (package-derivation %store p))
  136. (_
  137. (leave (_ "~A: unknown package~%") x))))
  138. (_ #f))
  139. opts))
  140. (req (append-map (lambda (drv-path)
  141. (let ((d (call-with-input-file drv-path
  142. read-derivation)))
  143. (derivation-prerequisites-to-build %store d)))
  144. drv))
  145. (req* (delete-duplicates
  146. (append (remove (compose (cut valid-path? %store <>)
  147. derivation-path->output-path)
  148. drv)
  149. (map derivation-input-path req)))))
  150. (if (assoc-ref opts 'dry-run?)
  151. (format (current-error-port)
  152. (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
  153. "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
  154. (length req*))
  155. (null? req*) req*)
  156. (format (current-error-port)
  157. (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
  158. "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
  159. (length req*))
  160. (null? req*) req*))
  161. ;; TODO: Add more options.
  162. (set-build-options %store
  163. #:keep-failed? (assoc-ref opts 'keep-failed?)
  164. #:build-cores (or (assoc-ref opts 'cores) 1))
  165. (or (assoc-ref opts 'dry-run?)
  166. (and (build-derivations %store drv)
  167. (for-each (lambda (d)
  168. (let ((drv (call-with-input-file d
  169. read-derivation)))
  170. (format #t "~{~a~%~}"
  171. (map (match-lambda
  172. ((out-name . out)
  173. (derivation-path->output-path
  174. d out-name)))
  175. (derivation-outputs drv)))))
  176. drv)))))