nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2013-11-07 22:41:21 +01:00
parent 18f2887bff
commit f9cc897105
3 changed files with 140 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
doc/guix.texi
View File

@ -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

81
guix/packages.scm
View File

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

61
tests/packages.scm
View File

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