diff options
| -rw-r--r-- | doc/guix.texi | 17 | ||||
| -rw-r--r-- | guix/packages.scm | 81 | ||||
| -rw-r--r-- | tests/packages.scm | 61 |
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) |