diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-07-17 00:04:41 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-07-19 11:53:47 +0200 |
commit | 45b903323e0fecb7947926d2c14103d47fea624a (patch) | |
tree | b53dd88f3584004144ecd247b32eed0242509830 /guix/channels.scm | |
parent | bacfec8611530dc3e849fb804b51f50b299796f0 (diff) | |
download | patches-45b903323e0fecb7947926d2c14103d47fea624a.tar patches-45b903323e0fecb7947926d2c14103d47fea624a.tar.gz |
channels: Strictly check the version of '.guix-channel'.
Until now the 'version' field in '.guix-channel' could be omitted, or it
could be any value.
* guix/channels.scm (read-channel-metadata): Rename to...
(channel-instance-metadata): ... this.
(channel-instance-dependencies): Adjust accordingly.
(read-channel-metadata): New procedure. Use 'match'
to require a 'version' field. Provide proper error handling when the
channel sexp is malformed or when given an unsupported version number.
(read-channel-metadata-from-source): Use 'catch' and
'system-error-errno' instead of 'file-exists?'.
* tests/channels.scm (instance--unsupported-version): New variable.
(read-channel-metadata): Rename to...
(channel-instance-metadata): ... this. Rename tests accordingly.
("channel-instance-metadata rejects unsupported version"): New test.
Diffstat (limited to 'guix/channels.scm')
-rw-r--r-- | guix/channels.scm | 71 |
1 files changed, 47 insertions, 24 deletions
diff --git a/guix/channels.scm b/guix/channels.scm index bfe6963418..e92148abf2 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -121,32 +121,55 @@ (#f `(branch . ,(channel-branch channel))) (commit `(commit . ,(channel-commit channel))))) +(define (read-channel-metadata port) + "Read from PORT channel metadata in the format expected for the +'.guix-channel' file. Return a <channel-metadata> record, or raise an error +if valid metadata could not be read from PORT." + (match (read port) + (('channel ('version 0) properties ...) + (let ((directory (and=> (assoc-ref properties 'directory) first)) + (dependencies (or (assoc-ref properties 'dependencies) '()))) + (channel-metadata + version + directory + (map (lambda (item) + (let ((get (lambda* (key #:optional default) + (or (and=> (assoc-ref item key) first) default)))) + (and-let* ((name (get 'name)) + (url (get 'url)) + (branch (get 'branch "master"))) + (channel + (name name) + (branch branch) + (url url) + (commit (get 'commit)))))) + dependencies)))) + ((and ('channel ('version version) _ ...) sexp) + (raise (condition + (&message (message "unsupported '.guix-channel' version")) + (&error-location + (location (source-properties->location + (source-properties sexp))))))) + (sexp + (raise (condition + (&message (message "invalid '.guix-channel' file")) + (&error-location + (location (source-properties->location + (source-properties sexp))))))))) + (define (read-channel-metadata-from-source source) "Return a channel-metadata record read from channel's SOURCE/.guix-channel description file, or return #F if SOURCE/.guix-channel does not exist." - (let ((meta-file (string-append source "/.guix-channel"))) - (and (file-exists? meta-file) - (let* ((raw (call-with-input-file meta-file read)) - (version (and=> (assoc-ref raw 'version) first)) - (directory (and=> (assoc-ref raw 'directory) first)) - (dependencies (or (assoc-ref raw 'dependencies) '()))) - (channel-metadata - version - directory - (map (lambda (item) - (let ((get (lambda* (key #:optional default) - (or (and=> (assoc-ref item key) first) default)))) - (and-let* ((name (get 'name)) - (url (get 'url)) - (branch (get 'branch "master"))) - (channel - (name name) - (branch branch) - (url url) - (commit (get 'commit)))))) - dependencies)))))) - -(define (read-channel-metadata instance) + (catch 'system-error + (lambda () + (call-with-input-file (string-append source "/.guix-channel") + read-channel-metadata)) + (lambda args + (if (= ENOENT (system-error-errno args)) + #f + (apply throw args))))) + +(define (channel-instance-metadata instance) "Return a channel-metadata record read from the channel INSTANCE's description file, or return #F if the channel instance does not include the file." @@ -155,7 +178,7 @@ file." (define (channel-instance-dependencies instance) "Return the list of channels that are declared as dependencies for the given channel INSTANCE." - (match (read-channel-metadata instance) + (match (channel-instance-metadata instance) (#f '()) (($ <channel-metadata> version directory dependencies) dependencies))) |