From: "Ludovic Courtès" <ludo@gnu.org>
To: 41425@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#41425] [PATCH 4/5] channels: 'latest-channel-instances' guards against non-forward updates.
Date: Wed, 20 May 2020 23:47:24 +0200 [thread overview]
Message-ID: <20200520214725.2437-4-ludo@gnu.org> (raw)
In-Reply-To: <20200520214725.2437-1-ludo@gnu.org>
* 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
next prev parent reply other threads:[~2020-05-20 21:48 UTC|newest]
Thread overview: 12+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-05-20 21:38 [bug#41425] [PATCH 0/5] Have 'guix pull' protect against downgrade attacks Ludovic Courtès
2020-05-20 21:47 ` [bug#41425] [PATCH 1/5] git: Add 'commit-relation' Ludovic Courtès
2020-05-20 21:47 ` [bug#41425] [PATCH 2/5] channels: 'latest-channel-instances' doesn't leak internal state Ludovic Courtès
2020-05-20 21:47 ` [bug#41425] [PATCH 3/5] git: 'update-cached-checkout' returns the commit relation Ludovic Courtès
2020-05-20 21:47 ` Ludovic Courtès [this message]
2020-05-20 21:47 ` [bug#41425] [PATCH 5/5] pull: Protect against downgrade attacks Ludovic Courtès
2020-05-21 14:06 ` [bug#41425] [PATCH 0/5] Have 'guix pull' protect " zimoun
2020-05-22 13:55 ` Ludovic Courtès
2020-05-25 14:36 ` zimoun
2020-05-27 16:32 ` Ludovic Courtès
2020-05-28 8:06 ` zimoun
2020-05-24 22:02 ` bug#41425: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200520214725.2437-4-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=41425@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).