From d40ec4a0d00df08ec4f866467080235f5a9fea87 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 6 Mar 2019 23:53:08 +0100
Subject: [PATCH] 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 1b77881eb6..0f325fb542 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.
 
+@item --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
+@file{/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 --profile-name=@var{name}
 Include the ``local state directory'', @file{/var/guix}, in the resulting
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 86e15d9bab..e2ecddfbfc 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -32,6 +32,7 @@ (define-module (guix scripts pack)
   #: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 @@ (define %options
                      (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)))
@@ -725,6 +729,8 @@ (define (show-help)
   -S, --symlink=SPEC     create symlinks to the profile according to SPEC"))
   (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_ "
@@ -772,13 +778,32 @@ (define (manifest-from-args store opts)
                                   (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