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.

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)))