aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-11-07 22:41:21 +0100
committerLudovic Courtès <ludo@gnu.org>2013-11-07 22:57:30 +0100
commitf9cc897105850dbbf5e12df63e800cb28b0f293f (patch)
tree975b6dabbd0d6c213993cf51da66f2afa8b3487b
parent18f2887bffeda697bf5ba227c75e303aad04898a (diff)
downloadguix-f9cc897105850dbbf5e12df63e800cb28b0f293f.tar
guix-f9cc897105850dbbf5e12df63e800cb28b0f293f.tar.gz
packages: Add a 'snippet' field to <origin>.
* guix/packages.scm (<origin>): Add 'snippet', 'modules', and 'imported-modules' fields. (patch-and-repack): Make 'inputs' a keyword parameter. Add 'snippet', 'modules', and 'imported-modules' parameters. Accept SOURCE as a raw file name. Insert SNIPPET in BUILDER. Pass IMPORTED-MODULES to 'build-expression->derivation'. (package-source-derivation): Pass the extra arguments to 'patch-and-repack'. * tests/packages.scm ("package-source-derivation, snippet"): New test. * doc/guix.texi (Defining Packages): Mention the 'patches' and 'snippet' fields. (Invoking guix build): Tell that --source has patches and snippets applied. (Software Freedom): Mention packages that contain non-free code.
-rw-r--r--doc/guix.texi17
-rw-r--r--guix/packages.scm81
-rw-r--r--tests/packages.scm61
3 files changed, 140 insertions, 19 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 43e7935b4c..4fb14063d0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -985,6 +985,11 @@ base32 representation of the hash. You can obtain this information with
@code{guix download} (@pxref{Invoking guix download}) and @code{guix
hash} (@pxref{Invoking guix hash}).
+@cindex patches
+When needed, the @code{origin} form can also have a @code{patches} field
+listing patches to be applied, and a @code{snippet} field giving a
+Scheme expression to modify the source code.
+
@item
@cindex GNU Build System
The @code{build-system} field is set to @var{gnu-build-system}. The
@@ -1479,6 +1484,10 @@ themselves.
For instance, @code{guix build -S gcc} returns something like
@file{/nix/store/@dots{}-gcc-4.7.2.tar.bz2}, which is GCC's source tarball.
+The returned source tarball is the result of applying any patches and
+code snippets specified in the package's @code{origin} (@pxref{Defining
+Packages}).
+
@item --system=@var{system}
@itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
@@ -1878,6 +1887,14 @@ software distribution guidelines}. Among other things, these guidelines
reject non-free firmware, recommendations of non-free software, and
discuss ways to deal with trademarks and patents.
+Some packages contain a small and optional subset that violates the
+above guidelines, for instance because this subset is itself non-free
+code. When that happens, the offending items are removed with
+appropriate patches or code snippets in the package definition's
+@code{origin} form (@pxref{Defining Packages}). That way, @code{guix
+build --source} returns the ``freed'' source rather than the unmodified
+upstream source.
+
@node Package Naming
@subsection Package Naming
diff --git a/guix/packages.scm b/guix/packages.scm
index 44f683f776..d4a295e3ac 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -41,6 +41,9 @@
origin-patch-flags
origin-patch-inputs
origin-patch-guile
+ origin-snippet
+ origin-modules
+ origin-imported-modules
base32
<search-path-specification>
@@ -107,10 +110,15 @@
(sha256 origin-sha256) ; bytevector
(file-name origin-file-name (default #f)) ; optional file name
(patches origin-patches (default '())) ; list of file names
+ (snippet origin-snippet (default #f)) ; sexp or #f
(patch-flags origin-patch-flags ; list of strings
(default '("-p1")))
(patch-inputs origin-patch-inputs ; input list or #f
(default #f))
+ (modules origin-modules ; list of module names
+ (default '()))
+ (imported-modules origin-imported-modules ; list of module names
+ (default '()))
(patch-guile origin-patch-guile ; derivation or #f
(default #f)))
@@ -270,26 +278,38 @@ corresponds to the arguments expected by `set-path-environment-variable'."
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))
-(define* (patch-and-repack store source patches inputs
+(define* (patch-and-repack store source patches
#:key
+ (inputs '())
+ (snippet #f)
(flags '("-p1"))
+ (modules '())
+ (imported-modules '())
(guile-for-build (%guile-for-build))
(system (%current-system)))
- "Unpack SOURCE (a derivation), apply all of PATCHES, and repack the tarball
-using the tools listed in INPUTS."
+ "Unpack SOURCE (a derivation or store path), apply all of PATCHES, and
+repack the tarball using the tools listed in INPUTS. When SNIPPET is true,
+it must be an s-expression that will run from within the directory where
+SOURCE was unpacked, after all of PATCHES have been applied. MODULES and
+IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
+ (define source-file-name
+ ;; SOURCE is usually a derivation, but it could be a store file.
+ (if (derivation? source)
+ (derivation->output-path source)
+ source))
+
(define decompression-type
- (let ((out (derivation->output-path source)))
- (cond ((string-suffix? "gz" out) "gzip")
- ((string-suffix? "bz2" out) "bzip2")
- ((string-suffix? "lz" out) "lzip")
- (else "xz"))))
+ (cond ((string-suffix? "gz" source-file-name) "gzip")
+ ((string-suffix? "bz2" source-file-name) "bzip2")
+ ((string-suffix? "lz" source-file-name) "lzip")
+ (else "xz")))
(define original-file-name
- (let ((out (derivation->output-path source)))
- ;; Remove the store prefix plus the slash, hash, and hyphen.
- (let* ((sans (string-drop out (+ (string-length (%store-prefix)) 1)))
- (dash (string-index sans #\-)))
- (string-drop sans (+ 1 dash)))))
+ ;; Remove the store prefix plus the slash, hash, and hyphen.
+ (let* ((sans (string-drop source-file-name
+ (+ (string-length (%store-prefix)) 1)))
+ (dash (string-index sans #\-)))
+ (string-drop sans (+ 1 dash))))
(define patch-inputs
(map (lambda (number patch)
@@ -329,7 +349,24 @@ using the tools listed in INPUTS."
(format (current-error-port)
"source is under '~a'~%" directory)
(chdir directory)
+
(and (every apply-patch ',(map car patch-inputs))
+
+ ,@(if snippet
+ `((let ((module (make-fresh-user-module)))
+ (module-use-interfaces! module
+ (map resolve-interface
+ ',modules))
+ (module-define! module '%build-inputs
+ %build-inputs)
+ (module-define! module '%outputs %outputs)
+ ((@ (system base compile) compile)
+ ',snippet
+ #:to 'value
+ #:opts %auto-compilation-options
+ #:env module)))
+ '())
+
(begin (chdir "..") #t)
(zero? (system* tar "cvfa" out directory))))))))
@@ -349,24 +386,30 @@ using the tools listed in INPUTS."
`(("source" ,source)
,@inputs
,@patch-inputs)
+ #:modules imported-modules
#:guile-for-build guile-for-build)))
(define* (package-source-derivation store source
#:optional (system (%current-system)))
"Return the derivation path for SOURCE, a package source, for SYSTEM."
(match source
- (($ <origin> uri method sha256 name ())
- ;; No patches.
+ (($ <origin> uri method sha256 name () #f)
+ ;; No patches, no snippet: this is a fixed-output derivation.
(method store uri 'sha256 sha256 name
#:system system))
- (($ <origin> uri method sha256 name (patches ...) (flags ...)
- inputs guile-for-build)
- ;; One or more patches.
+ (($ <origin> uri method sha256 name (patches ...) snippet
+ (flags ...) inputs (modules ...) (imported-modules ...)
+ guile-for-build)
+ ;; Patches and/or a snippet.
(let ((source (method store uri 'sha256 sha256 name
#:system system)))
- (patch-and-repack store source patches inputs
+ (patch-and-repack store source patches
+ #:inputs inputs
+ #:snippet snippet
#:flags flags
#:system system
+ #:modules modules
+ #:imported-modules modules
#:guile-for-build (or guile-for-build
(%guile-for-build)
(default-guile store system)))))
diff --git a/tests/packages.scm b/tests/packages.scm
index e0cf4ee001..7c5dd9f4e1 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -20,6 +20,7 @@
(define-module (test-packages)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (guix hash)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix build-system)
@@ -121,6 +122,66 @@
(package-source package))))
(string=? file source)))
+(test-equal "package-source-derivation, snippet"
+ "OK"
+ (let* ((file (search-bootstrap-binary "guile-2.0.7.tar.xz"
+ (%current-system)))
+ (sha256 (call-with-input-file file port-sha256))
+ (fetch (lambda* (store url hash-algo hash
+ #:optional name #:key system)
+ (pk 'fetch url hash-algo hash name system)
+ (add-to-store store (basename url) #f "sha256" url)))
+ (source (bootstrap-origin
+ (origin
+ (method fetch)
+ (uri file)
+ (sha256 sha256)
+ (patch-inputs
+ `(("tar" ,%bootstrap-coreutils&co)
+ ("xz" ,%bootstrap-coreutils&co)
+ ("patch" ,%bootstrap-coreutils&co)))
+ (patch-guile (package-derivation %store
+ %bootstrap-guile))
+ (modules '((guix build utils)))
+ (imported-modules modules)
+ (snippet '(begin
+ ;; We end up in 'bin', because it's the first
+ ;; directory, alphabetically. Not a very good
+ ;; example but hey.
+ (chmod "." #o777)
+ (symlink "guile" "guile-rocks")
+ (copy-recursively "../share/guile/2.0/scripts"
+ "scripts")
+
+ ;; These variables must exist.
+ (pk %build-inputs %outputs))))))
+ (package (package (inherit (dummy-package "with-snippet"))
+ (source source)
+ (build-system trivial-build-system)
+ (inputs
+ `(("tar" ,(search-bootstrap-binary "tar"
+ (%current-system)))
+ ("xz" ,(search-bootstrap-binary "xz"
+ (%current-system)))))
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder
+ (let ((tar (assoc-ref %build-inputs "tar"))
+ (xz (assoc-ref %build-inputs "xz"))
+ (source (assoc-ref %build-inputs "source")))
+ (and (zero? (system* tar "xvf" source
+ "--use-compress-program" xz))
+ (string=? "guile" (readlink "bin/guile-rocks"))
+ (file-exists? "bin/scripts/compile.scm")
+ (let ((out (assoc-ref %outputs "out")))
+ (call-with-output-file out
+ (lambda (p)
+ (display "OK" p))))))))))
+ (drv (package-derivation %store package))
+ (out (derivation->output-path drv)))
+ (and (build-derivations %store (list (pk 'snippet-drv drv)))
+ (call-with-input-file out get-string-all))))
+
(test-assert "return value"
(let ((drv (package-derivation %store (dummy-package "p"))))
(and (derivation? drv)