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"))
|
||||
@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
|
||||
@subsection Writing Channel News
|
||||
|
||||
|
|
|
@ -182,12 +182,13 @@ introduction, add it."
|
|||
(checkout channel-instance-checkout))
|
||||
|
||||
(define-record-type <channel-metadata>
|
||||
(channel-metadata directory dependencies news-file keyring-reference)
|
||||
(channel-metadata directory dependencies news-file keyring-reference url)
|
||||
channel-metadata?
|
||||
(directory channel-metadata-directory) ;string with leading slash
|
||||
(dependencies channel-metadata-dependencies) ;list of <channel>
|
||||
(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
|
||||
;; 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))
|
||||
(dependencies (or (assoc-ref properties 'dependencies) '()))
|
||||
(news-file (and=> (assoc-ref properties 'news-file) first))
|
||||
(url (and=> (assoc-ref properties 'url) first))
|
||||
(keyring-reference
|
||||
(or (and=> (assoc-ref properties 'keyring-reference) first)
|
||||
%default-keyring-reference)))
|
||||
|
@ -229,7 +231,8 @@ if valid metadata could not be read from PORT."
|
|||
(commit (get 'commit))))))
|
||||
dependencies)
|
||||
news-file
|
||||
keyring-reference)))
|
||||
keyring-reference
|
||||
url)))
|
||||
((and ('channel ('version version) _ ...) sexp)
|
||||
(raise (condition
|
||||
(&message (message "unsupported '.guix-channel' version"))
|
||||
|
@ -253,7 +256,7 @@ doesn't exist."
|
|||
read-channel-metadata))
|
||||
(lambda args
|
||||
(if (= ENOENT (system-error-errno args))
|
||||
(channel-metadata "/" '() #f %default-keyring-reference)
|
||||
(channel-metadata "/" '() #f %default-keyring-reference #f)
|
||||
(apply throw args)))))
|
||||
|
||||
(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
|
||||
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
|
||||
#:key
|
||||
(current-channels '())
|
||||
|
@ -518,6 +526,19 @@ depending on the policy it implements."
|
|||
validate-pull
|
||||
#:starting-commit
|
||||
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)
|
||||
(loop (channel-instance-dependencies instance)
|
||||
|
|
Reference in New Issue