[bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[Ludovic Courtès]

Hello!

This patch series aims to protect against “downgrade attacks”, whereby
a “guix pull” command would in fact deploy an older or an unrelated
revision of Guix, potentially leading you to install vulnerable or
malicious software.

By default ‘guix pull’ would now error out if the target commit of a
channel is not a descendant of the currently-used commit, according to
the commit graph.  There’s an option to bypass that.  ‘guix
time-machine’ behavior is unchanged though: it never complains.

This is generally useful and it’s a requirement for authenticated
checkouts as discussed in <https://issues.guix.gnu.org/22883>,
otherwise one could easily escape the intended authentication scheme
by branching and providing a different ‘.guix-authorizations’ file.

Feedback welcome!

Ludo’.

Ludovic Courtès (5):
  git: Add 'commit-relation'.
  channels: 'latest-channel-instances' doesn't leak internal state.
  git: 'update-cached-checkout' returns the commit relation.
  channels: 'latest-channel-instances' guards against non-forward
    updates.
  pull: Protect against downgrade attacks.

 doc/guix.texi         |  15 ++++
 guix/channels.scm     | 156 ++++++++++++++++++++++++++++++------------
 guix/git.scm          |  37 ++++++++--
 guix/import/opam.scm  |   2 +-
 guix/scripts/pull.scm |  35 +++++++++-
 tests/channels.scm    |  47 +++++++++++--
 tests/git.scm         |  42 +++++++++++-
 7 files changed, 276 insertions(+), 58 deletions(-)

-- 
2.26.2

[bug#41425] [PATCH 1/5] git: Add 'commit-relation'.

[Ludovic Courtès]

* guix/git.scm (commit-relation): New procedure.
* tests/git.scm ("commit-relation"): New test.
---
 guix/git.scm  | 16 ++++++++++++++++
 tests/git.scm | 42 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 57 insertions(+), 1 deletion(-)

diff --git a/guix/git.scm b/guix/git.scm
index 92121156cf..249d622756 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -43,6 +43,7 @@
             url+commit->name
             latest-repository-commit
             commit-difference
+            commit-relation
 
             git-checkout
             git-checkout?
@@ -405,6 +406,21 @@ that of OLD."
                  (cons head result)
                  (set-insert head visited)))))))
 
+(define (commit-relation old new)
+  "Return a symbol denoting the relation between OLD and NEW, two commit
+objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
+'unrelated, or 'self (OLD and NEW are the same commit)."
+  (if (eq? old new)
+      'self
+      (let ((newest (commit-closure new)))
+        (if (set-contains? newest old)
+            'ancestor
+            (let* ((seen   (list->setq (commit-parents new)))
+                   (oldest (commit-closure old seen)))
+              (if (set-contains? oldest new)
+                  'descendant
+                  'unrelated))))))
+
 \f
 ;;;
 ;;; Checkouts.
diff --git a/tests/git.scm b/tests/git.scm
index 052f8a79c4..4a806abcc3 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -122,4 +122,44 @@
              (lset= eq? (commit-difference commit4 commit1 (list commit5))
                     (list commit2 commit3 commit4)))))))
 
+(unless (which (git-command)) (test-skip 1))
+(test-equal "commit-relation"
+  '(self                                          ;master3 master3
+    ancestor                                      ;master1 master3
+    descendant                                    ;master3 master1
+    unrelated                                     ;master2 branch1
+    unrelated                                     ;branch1 master2
+    ancestor                                      ;branch1 merge
+    descendant                                    ;merge branch1
+    ancestor                                      ;master1 merge
+    descendant)                                   ;merge master1
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "first commit")
+        (branch "hack")
+        (checkout "hack")
+        (add "1.txt" "1")
+        (commit "branch commit")
+        (checkout "master")
+        (add "b.txt" "B")
+        (commit "second commit")
+        (add "c.txt" "C")
+        (commit "third commit")
+        (merge "hack" "merge"))
+    (with-repository directory repository
+      (let ((master1 (find-commit repository "first"))
+            (master2 (find-commit repository "second"))
+            (master3 (find-commit repository "third"))
+            (branch1 (find-commit repository "branch"))
+            (merge   (find-commit repository "merge")))
+        (list (commit-relation master3 master3)
+              (commit-relation master1 master3)
+              (commit-relation master3 master1)
+              (commit-relation master2 branch1)
+              (commit-relation branch1 master2)
+              (commit-relation branch1 merge)
+              (commit-relation merge branch1)
+              (commit-relation master1 merge)
+              (commit-relation merge master1))))))
+
 (test-end "git")
-- 
2.26.2

[bug#41425] [PATCH 2/5] channels: 'latest-channel-instances' doesn't leak internal state.

[Ludovic Courtès]

* guix/channels.scm (latest-channel-instances): Remove
'previous-channels' argument.  Introduce 'loop' and use it.
---
 guix/channels.scm | 67 +++++++++++++++++++++++------------------------
 1 file changed, 33 insertions(+), 34 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index f0174de767..e0a7a84f55 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -231,10 +231,9 @@ result is unspecified."
                                    #:select? (negate dot-git?))))
       (channel-instance channel commit checkout))))
 
-(define* (latest-channel-instances store channels #:optional (previous-channels '()))
+(define* (latest-channel-instances store channels)
   "Return a list of channel instances corresponding to the latest checkouts of
-CHANNELS and the channels on which they depend.  PREVIOUS-CHANNELS is a list
-of previously processed channels."
+CHANNELS and the channels on which they depend."
   ;; Only process channels that are unique, or that are more specific than a
   ;; previous channel specification.
   (define (ignore? channel others)
@@ -245,38 +244,38 @@ of previously processed channels."
                        (not (or (channel-commit a)
                                 (channel-commit b))))))))
 
-  ;; Accumulate a list of instances.  A list of processed channels is also
-  ;; accumulated to decide on duplicate channel specifications.
-  (define-values (resulting-channels instances)
-    (fold2 (lambda (channel previous-channels instances)
-             (if (ignore? channel previous-channels)
-                 (values previous-channels instances)
-                 (begin
-                   (format (current-error-port)
-                           (G_ "Updating channel '~a' from Git repository at '~a'...~%")
-                           (channel-name channel)
-                           (channel-url channel))
-                   (let ((instance (latest-channel-instance store channel)))
-                     (let-values (((new-instances new-channels)
-                                   (latest-channel-instances
-                                    store
-                                    (channel-instance-dependencies instance)
-                                    previous-channels)))
-                       (values (append (cons channel new-channels)
-                                       previous-channels)
-                               (append (cons instance new-instances)
-                                       instances)))))))
-           previous-channels
-           '()                                    ;instances
-           channels))
+  (let loop ((channels channels)
+             (previous-channels '()))
+    ;; Accumulate a list of instances.  A list of processed channels is also
+    ;; accumulated to decide on duplicate channel specifications.
+    (define-values (resulting-channels instances)
+      (fold2 (lambda (channel previous-channels instances)
+               (if (ignore? channel previous-channels)
+                   (values previous-channels instances)
+                   (begin
+                     (format (current-error-port)
+                             (G_ "Updating channel '~a' from Git repository at '~a'...~%")
+                             (channel-name channel)
+                             (channel-url channel))
+                     (let ((instance (latest-channel-instance store channel)))
+                       (let-values (((new-instances new-channels)
+                                     (loop (channel-instance-dependencies instance)
+                                           previous-channels)))
+                         (values (append (cons channel new-channels)
+                                         previous-channels)
+                                 (append (cons instance new-instances)
+                                         instances)))))))
+             previous-channels
+             '()                                  ;instances
+             channels))
 
-  (let ((instance-name (compose channel-name channel-instance-channel)))
-    ;; Remove all earlier channel specifications if they are followed by a
-    ;; more specific one.
-    (values (delete-duplicates instances
-                               (lambda (a b)
-                                 (eq? (instance-name a) (instance-name b))))
-            resulting-channels)))
+    (let ((instance-name (compose channel-name channel-instance-channel)))
+      ;; Remove all earlier channel specifications if they are followed by a
+      ;; more specific one.
+      (values (delete-duplicates instances
+                                 (lambda (a b)
+                                   (eq? (instance-name a) (instance-name b))))
+              resulting-channels))))
 
 (define* (checkout->channel-instance checkout
                                      #:key commit
-- 
2.26.2

[bug#41425] [PATCH 3/5] git: 'update-cached-checkout' returns the commit relation.

[Ludovic Courtès]

* guix/git.scm (update-cached-checkout): Add #:starting-commit
parameter.  Call 'commit-relation' when #:starting-commit is true.
Always return the relation or #f as the third vaule.
(latest-repository-commit): Adjust accordingly.
* guix/import/opam.scm (get-opam-repository): Likewise.
* tests/channels.scm ("latest-channel-instances includes channel dependencies")
("latest-channel-instances excludes duplicate channel dependencies"):
Update mock of 'update-cached-checkout' accordingly.
---
 guix/channels.scm    |  2 +-
 guix/git.scm         | 21 ++++++++++++++++-----
 guix/import/opam.scm |  2 +-
 tests/channels.scm   | 12 ++++++------
 4 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index e0a7a84f55..75b767a94c 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -218,7 +218,7 @@ result is unspecified."
     (and (string=? (basename file) ".git")
          (eq? 'directory (stat:type stat))))
 
-  (let-values (((checkout commit)
+  (let-values (((checkout commit relation)
                 (update-cached-checkout (channel-url channel)
                                         #:ref (channel-reference channel))))
     (when (guix-channel? channel)
diff --git a/guix/git.scm b/guix/git.scm
index 249d622756..c197e566db 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -262,14 +262,16 @@ definitely available in REPOSITORY, false otherwise."
                                  #:key
                                  (ref '(branch . "master"))
                                  recursive?
+                                 starting-commit
                                  (log-port (%make-void-port "w"))
                                  (cache-directory
                                   (url-cache-directory
                                    url (%repository-cache-directory)
                                    #:recursive? recursive?)))
-  "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return two
+  "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return three
 values: the cache directory name, and the SHA1 commit (a string) corresponding
-to REF.
+to REF, and the relation of the new commit relative to STARTING-COMMIT (if
+provided) as returned by 'commit-relation'.
 
 REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
 the associated data: [<branch name> | <sha1> | <tag name> | <string>].
@@ -302,7 +304,16 @@ When RECURSIVE? is true, check out submodules as well, if any."
            (remote-fetch (remote-lookup repository "origin"))))
      (when recursive?
        (update-submodules repository #:log-port log-port))
-     (let ((oid (switch-to-ref repository canonical-ref)))
+
+     ;; Note: call 'commit-relation' from here because it's more efficient
+     ;; than letting users re-open the checkout later on.
+     (let* ((oid      (switch-to-ref repository canonical-ref))
+            (new      (commit-lookup repository oid))
+            (old      (and starting-commit
+                           (commit-lookup repository
+                                          (string->oid starting-commit))))
+            (relation (and starting-commit
+                           (commit-relation old new))))
 
        ;; Reclaim file descriptors and memory mappings associated with
        ;; REPOSITORY as soon as possible.
@@ -310,7 +321,7 @@ When RECURSIVE? is true, check out submodules as well, if any."
                               'repository-close!)
          (repository-close! repository))
 
-       (values cache-directory (oid->string oid))))))
+       (values cache-directory (oid->string oid) relation)))))
 
 (define* (latest-repository-commit store url
                                    #:key
@@ -343,7 +354,7 @@ Log progress and checkout info to LOG-PORT."
 
   (format log-port "updating checkout of '~a'...~%" url)
   (let*-values
-      (((checkout commit)
+      (((checkout commit _)
         (update-cached-checkout url
                                 #:recursive? recursive?
                                 #:ref ref
diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index ae7df8a8b5..9cda3da006 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -115,7 +115,7 @@
 (define (get-opam-repository)
   "Update or fetch the latest version of the opam repository and return the
 path to the repository."
-  (receive (location commit)
+  (receive (location commit _)
     (update-cached-checkout "https://github.com/ocaml/opam-repository")
     location))
 
diff --git a/tests/channels.scm b/tests/channels.scm
index 910088ba15..3578b57204 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -136,11 +136,11 @@
                    (url "test")))
          (test-dir (channel-instance-checkout instance--simple)))
     (mock ((guix git) update-cached-checkout
-           (lambda* (url #:key ref)
+           (lambda* (url #:key ref starting-commit)
              (match url
-               ("test" (values test-dir "caf3cabba9e"))
+               ("test" (values test-dir "caf3cabba9e" #f))
                (_      (values (channel-instance-checkout instance--no-deps)
-                               "abcde1234")))))
+                               "abcde1234" #f)))))
           (with-store store
             (let ((instances (latest-channel-instances store (list channel))))
               (and (eq? 2 (length instances))
@@ -155,11 +155,11 @@
                    (url "test")))
          (test-dir (channel-instance-checkout instance--with-dupes)))
     (mock ((guix git) update-cached-checkout
-           (lambda* (url #:key ref)
+           (lambda* (url #:key ref starting-commit)
              (match url
-               ("test" (values test-dir "caf3cabba9e"))
+               ("test" (values test-dir "caf3cabba9e" #f))
                (_      (values (channel-instance-checkout instance--no-deps)
-                               "abcde1234")))))
+                               "abcde1234" #f)))))
           (with-store store
             (let ((instances (latest-channel-instances store (list channel))))
               (and (= 2 (length instances))
-- 
2.26.2

[bug#41425] [PATCH 4/5] channels: 'latest-channel-instances' guards against non-forward updates.

[Ludovic Courtès]

* guix/channels.scm (latest-channel-instance): Add #:starting-commit and
pass it to 'update-cached-checkout'.  Return the commit relation as a
second value.
(ensure-forward-channel-update): New procedure.
(latest-channel-instances): Add #:current-channels and #:validate-pull.
[current-commit]: New procedure.
Pass #:starting-commit to 'latest-channel-instance'.  When the returned
relation is true, call VALIDATE-PULL.
(latest-channel-derivation): Add #:current-channels and #:validate-pull.
Pass them to 'latest-channel-instances*'.
* tests/channels.scm ("latest-channel-instances #:validate-pull"): New
test.
---
 guix/channels.scm  | 89 ++++++++++++++++++++++++++++++++++++++++------
 tests/channels.scm | 35 ++++++++++++++++++
 2 files changed, 114 insertions(+), 10 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 75b767a94c..70e2d7f07c 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -73,6 +73,7 @@
             channel-instances->manifest
             %channel-profile-hooks
             channel-instances->derivation
+            ensure-forward-channel-update
 
             profile-channels
 
@@ -212,15 +213,18 @@ result is unspecified."
        (loop rest)))))
 
 (define* (latest-channel-instance store channel
-                                  #:key (patches %patches))
-  "Return the latest channel instance for CHANNEL."
+                                  #:key (patches %patches)
+                                  starting-commit)
+  "Return two values: the latest channel instance for CHANNEL, and its
+relation to STARTING-COMMIT when provided."
   (define (dot-git? file stat)
     (and (string=? (basename file) ".git")
          (eq? 'directory (stat:type stat))))
 
   (let-values (((checkout commit relation)
                 (update-cached-checkout (channel-url channel)
-                                        #:ref (channel-reference channel))))
+                                        #:ref (channel-reference channel)
+                                        #:starting-commit starting-commit)))
     (when (guix-channel? channel)
       ;; Apply the relevant subset of PATCHES directly in CHECKOUT.  This is
       ;; safe to do because 'switch-to-ref' eventually does a hard reset.
@@ -229,11 +233,51 @@ result is unspecified."
     (let* ((name     (url+commit->name (channel-url channel) commit))
            (checkout (add-to-store store name #t "sha256" checkout
                                    #:select? (negate dot-git?))))
-      (channel-instance channel commit checkout))))
+      (values (channel-instance channel commit checkout)
+              relation))))
 
-(define* (latest-channel-instances store channels)
+(define (ensure-forward-channel-update channel start instance relation)
+  "Raise an error if RELATION is not 'ancestor, meaning that START is not an
+ancestor of the commit in INSTANCE, unless CHANNEL specifies a commit.
+
+This procedure implements a channel update policy meant to be used as a
+#:validate-pull argument."
+  (match relation
+    ('ancestor #t)
+    ('self #t)
+    (_
+     (raise (apply make-compound-condition
+                   (condition
+                    (&message (message
+                               (format #f (G_ "\
+aborting update of channel '~a' to commit ~a, which is not a descendant of ~a")
+                                       (channel-name channel)
+                                       (channel-instance-commit instance)
+                                       start))))
+
+                   ;; Don't show the hint when the user explicitly specified a
+                   ;; commit in CHANNEL.
+                   (if (channel-commit channel)
+                       '()
+                       (list (condition
+                              (&fix-hint
+                               (hint (G_ "This could indicate that the channel has
+been tampered with and is trying to force a roll-back, preventing you from
+getting the latest updates.  If you think this is not the case, explicitly
+allow non-forward updates.")))))))))))
+
+(define* (latest-channel-instances store channels
+                                   #:key
+                                   (current-channels '())
+                                   (validate-pull
+                                    ensure-forward-channel-update))
   "Return a list of channel instances corresponding to the latest checkouts of
-CHANNELS and the channels on which they depend."
+CHANNELS and the channels on which they depend.
+
+CURRENT-CHANNELS is the list of currently used channels.  It is compared
+against the newly-fetched instances of CHANNELS, and VALIDATE-PULL is called
+for each channel update and can choose to emit warnings or raise an error,
+depending on the policy it implements."
   ;; Only process channels that are unique, or that are more specific than a
   ;; previous channel specification.
   (define (ignore? channel others)
@@ -244,6 +288,13 @@ CHANNELS and the channels on which they depend."
                        (not (or (channel-commit a)
                                 (channel-commit b))))))))
 
+  (define (current-commit name)
+    ;; Return the current commit for channel NAME.
+    (any (lambda (channel)
+           (and (eq? (channel-name channel) name)
+                (channel-commit channel)))
+         current-channels))
+
   (let loop ((channels channels)
              (previous-channels '()))
     ;; Accumulate a list of instances.  A list of processed channels is also
@@ -257,7 +308,15 @@ CHANNELS and the channels on which they depend."
                              (G_ "Updating channel '~a' from Git repository at '~a'...~%")
                              (channel-name channel)
                              (channel-url channel))
-                     (let ((instance (latest-channel-instance store channel)))
+                     (let*-values (((current)
+                                    (current-commit (channel-name channel)))
+                                   ((instance relation)
+                                    (latest-channel-instance store channel
+                                                             #:starting-commit
+                                                             current)))
+                       (when relation
+                         (validate-pull channel current instance relation))
+
                        (let-values (((new-instances new-channels)
                                      (loop (channel-instance-dependencies instance)
                                            previous-channels)))
@@ -617,10 +676,20 @@ channel instances."
 (define latest-channel-instances*
   (store-lift latest-channel-instances))
 
-(define* (latest-channel-derivation #:optional (channels %default-channels))
+(define* (latest-channel-derivation #:optional (channels %default-channels)
+                                    #:key
+                                    (current-channels '())
+                                    (validate-pull
+                                     ensure-forward-channel-update))
   "Return as a monadic value the derivation that builds the profile for the
-latest instances of CHANNELS."
-  (mlet %store-monad ((instances (latest-channel-instances* channels)))
+latest instances of CHANNELS.  CURRENT-CHANNELS and VALIDATE-PULL are passed
+to 'latest-channel-instances'."
+  (mlet %store-monad ((instances
+                       (latest-channel-instances* channels
+                                                  #:current-channels
+                                                  current-channels
+                                                  #:validate-pull
+                                                  validate-pull)))
     (channel-instances->derivation instances)))
 
 (define (profile-channels profile)
diff --git a/tests/channels.scm b/tests/channels.scm
index 3578b57204..3b141428c8 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -37,6 +37,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
+  #:use-module (ice-9 control)
   #:use-module (ice-9 match))
 
 (test-begin "channels")
@@ -178,6 +179,40 @@
                                           "abc1234")))
                          instances)))))))
 
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-channel-instances #:validate-pull"
+  'descendant
+
+  ;; Make sure the #:validate-pull procedure receives the right values.
+  (let/ec return
+    (with-temporary-git-repository directory
+        '((add "a.txt" "A")
+          (commit "first commit")
+          (add "b.scm" "#t")
+          (commit "second commit"))
+      (with-repository directory repository
+        (let* ((commit1 (find-commit repository "first"))
+               (commit2 (find-commit repository "second"))
+               (spec    (channel (url (string-append "file://" directory))
+                                 (name 'foo)))
+               (new     (channel (inherit spec)
+                                 (commit (oid->string (commit-id commit2)))))
+               (old     (channel (inherit spec)
+                                 (commit (oid->string (commit-id commit1))))))
+          (define (validate-pull channel current instance relation)
+            (return (and (eq? channel old)
+                         (string=? (oid->string (commit-id commit2))
+                                   current)
+                         (string=? (oid->string (commit-id commit1))
+                                   (channel-instance-commit instance))
+                         relation)))
+
+          (with-store store
+            ;; Attempt a downgrade from NEW to OLD.
+            (latest-channel-instances store (list old)
+                                      #:current-channels (list new)
+                                      #:validate-pull validate-pull)))))))
+
 (test-assert "channel-instances->manifest"
   ;; Compute the manifest for a graph of instances and make sure we get a
   ;; derivation graph that mirrors the instance graph.  This test also ensures
-- 
2.26.2

[bug#41425] [PATCH 5/5] pull: Protect against downgrade attacks.

[Ludovic Courtès]

* guix/scripts/pull.scm (%default-options): Add 'validate-pull'.
(%options, show-help): Add '--allow-downgrades'.
(warn-about-backward-updates): New procedure.
(guix-pull): Pass #:current-channels and #:validate-pull to
'latest-channel-instances'.
* guix/channels.scm (ensure-forward-channel-update): Add hint for
when (channel-commit channel) is true.
* doc/guix.texi (Invoking guix pull): Document '--allow-downgrades'.
---
 doc/guix.texi         | 15 +++++++++++++++
 guix/channels.scm     | 34 +++++++++++++++++++---------------
 guix/scripts/pull.scm | 35 ++++++++++++++++++++++++++++++++---
 3 files changed, 66 insertions(+), 18 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index eef5b703fe..79ed260a85 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3900,6 +3900,21 @@ Use @var{profile} instead of @file{~/.config/guix/current}.
 Show which channel commit(s) would be used and what would be built or
 substituted but do not actually do it.
 
+@item --allow-downgrades
+Allow pulling older or unrelated revisions of channels than those
+currently in use.
+
+@cindex downgrade attacks, protection against
+By default, @command{guix pull} protects against so-called ``downgrade
+attacks'' whereby the Git repository of a channel would be reset to an
+earlier or unrelated revision of itself, potentially leading you to
+install older, known-vulnerable versions of software packages.
+
+@quotation Note
+Make sure you understand its security implications before using
+@option{--allow-downgrades}.
+@end quotation
+
 @item --system=@var{system}
 @itemx -s @var{system}
 Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
diff --git a/guix/channels.scm b/guix/channels.scm
index 70e2d7f07c..84c47fc0d0 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -246,25 +246,29 @@ This procedure implements a channel update policy meant to be used as a
     ('ancestor #t)
     ('self #t)
     (_
-     (raise (apply make-compound-condition
-                   (condition
-                    (&message (message
-                               (format #f (G_ "\
+     (raise (make-compound-condition
+             (condition
+              (&message (message
+                         (format #f (G_ "\
 aborting update of channel '~a' to commit ~a, which is not a descendant of ~a")
-                                       (channel-name channel)
-                                       (channel-instance-commit instance)
-                                       start))))
+                                 (channel-name channel)
+                                 (channel-instance-commit instance)
+                                 start))))
 
-                   ;; Don't show the hint when the user explicitly specified a
-                   ;; commit in CHANNEL.
-                   (if (channel-commit channel)
-                       '()
-                       (list (condition
-                              (&fix-hint
-                               (hint (G_ "This could indicate that the channel has
+             ;; If the user asked for a specific commit, they might want
+             ;; that to happen nevertheless, so tell them about the
+             ;; relevant 'guix pull' option.
+             (if (channel-commit channel)
+                 (condition
+                  (&fix-hint
+                   (hint (G_ "Use @option{--allow-downgrades} to force
+this downgrade."))))
+                 (condition
+                  (&fix-hint
+                   (hint (G_ "This could indicate that the channel has
 been tampered with and is trying to force a roll-back, preventing you from
 getting the latest updates.  If you think this is not the case, explicitly
-allow non-forward updates.")))))))))))
+allow non-forward updates."))))))))))
 
 (define* (latest-channel-instances store channels
                                    #:key
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index dfe7ee7ad5..c386d81b8e 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -81,7 +81,8 @@
     (multiplexed-build-output? . #t)
     (graft? . #t)
     (debug . 0)
-    (verbosity . 1)))
+    (verbosity . 1)
+    (validate-pull . ,ensure-forward-channel-update)))
 
 (define (show-help)
   (display (G_ "Usage: guix pull [OPTION]...
@@ -94,6 +95,8 @@ Download and deploy the latest version of Guix.\n"))
       --commit=COMMIT    download the specified COMMIT"))
   (display (G_ "
       --branch=BRANCH    download the tip of the specified BRANCH"))
+  (display (G_ "
+      --allow-downgrades allow downgrades to earlier channel revisions"))
   (display (G_ "
   -N, --news             display news compared to the previous generation"))
   (display (G_ "
@@ -158,6 +161,10 @@ Download and deploy the latest version of Guix.\n"))
          (option '("branch") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'ref `(branch . ,arg) result)))
+         (option '("allow-downgrades") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'validate-pull warn-about-backward-updates
+                               result)))
          (option '(#\p "profile") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'profile (canonicalize-profile arg)
@@ -188,6 +195,21 @@ Download and deploy the latest version of Guix.\n"))
 
          %standard-build-options))
 
+(define (warn-about-backward-updates channel start instance relation)
+  "Warn about non-forward updates of CHANNEL from START to INSTANCE, without
+aborting."
+  (match relation
+    ((or 'ancestor 'self)
+     #t)
+    ('descendant
+     (warning (G_ "rolling back channel '~a' from ~a to ~a~%")
+              (channel-name channel) start
+              (channel-instance-commit instance)))
+    ('unrelated
+     (warning (G_ "moving channel '~a' from ~a to unrelated commit ~a~%")
+              (channel-name channel) start
+              (channel-instance-commit instance)))))
+
 (define* (display-profile-news profile #:key concise?
                                current-is-newer?)
   "Display what's up in PROFILE--new packages, and all that.  If
@@ -749,7 +771,9 @@ Use '~/.config/guix/channels.scm' instead."))
             (substitutes? (assoc-ref opts 'substitutes?))
             (dry-run?     (assoc-ref opts 'dry-run?))
             (channels     (channel-list opts))
-            (profile      (or (assoc-ref opts 'profile) %current-profile)))
+            (profile      (or (assoc-ref opts 'profile) %current-profile))
+            (current-channels (profile-channels profile))
+            (validate-pull    (assoc-ref opts 'validate-pull)))
        (cond ((assoc-ref opts 'query)
               (process-query opts profile))
              ((assoc-ref opts 'generation)
@@ -766,7 +790,12 @@ Use '~/.config/guix/channels.scm' instead."))
                       (ensure-default-profile)
                       (honor-x509-certificates store)
 
-                      (let ((instances (latest-channel-instances store channels)))
+                      (let ((instances
+                             (latest-channel-instances store channels
+                                                       #:current-channels
+                                                       current-channels
+                                                       #:validate-pull
+                                                       validate-pull)))
                         (format (current-error-port)
                                 (N_ "Building from this channel:~%"
                                     "Building from these channels:~%"
-- 
2.26.2

[bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[zimoun]

Hi Ludo,

On Wed, 20 May 2020 at 23:39, Ludovic Courtès <ludo@gnu.org> wrote:

> By default ‘guix pull’ would now error out if the target commit of a
> channel is not a descendant of the currently-used commit, according to
> the commit graph.  There’s an option to bypass that.  ‘guix
> time-machine’ behavior is unchanged though: it never complains.

What is the extra time cost of such check?  Well, it depends on the
"distance" between the 2 commits and maybe the complexity of the graph
-- it it not clear what happen for complex merge -- but say pulling
once a month.

It is not easy -- nor impossible -- to evaluate such cost at the level
of "guix pull".  And I failed to evaluate it using 'commit-relation'
with "guix repl" -- Segmentation fault with commit
c81457a5883ea43950eb2ecdcbb58a5b144bcd11 and
4bdf4182fe080c3409f6ef9b410146b67cfa2595; probably because I did used
correctly the API.


Well, what will be the timing impact of checking the "fast-fowardness"?


All the best,
simon

[bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[Ludovic Courtès]

Hi Simon,

zimoun <zimon.toutoune@gmail.com> skribis:

> On Wed, 20 May 2020 at 23:39, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> By default ‘guix pull’ would now error out if the target commit of a
>> channel is not a descendant of the currently-used commit, according to
>> the commit graph.  There’s an option to bypass that.  ‘guix
>> time-machine’ behavior is unchanged though: it never complains.
>
> What is the extra time cost of such check?

The problem is not the cost.  ‘guix pull’ compares the target commit(s)
against the commit(s) of the currently-used ‘guix’; it can clearly see
if it’s a forward pull or not.

However, in the case of ‘guix time-machine’, there’s nothing to compare
against (it’s a bit like a fresh ‘git clone’ as opposed to a ‘git pull’,
if you see what I mean.)

Additionally, the purpose of ‘guix time-machine’ is to travel in time,
usually in the past, so it would be inconvenient to get warnings or
errors every time.

> It is not easy -- nor impossible -- to evaluate such cost at the level
> of "guix pull".  And I failed to evaluate it using 'commit-relation'
> with "guix repl" -- Segmentation fault with commit
> c81457a5883ea43950eb2ecdcbb58a5b144bcd11 and
> 4bdf4182fe080c3409f6ef9b410146b67cfa2595; probably because I did used
> correctly the API.

How can I reproduce the issue?

> Well, what will be the timing impact of checking the "fast-fowardness"?

I haven’t measured it, but it’s small compared to the cost of fetching
the new revisions and performing the checkout.  It’s roughly what ‘git
pull’ does, although ‘git pull’ is probably faster because it’s in C and
has been well optimized over the years.

Thanks for your feedback!

Ludo’.

[bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[zimoun]

On Fri, 22 May 2020 at 15:56, Ludovic Courtès <ludo@gnu.org> wrote:

> > It is not easy -- nor impossible -- to evaluate such cost at the level
> > of "guix pull".  And I failed to evaluate it using 'commit-relation'
> > with "guix repl" -- Segmentation fault with commit
> > c81457a5883ea43950eb2ecdcbb58a5b144bcd11 and
> > 4bdf4182fe080c3409f6ef9b410146b67cfa2595; probably because I did used
> > correctly the API.

Obviously, one had to read "probably I did *not* used correctly the API". :-)

> How can I reproduce the issue?

--8<---------------cut here---------------start------------->8---
(use-modules (guix git) (guix channels) (guix tests git) (git))
(define url-cache-directory (@@ (guix git) url-cache-directory))
(define dir (url-cache-directory (channel-url (car %default-channels))))
(define merge (with-repository dir repo (find-commit repo "Merge")))
merge
;; $1 = #<git-commit 4bdf4182fe080c3409f6ef9b410146b67cfa2595>
(define left (car (commit-parents merge)))
left
;; $2 = #<git-commit c81457a5883ea43950eb2ecdcbb58a5b144bcd11>
(commit-relation left merge)
Segmentation fault
--8<---------------cut here---------------end--------------->8---

Because of 'commit-closure'.
I do not know if it is the correct use of the API; and because I do
not know how to get easily a commit, I use 'find-commit' which is not
nice.


> > Well, what will be the timing impact of checking the "fast-fowardness"?
>
> I haven’t measured it, but it’s small compared to the cost of fetching
> the new revisions and performing the checkout.  It’s roughly what ‘git
> pull’ does, although ‘git pull’ is probably faster because it’s in C and
> has been well optimized over the years.

My "worry" is about the complexity of the graph because
'commit-relation' walks somehow the graph of commits.


Cheers,
simon

[bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[Ludovic Courtès]

Hi,

zimoun <zimon.toutoune@gmail.com> skribis:

> (use-modules (guix git) (guix channels) (guix tests git) (git))
> (define url-cache-directory (@@ (guix git) url-cache-directory))
> (define dir (url-cache-directory (channel-url (car %default-channels))))
> (define merge (with-repository dir repo (find-commit repo "Merge")))
> merge
> ;; $1 = #<git-commit 4bdf4182fe080c3409f6ef9b410146b67cfa2595>
> (define left (car (commit-parents merge)))
> left
> ;; $2 = #<git-commit c81457a5883ea43950eb2ecdcbb58a5b144bcd11>
> (commit-relation left merge)
> Segmentation fault

It took me a while to notice, but the problem with the code above is
that ‘repo’ is closed when you call ‘commit-relation’, and thus the
commit objects are invalid.  It works if you keep ‘repo’ alive:

--8<---------------cut here---------------start------------->8---
$ guix describe
Generacio 145	May 25 2020 00:37:58	(nuna)
  guix 9744cc7
    repository URL: https://git.savannah.gnu.org/git/guix.git
    branch: master
    commit: 9744cc7b4636fafb772c94adb8f05961b5b39f16
$ guix repl
GNU Guile 3.0.2
Copyright (C) 1995-2020 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guix-user)> (use-modules (guix git) (guix channels) (guix tests git) (git))
(define url-cache-directory (@@ (guix git) url-cache-directory))
(define dir (url-cache-directory (channel-url (car %default-channels))))
;;; <stdin>:2:0: warning: possibly unused local top-level variable `url-cache-directory'
;;; <stdin>:3:0: warning: possibly unused local top-level variable `dir'
scheme@(guix-user)> (define repo (repository-open dir))
;;; <stdin>:4:0: warning: possibly unused local top-level variable `repo'
scheme@(guix-user)> (define merge (find-commit repo "Merge"))
;;; <stdin>:5:0: warning: possibly unused local top-level variable `merge'
scheme@(guix-user)> merge
$1 = #<git-commit b4440de133401abc6ce8be6c1c2e720efd9b2ba3>
scheme@(guix-user)> (define left (car (commit-parents merge)))
left
;;; <stdin>:7:0: warning: possibly unused local top-level variable `left'
$2 = #<git-commit 141262f266ab702c856f634889d4130ae661e79f>
scheme@(guix-user)> (commit-relation left merge)
$3 = ancestor
scheme@(guix-user)> (gc)
scheme@(guix-user)> (commit-relation left merge)
$4 = ancestor
--8<---------------cut here---------------end--------------->8---

The solution in such cases is to synchronize the object lifetimes.  In
this case, commits would keep a reference to the repository object to
prevent it from being GC’d, as is done with ‘%submodule-owners’ in (git
submodule).

Could you make an issue over at
<https://gitlab.com/guile-git/guile-git>?

Thanks,
Ludo’.

[bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[zimoun]

Hi Ludo,

On Wed, 27 May 2020 at 18:32, Ludovic Courtès <ludo@gnu.org> wrote:

> > (commit-relation left merge)
> > Segmentation fault
>
> It took me a while to notice, but the problem with the code above is
> that ‘repo’ is closed when you call ‘commit-relation’, and thus the
> commit objects are invalid.  It works if you keep ‘repo’ alive:

It make totally sense.  Thank you for the explanations.


> --8<---------------cut here---------------start------------->8---
> $ guix describe
> Generacio 145   May 25 2020 00:37:58    (nuna)
>   guix 9744cc7
>     repository URL: https://git.savannah.gnu.org/git/guix.git
>     branch: master
>     commit: 9744cc7b4636fafb772c94adb8f05961b5b39f16
> $ guix repl
> GNU Guile 3.0.2
> Copyright (C) 1995-2020 Free Software Foundation, Inc.
>
> Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
> This program is free software, and you are welcome to redistribute it
> under certain conditions; type `,show c' for details.
>
> Enter `,help' for help.
> scheme@(guix-user)> (use-modules (guix git) (guix channels) (guix tests git) (git))
> (define url-cache-directory (@@ (guix git) url-cache-directory))
> (define dir (url-cache-directory (channel-url (car %default-channels))))
> ;;; <stdin>:2:0: warning: possibly unused local top-level variable `url-cache-directory'
> ;;; <stdin>:3:0: warning: possibly unused local top-level variable `dir'
> scheme@(guix-user)> (define repo (repository-open dir))
> ;;; <stdin>:4:0: warning: possibly unused local top-level variable `repo'
> scheme@(guix-user)> (define merge (find-commit repo "Merge"))
> ;;; <stdin>:5:0: warning: possibly unused local top-level variable `merge'
> scheme@(guix-user)> merge
> $1 = #<git-commit b4440de133401abc6ce8be6c1c2e720efd9b2ba3>
> scheme@(guix-user)> (define left (car (commit-parents merge)))
> left
> ;;; <stdin>:7:0: warning: possibly unused local top-level variable `left'
> $2 = #<git-commit 141262f266ab702c856f634889d4130ae661e79f>
> scheme@(guix-user)> (commit-relation left merge)
> $3 = ancestor
> scheme@(guix-user)> (gc)
> scheme@(guix-user)> (commit-relation left merge)
> $4 = ancestor
> --8<---------------cut here---------------end--------------->8---

Well, the '(gc)' has no effect here because 'repo' is still alive and
thus the reference too.  Instead, an example would be:

--8<---------------cut here---------------start------------->8---
[...]
scheme@(guix-user)> (commit-relation left merge)
$3 = ancestor
scheme@(guix-user)> (define repo 42)
scheme@(guix-user)> (commit-relation left merge)
$4 = ancestor
scheme@(guix-user)> (gc)
scheme@(guix-user)> (commit-relation left merge)
Segmentation fault
--8<---------------cut here---------------end--------------->8---

isn't?  Which is somehow the same than the initial example.


> The solution in such cases is to synchronize the object lifetimes.  In
> this case, commits would keep a reference to the repository object to
> prevent it from being GC’d, as is done with ‘%submodule-owners’ in (git
> submodule).

I think I understand.


> Could you make an issue over at
> <https://gitlab.com/guile-git/guile-git>?

I will.


Thank you for the explanation.

bug#41425: [PATCH 0/5] Have 'guix pull' protect against downgrade attacks

[Ludovic Courtès]

Pushed!

  9744cc7b46 pull: Protect against downgrade attacks.
  872898f768 channels: 'latest-channel-instances' guards against non-forward updates.
  8d1d56578a git: 'update-cached-checkout' returns the commit relation.
  9b049de84e channels: 'latest-channel-instances' doesn't leak internal state.
  c098c11be8 git: Add 'commit-relation'.

One step closer to addressing <https://issues.guix.gnu.org/22883>…

Ludo’.