From b6312c84a0d6b65a98f4c5df4df40ed102db16fe Mon Sep 17 00:00:00 2001 From: Rostislav Svoboda Date: Wed, 10 Apr 2024 19:36:33 +0200 Subject: pull: Add fine-grained control for `guix pull --allow-downgrades`. 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. * test/channels.scm (latest-channel-instances validate-pull): Adopt latest-channel-instances signature change. * guix/inferior.scm (cached-channel-instance): Adopt latest-channel-instances signature change. * guix/scripts/time-machine.scm (guix-time-machine): Adopt latest-channel-instances signature change. (%reference-channels): compute JIT Change-Id: If947a2453c520463d77da9591af9ac03e6472afc --- doc/guix.texi | 21 ++++++---- guix/channels.scm | 67 +++++++++++++++++--------------- guix/inferior.scm | 17 ++++----- guix/scripts/pull.scm | 89 +++++++++++++++++++++++++++++++++++++------ guix/scripts/time-machine.scm | 17 ++++----- tests/channels.scm | 8 ++-- 6 files changed, 146 insertions(+), 73 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index fc28a15980..8c4dcee63e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4565,15 +4565,22 @@ 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. +@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 51024dcad4..58b1d7bdb1 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -497,26 +497,35 @@ information." (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 @@ depending on the policy it implements." (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,18 +1012,14 @@ channel instances." (define* (latest-channel-derivation #:optional (channels %default-channels) #:key - (current-channels '()) - (validate-pull - ensure-forward-channel-update)) + (channel-validation-pairs '())) "Return as a monadic value the derivation that builds the profile for the 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-validation-pairs + channel-validation-pairs))) (channel-instances->derivation instances))) (define* (sexp->channel sexp #:optional (name 'channel)) diff --git a/guix/inferior.scm b/guix/inferior.scm index 190ba01b3c..3be9028afb 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -872,17 +872,16 @@ prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip." (authenticate? #t) (cache-directory (%inferior-cache-directory)) (ttl (* 3600 24 30)) - (reference-channels '()) - (validate-channels (const #t))) + (channel-validation-pairs '())) "Return a directory containing a guix filetree defined by CHANNELS, a list of channels. The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. This procedure opens a new connection to the build daemon. AUTHENTICATE? determines whether CHANNELS are authenticated. -VALIDATE-CHANNELS must be a four-argument procedure used to validate channel -instances against REFERENCE-CHANNELS; it is passed as #:validate-pull to -'latest-channel-instances' and should raise an exception in case a target -channel commit is deemed \"invalid\"." +CHANNEL-VALIDATION-PAIRS must be a list of pairs (channel . validation-pull) where +validation-pull is a four-argument procedure used to validate corresponding channel +instance. This procedure 'latest-channel-instances' and should raise an exception in +case a target channel commit is deemed \"invalid\"." (define commits ;; Since computing the instances of CHANNELS is I/O-intensive, use a ;; cheaper way to get the commit list of CHANNELS. This limits overhead @@ -935,10 +934,8 @@ channel commit is deemed \"invalid\"." -> (latest-channel-instances store channels #:authenticate? authenticate? - #:current-channels - reference-channels - #:validate-pull - validate-channels)) + #:channel-validation-pairs + channel-validation-pairs)) (profile (channel-instances->derivation instances))) (mbegin %store-monad diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 58d3cd7e83..b79a4a0c95 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -76,8 +76,7 @@ (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 @@ Download and deploy the latest version of Guix.\n")) (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 @@ 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 + (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 @@ Use '~/.config/guix/channels.scm' instead.")) @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 + validate-pull 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 . #) + (channel2 . #))" + (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 @@ Use '~/.config/guix/channels.scm' instead.")) (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 @@ Use '~/.config/guix/channels.scm' instead.")) (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) diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index d9ce85df84..139dff9e83 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -149,10 +149,6 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (define %oldest-possible-commit "4a0b87f0ec5b6c2dcf82b372dd20ca7ea6acdd9c") ;v0.16.0 -(define %reference-channels - (list (channel (inherit %default-guix-channel) - (commit %oldest-possible-commit)))) - (define (validate-guix-channel channel start commit relation) "Raise an error if CHANNEL is the 'guix' channel and the RELATION of COMMIT to %OLDEST-POSSIBLE-COMMIT is not that of an ancestor." @@ -180,7 +176,12 @@ to %OLDEST-POSSIBLE-COMMIT is not that of an ancestor." (substitutes? (assoc-ref opts 'substitutes?)) (authenticate? (assoc-ref opts 'authenticate-channels?))) (if command-line - (let* ((directory + (let* ((channel-validation-pairs + (list (cons (channel (inherit %default-guix-channel) + (commit %oldest-possible-commit)) + validate-guix-channel))) + + (directory (with-store store (with-status-verbosity (assoc-ref opts 'verbosity) (with-build-handler (build-notifier #:use-substitutes? @@ -191,10 +192,8 @@ to %OLDEST-POSSIBLE-COMMIT is not that of an ancestor." (set-build-options-from-command-line store opts) (cached-channel-instance store channels #:authenticate? authenticate? - #:reference-channels - %reference-channels - #:validate-channels - validate-guix-channel))))) + #:channel-validation-pairs + channel-validation-pairs))))) (executable (string-append directory "/bin/guix"))) (apply execl (cons* executable executable command-line))) (warning (G_ "no command specified; nothing to do~%"))))))) diff --git a/tests/channels.scm b/tests/channels.scm index c56e4e6a71..1bb85dd3e8 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -245,10 +245,8 @@ (string=? (channel-instance-commit instance1) (channel-instance-commit instance2))))))))))) -(test-equal "latest-channel-instances #:validate-pull" +(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") @@ -275,8 +273,8 @@ (with-store store ;; Attempt a downgrade from NEW to OLD. (latest-channel-instances store (list old) - #:current-channels (list new) - #:validate-pull validate-pull))))))) + #:channel-validation-pairs + (list (cons new validate-pull))))))))) (test-assert "channel-instances->manifest" ;; Compute the manifest for a graph of instances and make sure we get a -- cgit v1.2.3