07/08: transformations: Add '--with-latest'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 9ab817b2a4601b4a6755983590ed7d93ebdc8d09
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jan 7 10:00:50 2021 +0100

    transformations: Add '--with-latest'.
    
    * guix/upstream.scm (upstream-source-compiler): New procedure.
    (%updaters): Set! it.
    * guix/transformations.scm (transform-package-latest): New procedure.
    (%transformations): Add 'with-latest'.
    (%transformation-options, show-transformation-options-help/detailed):
    Add '--with-latest'.
    * tests/transformations.scm ("options->transformation, with-latest"):
    New test.
    * doc/guix.texi (Package Transformation Options): Document it.
---
 doc/guix.texi             | 31 ++++++++++++++++++++++++++++++
 guix/transformations.scm  | 49 +++++++++++++++++++++++++++++++++++++++++++++--
 guix/upstream.scm         | 28 +++++++++++++++++++++++++--
 tests/transformations.scm | 19 +++++++++++++++++-
 4 files changed, 122 insertions(+), 5 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f02353d..c49bd36 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10381,6 +10381,37 @@ guix build coreutils 
--with-patch=glibc=./glibc-frob.patch
 In this example, glibc itself as well as everything that leads to
 Coreutils in the dependency graph is rebuilt.
 
+@cindex upstream, latest version
+@item --with-latest=@var{package}
+So you like living on the bleeding edge?  This option is for you!  It
+replaces occurrences of @var{package} in the dependency graph with its
+latest upstream version, as reported by @command{guix refresh}
+(@pxref{Invoking guix refresh}).
+
+It does so by determining the latest upstream release of @var{package}
+(if possible), downloading it, and authenticating it @emph{if} it comes
+with an OpenPGP signature.
+
+As an example, the command below builds Guix against the latest version
+of Guile-JSON:
+
+@example
+guix build guix --with-latest=guile-json
+@end example
+
+There are limitations.  First, in cases where the tool cannot or does
+not know how to authenticate source code, you are at risk of running
+malicious code; a warning is emitted in this case.  Second, this option
+simply changes the source used in the existing package definitions,
+which is not always sufficient: there might be additional dependencies
+that need to be added, patches to apply, and more generally the quality
+assurance work that Guix developers normally do will be missing.
+
+You've been warned!  In all the other cases, it's a snappy way to stay
+on top.  We encourage you to submit patches updating the actual package
+definitions once you have successfully tested an upgrade
+(@pxref{Contributing}).
+
 @cindex test suite, skipping
 @item --without-tests=@var{package}
 Build @var{package} without running its tests.  This can be useful in
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 2385d32..4e92603 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès 
<ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +25,9 @@
   #:autoload   (guix download) (download-to-store)
   #:autoload   (guix git-download) (git-reference? git-reference-url)
   #:autoload   (guix git) (git-checkout git-checkout? git-checkout-url)
+  #:autoload   (guix upstream) (package-latest-release*
+                                upstream-source-version
+                                upstream-source-signature-urls)
   #:use-module (guix utils)
   #:use-module (guix memoization)
   #:use-module (guix gexp)
@@ -511,6 +514,42 @@ additional patches."
         (rewrite obj)
         obj)))
 
+(define (transform-package-latest specs)
+  "Return a procedure that rewrites package graphs such that those in SPECS
+are replaced by their latest upstream version."
+  (define (package-with-latest-upstream p)
+    (let ((source (package-latest-release* p)))
+      (cond ((not source)
+             (warning
+              (G_ "could not determine latest upstream release of '~a'~%")
+              (package-name p))
+             p)
+            ((string=? (upstream-source-version source)
+                       (package-version p))
+             p)
+            (else
+             (unless (pair? (upstream-source-signature-urls source))
+               (warning (G_ "cannot authenticate source of '~a', version ~a~%")
+                        (package-name p)
+                        (upstream-source-version source)))
+
+             ;; TODO: Take 'upstream-source-input-changes' into account.
+             (package
+               (inherit p)
+               (version (upstream-source-version source))
+               (source source))))))
+
+  (define rewrite
+    (package-input-rewriting/spec
+     (map (lambda (spec)
+            (cons spec package-with-latest-upstream))
+          specs)))
+
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (define %transformations
   ;; Transformations that can be applied to things to build.  The car is the
   ;; key used in the option alist, and the cdr is the transformation
@@ -525,7 +564,8 @@ additional patches."
     (with-c-toolchain . ,transform-package-toolchain)
     (with-debug-info . ,transform-package-with-debug-info)
     (without-tests . ,transform-package-tests)
-    (with-patch  . ,transform-package-patches)))
+    (with-patch  . ,transform-package-patches)
+    (with-latest . ,transform-package-latest)))
 
 (define (transformation-procedure key)
   "Return the transformation procedure associated with KEY, a symbol such as
@@ -567,6 +607,8 @@ additional patches."
                   (parser 'without-tests))
           (option '("with-patch") #t #f
                   (parser 'with-patch))
+          (option '("with-latest") #t #f
+                  (parser 'with-latest))
 
           (option '("help-transform") #f #f
                   (lambda _
@@ -599,6 +641,9 @@ additional patches."
       --with-patch=PACKAGE=FILE
                          add FILE to the list of patches of PACKAGE"))
   (display (G_ "
+      --with-latest=PACKAGE
+                         use the latest upstream release of PACKAGE"))
+  (display (G_ "
       --with-c-toolchain=PACKAGE=TOOLCHAIN
                          build PACKAGE and its dependents with TOOLCHAIN"))
   (display (G_ "
diff --git a/guix/upstream.scm b/guix/upstream.scm
index a8ed1d8..accd896 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -31,8 +31,8 @@
   #:use-module (guix base32)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module ((guix derivations)
-                #:select (built-derivations derivation->output-path))
+  #:use-module ((guix derivations) #:select (built-derivations 
derivation->output-path))
+  #:autoload   (gcrypt hash) (port-sha256)
   #:use-module (guix monads)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -248,6 +248,9 @@ correspond to the same version."
                                        '()
                                        (importer-modules))))
 
+;; Tests need to mock this variable so mark it as "non-declarative".
+(set! %updaters %updaters)
+
 (define* (lookup-updater package
                          #:optional (updaters (force %updaters)))
   "Return an updater among UPDATERS that matches PACKAGE, or #f if none of
@@ -351,6 +354,27 @@ values: 'interactive' (default), 'always', and 'never'."
                         data url)
                #f)))))))
 
+(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
+                                                system target)
+  "Download SOURCE from its first URL and lower it as a fixed-output
+derivation that would fetch it."
+  (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
+                       (signature
+                        -> (and=> (upstream-source-signature-urls source)
+                                  first))
+                       (tarball ((store-lift download-tarball) url signature)))
+    (unless tarball
+      (raise (formatted-message (G_ "failed to fetch source from '~a'")
+                                url)))
+
+    ;; Instead of returning TARBALL, return a fixed-output derivation that
+    ;; would be able to re-download it.  In practice, since TARBALL is already
+    ;; in the store, no extra download will happen, but having the derivation
+    ;; in store improves provenance tracking.
+    (let ((hash (call-with-input-file tarball port-sha256)))
+      (url-fetch url 'sha256 hash (store-path-package-name tarball)
+                 #:system system))))
+
 (define (find2 pred lst1 lst2)
   "Like 'find', but operate on items from both LST1 and LST2.  Return two
 values: the item from LST1 and the item from LST2 that match PRED."
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 9053deb..7877029 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +30,7 @@
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix git)
+  #:use-module (guix upstream)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages busybox)
@@ -396,6 +397,22 @@
               (map local-file-file
                    (origin-patches (package-source dep)))))))))
 
+(test-equal "options->transformation, with-latest"
+  "42.0"
+  (mock ((guix upstream) %updaters
+         (delay (list (upstream-updater
+                       (name 'dummy)
+                       (pred (const #t))
+                       (description "")
+                       (latest (const (upstream-source
+                                       (package "foo")
+                                       (version "42.0")
+                                       (urls '("http://example.org";)))))))))
+        (let* ((p (dummy-package "foo" (version "1.0")))
+               (t (options->transformation
+                   `((with-latest . "foo")))))
+          (package-version (t p)))))
+
 (test-end)
 
 ;;; Local Variables: