03/03: pack: Add '--save-provenance'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit d40ec4a0d00df08ec4f866467080235f5a9fea87
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 6 23:53:08 2019 +0100

    pack: Add '--save-provenance'.
    
    * guix/scripts/pack.scm (show-help, %options): Add '--save-provenance'.
    (guix-pack)[manifest-from-args]: Honor it.
    * doc/guix.texi (Invoking guix pack): Document it.
---
 doc/guix.texi         | 17 +++++++++++++++++
 guix/scripts/pack.scm | 27 ++++++++++++++++++++++++++-
 2 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1b77881..0f325fb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4777,6 +4777,23 @@ symlink target.
 For instance, @code{-S /opt/gnu/bin=bin} creates a @file{/opt/gnu/bin}
 symlink pointing to the @file{bin} sub-directory of the profile.
 
address@hidden --save-provenance
+Save provenance information for the packages passed on the command line.
+Provenance information includes the URL and commit of the channels in use
+(@pxref{Channels}).
+
+Provenance information is saved in the
address@hidden/gnu/store/@dots{}-profile/manifest} file in the pack, along with 
the
+usual package metadata---the name and version of each package, their
+propagated inputs, and so on.  It is useful information to the recipient of
+the pack, who then knows how the pack was (supposedly) obtained.
+
+This option is not enabled by default because, like timestamps, provenance
+information contributes nothing to the build process.  In other words, there
+is an infinity of channel URLs and commit IDs that can lead to the same pack.
+Recording such ``silent'' metadata in the output thus potentially breaks the
+source-to-binary bitwise reproducibility property.
+
 @item --localstatedir
 @itemx address@hidden
 Include the ``local state directory'', @file{/var/guix}, in the resulting
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 86e15d9..e2ecddf 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -32,6 +32,7 @@
   #:use-module (guix modules)
   #:use-module (guix packages)
   #:use-module (guix profiles)
+  #:use-module (guix describe)
   #:use-module (guix derivations)
   #:use-module (guix search-paths)
   #:use-module (guix build-system gnu)
@@ -678,6 +679,9 @@ please email '~a'~%")
                      (x
                       (leave (G_ "~a: invalid symlink specification~%")
                              arg)))))
+         (option '("save-provenance") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'save-provenance? #t result)))
          (option '("localstatedir") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'localstatedir? #t result)))
@@ -726,6 +730,8 @@ Create a bundle of PACKAGE.\n"))
   (display (G_ "
   -m, --manifest=FILE    create a pack with the manifest from FILE"))
   (display (G_ "
+      --save-provenance  save provenance information"))
+  (display (G_ "
       --localstatedir    include /var/guix in the resulting pack"))
   (display (G_ "
       --profile-name=NAME
@@ -772,13 +778,32 @@ Create a bundle of PACKAGE.\n"))
                                   (list (transform store package) "out")))
                                (filter-map maybe-package-argument opts)))
            (manifest-file (assoc-ref opts 'manifest)))
+      (define properties
+        (if (assoc-ref opts 'save-provenance?)
+            (lambda (package)
+              (match (package-provenance package)
+                (#f
+                 (warning (G_ "could not determine provenance of package ~a~%")
+                          (package-full-name package))
+                 '())
+                (sexp
+                 `((provenance . ,sexp)))))
+            (const '())))
+
       (cond
        ((and manifest-file (not (null? packages)))
         (leave (G_ "both a manifest and a package list were given~%")))
        (manifest-file
         (let ((user-module (make-user-module '((guix profiles) (gnu)))))
           (load* manifest-file user-module)))
-       (else (packages->manifest packages)))))
+       (else
+        (manifest
+         (map (match-lambda
+                ((package output)
+                 (package->manifest-entry package output
+                                          #:properties
+                                          (properties package))))
+              packages))))))
 
   (with-error-handling
     (with-store store