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.

1 files changed, 62 insertions, 19 deletions

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