(name . Rostislav Svoboda)(address . Rostislav.Svoboda@gmail.com)
3dbbb59fdc650a20a0eb853a0d30aaccae1beae5.1712927299.git.Rostislav.Svoboda@gmail.com
Introduce the ability to specify channels for downgrades in `guix pull`,
enhancing security by enabling users to trust certain channels over
others. This update maintains backward compatibility and updates relevant
documentation.
* guix/scripts/pull.scm (allow-downgrades): Option accepts a list of
downgradable channels, add '-a' as its short version.
(%default-options): Remove validate-pull.
(channels-with-validations): New procedure.
* guix/channels.scm (latest-channel-instances): Signature change.
* doc/guix.texi (Invoking guix pull): Document changes.
Change-Id: If947a2453c520463d77da9591af9ac03e6472afc
---
doc/guix.texi | 21 ++++++----
guix/channels.scm | 61 +++++++++++++++++------------
guix/scripts/pull.scm | 89 +++++++++++++++++++++++++++++++++++++------
3 files changed, 127 insertions(+), 44 deletions(-)
Toggle diff (357 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 5827e0de14..6126c1b5ef 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4565,15 +4565,22 @@ Invoking guix pull
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.
+@item --allow-downgrades[=channels]
+@itemx -a [channels]
+Allows pulling older or unrelated revisions of specified channels, or
+all channels if none are specified.
@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.
+By default, @command{guix pull} safeguards against so-called ``downgrade
+attacks``, where a channel's Git repository is reset to a previous or
+unrelated revision, potentially causing the installation of older,
+vulnerable software versions. Without specifying channels, this
+protection is disabled entirely, posing a security risk.
+
+It's advisable to permit downgrades only for channels you trust
+implicitly, such as those you maintain. For all other channels,
+including the official Guix channel, downgrade protection remains
+recommended.
@quotation Note
Make sure you understand its security implications before using
diff --git a/guix/channels.scm b/guix/channels.scm
index 66f3122f79..af5a0b26c4 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -497,26 +497,35 @@ (define (channel-instance-primary-url instance)
(define* (latest-channel-instances store channels
#:key
- (current-channels '())
- (authenticate? #t)
- (validate-pull
- ensure-forward-channel-update))
+ (channel-validation-pairs '())
+ (authenticate? #t))
"Return a list of channel instances corresponding to the latest checkouts of
CHANNELS and the channels on which they depend.
When AUTHENTICATE? is true, authenticate the subset of CHANNELS that has a
\"channel introduction\".
-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."
+CHANNEL-VALIDATION-PAIRS is a list of pairs of currently used channels with their
+respective validation procedures: (current-channel . validate-pull). The
+current-channel is compared against the newly-fetched instances of CHANNELS, and its
+validate-pull procedure is called for each channel update and can choose to emit
+warnings or raise an error, depending on the policy it implements."
(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))
+ "Return the current commit for channel NAME."
+ (any (lambda (channel-with-validation)
+ (let ((channel (car channel-with-validation)))
+ (and (eq? (channel-name channel) name)
+ (channel-commit channel))))
+ channel-validation-pairs))
+
+ (define (current-validate-pull name)
+ "Return the desired validate-pull procedure for channel NAME."
+ (any (lambda (channel-with-validation)
+ (let ((channel (car channel-with-validation))
+ (validate-pull (cdr channel-with-validation)))
+ (and (eq? (channel-name channel) name)
+ validate-pull)))
+ channel-validation-pairs))
(define instance-name
(compose channel-name channel-instance-channel))
@@ -544,20 +553,22 @@ (define* (latest-channel-instances store channels
(if (and previous
(not (more-specific? channel previous)))
(loop rest previous-channels instances)
- (begin
+ (let ((current (current-commit (channel-name channel)))
+ (validate-pull (current-validate-pull (channel-name channel))))
+ ;; (format #t "channel '~a' is validated by '~a'~%"
+ ;; (channel-name channel) (procedure-name validate-pull))
(format (current-error-port)
(G_ "Updating channel '~a' from Git repository at '~a'...~%")
(channel-name channel)
(channel-url channel))
- (let* ((current (current-commit (channel-name channel)))
- (instance
- (latest-channel-instance store channel
- #:authenticate?
- authenticate?
- #:validate-pull
- validate-pull
- #:starting-commit
- current)))
+ (let ((instance
+ (latest-channel-instance store channel
+ #:authenticate?
+ authenticate?
+ #:validate-pull
+ validate-pull
+ #:starting-commit
+ current)))
(when authenticate?
;; CHANNEL is authenticated so we can trust the
;; primary URL advertised in its metadata and warn
@@ -1001,7 +1012,7 @@ (define latest-channel-instances*
(define* (latest-channel-derivation #:optional (channels %default-channels)
#:key
- (current-channels '())
+ (channel-validation-pairs '())
(validate-pull
ensure-forward-channel-update))
"Return as a monadic value the derivation that builds the profile for the
@@ -1010,7 +1021,7 @@ (define* (latest-channel-derivation #:optional (channels %default-channels)
(mlet %store-monad ((instances
(latest-channel-instances* channels
#:current-channels
- current-channels
+ channel-validation-pairs
#:validate-pull
validate-pull)))
(channel-instances->derivation instances)))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 58d3cd7e83..c662e88771 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -76,8 +76,7 @@ (define %default-options
(graft? . #t)
(debug . 0)
(verbosity . 1)
- (authenticate-channels? . #t)
- (validate-pull . ,ensure-forward-channel-update)))
+ (authenticate-channels? . #t)))
(define (show-help)
(display (G_ "Usage: guix pull [OPTION]...
@@ -94,7 +93,8 @@ (define (show-help)
(display (G_ "
--branch=BRANCH download the tip of the specified \"guix\" channel BRANCH"))
(display (G_ "
- --allow-downgrades allow downgrades to earlier channel revisions"))
+ -a, --allow-downgrades[=CHANNELS]
+ allow downgrades to earlier revisions of CHANNELS"))
(display (G_ "
--disable-authentication
disable channel authentication"))
@@ -176,10 +176,37 @@ (define %options
(option '("branch") #t #f
(lambda (opt name arg result)
(alist-cons 'ref `(branch . ,arg) result)))
- (option '("allow-downgrades") #f #f
+ (option '(#\a "allow-downgrades") #f #t
(lambda (opt name arg result)
- (alist-cons 'validate-pull warn-about-backward-updates
- result)))
+ (cond
+ ((string? arg)
+ ((compose
+ (cut alist-cons 'allow-downgrades <>
+ (alist-delete 'allow-downgrades result))
+ (cut append
+ (or (assoc-ref result 'allow-downgrades)
+ (list))
+ <>))
+ ;; Values may be also comma-separated. Possibilities:
+ ;; -a val1 -a val2,val3 -a val4 -aval5
+ (string-tokenize arg
+ (char-set-complement (char-set #\,)))))
+ ((boolean? arg)
+ ;; The command contains this option with no value
+ ;; specified, (`arg' is #f). We'll interpreted this as
+ ;; 'all channels can be downgraded'
+ (alist-cons 'allow-downgrades #t result))
+ (else
+ ((compose
+ (lambda (text)
+ (raise (condition (&message (message text)))))
+ (cut format #f <>
+ "You found a bug:" arg name
+ version system %guix-version
+ %guix-bug-report-address))
+ "~a The value '~a' of the '~a' option is unrecognized.
+(version: ~s; system: ~s; host version: ~s)
+Please report the COMPLETE output above by email to <~a>.~%")))))
(option '("disable-authentication") #f #f
(lambda (opt name arg result)
(alist-cons 'authenticate-channels? #f result)))
@@ -828,6 +855,41 @@ (define (validate-cache-directory-ownership)
@command{sudo -i} or equivalent if you really want to pull as ~a.")
dir:user our:user)))))))))))
+(define (channels-with-validations downgradable-candidates channels)
+ "Return a list of pairs: channel + pull-validation procedure. The procedure
+is `warn-about-backward-updates' if a given channel is among the
+DOWNGRADABLE-CANDIDATES or `ensure-forward-channel-update' otherwise. E.g.:
+
+((channel1 . #<procedure warn-about-backward-updates ...>)
+ (channel2 . #<procedure ensure-forward-channel-update ...>))"
+ (cond
+ ((and (list? downgradable-candidates) (not (null? downgradable-candidates)))
+ (let ((downgradables-candidate-names (map string->symbol
+ downgradable-candidates))
+ (channels-names (map channel-name channels)))
+ (map (lambda (name)
+ (unless (member name channels-names)
+ (leave (G_ "'~a' must be one of '~a~'%") name channels-names)))
+ downgradables-candidate-names)
+ (let* ((downgradables-names
+ (filter (cut member <> downgradables-candidate-names)
+ channels-names))
+ (downgradables
+ (filter (compose (cut member <> downgradables-names)
+ (cut channel-name <>))
+ channels))
+ (non-downgradables (lset-difference equal? channels
+ downgradables)))
+ (append
+ (map (cut cons <> warn-about-backward-updates) downgradables)
+ (map (cut cons <> ensure-forward-channel-update) non-downgradables)))))
+
+ ((and (boolean? downgradable-candidates) downgradable-candidates)
+ (map (cut cons <> warn-about-backward-updates) channels))
+
+ (else
+ (map (cut cons <> ensure-forward-channel-update) channels))))
+
(define-command (guix-pull . args)
(synopsis "pull the latest revision of Guix")
@@ -844,7 +906,7 @@ (define-command (guix-pull . args)
(dry-run? (assoc-ref opts 'dry-run?))
(profile (or (assoc-ref opts 'profile) %current-profile))
(current-channels (profile-channels profile))
- (validate-pull (assoc-ref opts 'validate-pull))
+ (allow-downgrades (assoc-ref opts 'allow-downgrades))
(authenticate? (assoc-ref opts 'authenticate-channels?)))
(cond
((assoc-ref opts 'query)
@@ -868,14 +930,17 @@ (define-command (guix-pull . args)
(set-build-options-from-command-line store opts)
(ensure-default-profile)
(honor-x509-certificates store)
-
(let* ((channels (channel-list opts))
+ (channel-validation-pairs
+ ;; Only current-channels can be checked against
+ ;; downgrade-attacks. New channels can't be
+ ;; downgraded. Their commit history is unknown yet.
+ (channels-with-validations allow-downgrades
+ current-channels))
(instances
(latest-channel-instances store channels
- #:current-channels
- current-channels
- #:validate-pull
- validate-pull
+ #:channel-validation-pairs
+ channel-validation-pairs
#:authenticate?
authenticate?)))
(format (current-error-port)
base-commit: 7af70efd7633b0d70091762cf43ce01a86176e8e
prerequisite-patch-id: e64f0d27446c1c560ad851f367a2472c14a7037e
prerequisite-patch-id: dfa2d04882577e60f7d473731e434454b8852644
prerequisite-patch-id: cc23ce978964d00cd66167c9465795838079d103
prerequisite-patch-id: f802f9482cfdb9b3b403616d8c2e91a252eee72c
prerequisite-patch-id: f1fd30f4906d43b4a0cbd16d45407cb75a3af0d5
prerequisite-patch-id: 375dece6d1cab20d1f4b4185c872634faa63d877
prerequisite-patch-id: 46680596f20c72c67fd869c057fb7eb0904f3bc9
prerequisite-patch-id: 866db02be533978a7953f5404a01335ae9434cb0
prerequisite-patch-id: e0e407612802204a5a17ae9678b78f13a6957a4a
prerequisite-patch-id: 1d7d9a6c7af37a60d9b24ec5b6ddfcb63bfa3658
prerequisite-patch-id: c54d19e7e00697430d955942249f8ac06a0d5e0d
prerequisite-patch-id: c51a937244a2bfd3098b14dacea70820e4175cd3
prerequisite-patch-id: 0d64205fece7716a15913d1b5b1e6264542c3e6b
prerequisite-patch-id: 48a4c1d593f45b030b20d21424423b18fc628be5
prerequisite-patch-id: 5a7198d3c2e5c1711c707875657886fada86045c
prerequisite-patch-id: a5426596293ad72222b40b165208718ac360f076
prerequisite-patch-id: 3d69d13f9f454733518329cf6c570dd3ad4e8ec4
prerequisite-patch-id: 9359f1cfb68b8f2c251db5c79cacd696ab7a61c7
prerequisite-patch-id: e3c63b7b5415c0defbb04b6332d7fe9c0f9f92d1
prerequisite-patch-id: 6820bafc717331edb240b9c5d0e6ea9b56f0d268
prerequisite-patch-id: 819a40d73fd85f0abbb6de717702cc350a638812
prerequisite-patch-id: 389cfca519329cbc85ed6cf9e4f19457584e7113
prerequisite-patch-id: 93ae07255880b16be653369b88ac4bab01531de4
prerequisite-patch-id: c4ae064694c171c4709e0bbbce7dcae9a3ed3640
prerequisite-patch-id: 8e3e598481b5985c08e5e0b47064b517b7303ec8
prerequisite-patch-id: 01933610286e38850935f6832db66bc68ce867d9
prerequisite-patch-id: c46d5e95188b94c38b0effb5eacbe9d645c88625
prerequisite-patch-id: 9f7f301a7e1617f3edd6bfaa89e99b33924a6041
prerequisite-patch-id: ca097b601f748da69c706eaf70ca94e66cd80494
prerequisite-patch-id: fb9f6159a1e6de7c5866068731156d459ad33b62
prerequisite-patch-id: 4f42d2dc345f4e5d534be7cf491a6955f06d9ebe
prerequisite-patch-id: 52a3ecab13d8feacab75727f9a09d5ab108d1a23
prerequisite-patch-id: 25b017882ab15f59a8b2c1613ab321795a17dde9
prerequisite-patch-id: 6d7299f9a81a7a93e47b38c00e0b1d924ce8b687
prerequisite-patch-id: d192b54857d9029fa7f88dae85aa4a3b5163c332
prerequisite-patch-id: 92919e6803391635e63c33196c2a13eaf8ebc283
prerequisite-patch-id: ed7ba0aab3ec834bcfbfd67281392e49d9cf67a5
prerequisite-patch-id: 82406c3bc8cfee6acc8c8079015070f283fe79e3
prerequisite-patch-id: a59d1f2dc396fb7a2d1b4d51d83b4f77659fd9c7
prerequisite-patch-id: 8fefac2b53befd391dff2c96f4c6a3699a3060d5
prerequisite-patch-id: 9ddab69dc4619551f7334fe4b400e592ed4393a7
prerequisite-patch-id: 0deaa2b9c7bc444b22053af11b234ca4ccf16399
prerequisite-patch-id: e0a866813a66138498944da75bdad86f596bdb7c
prerequisite-patch-id: 62736ca29e36894d18f65532cc28cfdc7336846c
prerequisite-patch-id: b586f071a3faa5dcab26a252e9e378ff7e9a0687
prerequisite-patch-id: 1812d030ccb0890fb5aa1f9397ed82fb21479825
prerequisite-patch-id: 31dd5fb7a5b242e8263d570162db341147211da6
prerequisite-patch-id: 3883ed174c39f0fc7931f50c71f2060504ff462a
prerequisite-patch-id: e90161d1e23ff002d4f2d857e596ba65eec483d8
prerequisite-patch-id: 61d34657ffbd7381cbde53c679129dc255a42ef9
prerequisite-patch-id: f17d9fa7c863667737420d2541bcec4537515e8b
prerequisite-patch-id: ff994a1d3e932e75eb88747bc1933690da835dba
prerequisite-patch-id: f3b5d769de6ad0adf1b416f0a6f0a2bbaf7ed223
prerequisite-patch-id: b646681f04f59b46dea1f7c6d4344578e0bd26ee
prerequisite-patch-id: 96aa449e0b10733f455552f96c3665cc52a2d8da
prerequisite-patch-id: b21ad691e53f0c96b6412e176413f904f5c8f46e
prerequisite-patch-id: 28a9474b4f516613c1e73504b44bb0716505bff1
prerequisite-patch-id: 7c7d301e9827ddb4bbd5054e4d227e02561c4cf2
prerequisite-patch-id: 0801807425306d34c12e0718fd67973092e84b56
prerequisite-patch-id: c059905a50861b9c0e0c3c0359db4847c6bb3386
prerequisite-patch-id: abb0c728d67f1e57a87d5cbfec93bb77b4a766c2
prerequisite-patch-id: 823fb528dee836deec3c5154a23167d773f4bbb3
prerequisite-patch-id: 11a7b07fbbbb45cbdea63321fa5657a3037a69b8
prerequisite-patch-id: 1900015cfa7370761c371d243038caa8e0576d05
prerequisite-patch-id: b724fddb5e4f81644384296be36f695c48d866df
prerequisite-patch-id: ab85ac4bd58ecfcc65ce6b003a48530172040ddb
prerequisite-patch-id: 653a88a96f1c8bf90f82e4d0ee5828e8e417ca69
prerequisite-patch-id: ecd314828713060dbe48b00d6962adcf58a4d419
prerequisite-patch-id: 833f9bd5e73f7119d93de182c39dfb96fd6b7863
prerequisite-patch-id: 00bc17f527ee712025e18cdc5469de2b59a04fcd
prerequisite-patch-id: 4015e7d087d5f7b9248fe4c8b0a28a05c3af1c02
prerequisite-patch-id: 8d82f9e6e183647a0bf71e23815e2941e44a3f2b
prerequisite-patch-id: 6474ef2249845b7bfafc6165e31a1de6c9dfcf18
prerequisite-patch-id: 532fa26ec1e1eddead55a04e7dd81d336434cec6
prerequisite-patch-id: d0c7f0a3c9c701c752390e7f8874b831a51b4721
prerequisite-patch-id: 5e832cefe1aa9bfe819544fb306c6b23c2c9e7f0
prerequisite-patch-id: d66e51cdcff3ede7b23d5091984a1aade854ac98
prerequisite-patch-
This message was truncated. Download the full message here.