summaryrefslogtreecommitdiff
path: root/guix/channels.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-07-17 00:04:41 +0200
committerLudovic Courtès <ludo@gnu.org>2019-07-19 11:53:47 +0200
commit45b903323e0fecb7947926d2c14103d47fea624a (patch)
treeb53dd88f3584004144ecd247b32eed0242509830 /guix/channels.scm
parentbacfec8611530dc3e849fb804b51f50b299796f0 (diff)
downloadpatches-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.scm71
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)))