channels: Warn when pulling from a mirror.
* guix/channels.scm (<channel-metadata>)[url]: New field. (read-channel-metadata): Initialize it. (read-channel-metadata-from-source): Likewise. (channel-instance-primary-url): New procedure. (latest-channel-instances): Compare CHANNEL's URL against it. * doc/guix.texi (Channels)[Primary URL]: New subsection.master
parent
cb8c698e8d
commit
4ae762af76
|
@ -4153,6 +4153,28 @@ add a meta-data file @file{.guix-channel} that contains:
|
||||||
(directory "guix"))
|
(directory "guix"))
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
|
@cindex primary URL, channels
|
||||||
|
@subsection Primary URL
|
||||||
|
|
||||||
|
Channel authors can indicate the primary URL of their channel's Git
|
||||||
|
repository in the @file{.guix-channel} file, like so:
|
||||||
|
|
||||||
|
@lisp
|
||||||
|
(channel
|
||||||
|
(version 0)
|
||||||
|
(url "https://example.org/guix.git"))
|
||||||
|
@end lisp
|
||||||
|
|
||||||
|
This allows @command{guix pull} to determine whether it is pulling code
|
||||||
|
from a mirror of the channel; when that is the case, it warns the user
|
||||||
|
that the mirror might be stale and displays the primary URL. That way,
|
||||||
|
users cannot be tricked into fetching code from a stale mirror that does
|
||||||
|
not receive security updates.
|
||||||
|
|
||||||
|
This feature only makes sense for authenticated repositories, such as
|
||||||
|
the official @code{guix} channel, for which @command{guix pull} ensures
|
||||||
|
the code it fetches is authentic.
|
||||||
|
|
||||||
@cindex news, for channels
|
@cindex news, for channels
|
||||||
@subsection Writing Channel News
|
@subsection Writing Channel News
|
||||||
|
|
||||||
|
|
|
@ -182,12 +182,13 @@ introduction, add it."
|
||||||
(checkout channel-instance-checkout))
|
(checkout channel-instance-checkout))
|
||||||
|
|
||||||
(define-record-type <channel-metadata>
|
(define-record-type <channel-metadata>
|
||||||
(channel-metadata directory dependencies news-file keyring-reference)
|
(channel-metadata directory dependencies news-file keyring-reference url)
|
||||||
channel-metadata?
|
channel-metadata?
|
||||||
(directory channel-metadata-directory) ;string with leading slash
|
(directory channel-metadata-directory) ;string with leading slash
|
||||||
(dependencies channel-metadata-dependencies) ;list of <channel>
|
(dependencies channel-metadata-dependencies) ;list of <channel>
|
||||||
(news-file channel-metadata-news-file) ;string | #f
|
(news-file channel-metadata-news-file) ;string | #f
|
||||||
(keyring-reference channel-metadata-keyring-reference)) ;string
|
(keyring-reference channel-metadata-keyring-reference) ;string
|
||||||
|
(url channel-metadata-url)) ;string | #f
|
||||||
|
|
||||||
(define %default-keyring-reference
|
(define %default-keyring-reference
|
||||||
;; Default value of the 'keyring-reference' field.
|
;; Default value of the 'keyring-reference' field.
|
||||||
|
@ -209,6 +210,7 @@ if valid metadata could not be read from PORT."
|
||||||
(let ((directory (and=> (assoc-ref properties 'directory) first))
|
(let ((directory (and=> (assoc-ref properties 'directory) first))
|
||||||
(dependencies (or (assoc-ref properties 'dependencies) '()))
|
(dependencies (or (assoc-ref properties 'dependencies) '()))
|
||||||
(news-file (and=> (assoc-ref properties 'news-file) first))
|
(news-file (and=> (assoc-ref properties 'news-file) first))
|
||||||
|
(url (and=> (assoc-ref properties 'url) first))
|
||||||
(keyring-reference
|
(keyring-reference
|
||||||
(or (and=> (assoc-ref properties 'keyring-reference) first)
|
(or (and=> (assoc-ref properties 'keyring-reference) first)
|
||||||
%default-keyring-reference)))
|
%default-keyring-reference)))
|
||||||
|
@ -229,7 +231,8 @@ if valid metadata could not be read from PORT."
|
||||||
(commit (get 'commit))))))
|
(commit (get 'commit))))))
|
||||||
dependencies)
|
dependencies)
|
||||||
news-file
|
news-file
|
||||||
keyring-reference)))
|
keyring-reference
|
||||||
|
url)))
|
||||||
((and ('channel ('version version) _ ...) sexp)
|
((and ('channel ('version version) _ ...) sexp)
|
||||||
(raise (condition
|
(raise (condition
|
||||||
(&message (message "unsupported '.guix-channel' version"))
|
(&message (message "unsupported '.guix-channel' version"))
|
||||||
|
@ -253,7 +256,7 @@ doesn't exist."
|
||||||
read-channel-metadata))
|
read-channel-metadata))
|
||||||
(lambda args
|
(lambda args
|
||||||
(if (= ENOENT (system-error-errno args))
|
(if (= ENOENT (system-error-errno args))
|
||||||
(channel-metadata "/" '() #f %default-keyring-reference)
|
(channel-metadata "/" '() #f %default-keyring-reference #f)
|
||||||
(apply throw args)))))
|
(apply throw args)))))
|
||||||
|
|
||||||
(define (channel-instance-metadata instance)
|
(define (channel-instance-metadata instance)
|
||||||
|
@ -463,6 +466,11 @@ 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
|
getting the latest updates. If you think this is not the case, explicitly
|
||||||
allow non-forward updates."))))))))))
|
allow non-forward updates."))))))))))
|
||||||
|
|
||||||
|
(define (channel-instance-primary-url instance)
|
||||||
|
"Return the primary URL advertised for INSTANCE, or #f if there is no such
|
||||||
|
information."
|
||||||
|
(channel-metadata-url (channel-instance-metadata instance)))
|
||||||
|
|
||||||
(define* (latest-channel-instances store channels
|
(define* (latest-channel-instances store channels
|
||||||
#:key
|
#:key
|
||||||
(current-channels '())
|
(current-channels '())
|
||||||
|
@ -518,6 +526,19 @@ depending on the policy it implements."
|
||||||
validate-pull
|
validate-pull
|
||||||
#:starting-commit
|
#:starting-commit
|
||||||
current)))
|
current)))
|
||||||
|
(when authenticate?
|
||||||
|
;; CHANNEL is authenticated so we can trust the
|
||||||
|
;; primary URL advertised in its metadata and warn
|
||||||
|
;; about possibly stale mirrors.
|
||||||
|
(let ((primary-url (channel-instance-primary-url
|
||||||
|
instance)))
|
||||||
|
(unless (or (not primary-url)
|
||||||
|
(channel-commit channel)
|
||||||
|
(string=? primary-url (channel-url channel)))
|
||||||
|
(warning (G_ "pulled channel '~a' from a mirror \
|
||||||
|
of ~a, which might be stale~%")
|
||||||
|
(channel-name channel)
|
||||||
|
primary-url))))
|
||||||
|
|
||||||
(let-values (((new-instances new-channels)
|
(let-values (((new-instances new-channels)
|
||||||
(loop (channel-instance-dependencies instance)
|
(loop (channel-instance-dependencies instance)
|
||||||
|
|
Reference in New Issue