[bug#36699] [PATCH 0/4] Strengthen '.guix-channel' file handling

[bug#36699] [PATCH 0/4] Strengthen '.guix-channel' file handling

[Ludovic Courtès]

Hello Guix,

These patches change ‘.guix-channel’ parsing and handling following
the same pattern as <manifest>/read-manifest/profile-manifest and
other places where we deal with serialized data structures.

The last patch addresses a potential security issue with the
‘directory’ field of ‘.guix-channel’ that hadn’t occurred to me
while reviewing it.

Thoughts?

Ludo’.

Ludovic Courtès (4):
  channels: Strictly check the version of '.guix-channel'.
  channels: Remove unneeded 'version' field of <channel-metadata>.
  channels: Always provide a <channel-metadata> record.
  channels: Reject directories with '..' in '.guix-channel' file.

 guix/channels.scm  | 102 +++++++++++++++++++++++++++++----------------
 tests/channels.scm |  81 +++++++++++++++++++++++++----------
 2 files changed, 124 insertions(+), 59 deletions(-)

-- 
2.22.0

[bug#36699] [PATCH 1/4] channels: Strictly check the version of '.guix-channel'.

[Ludovic Courtès]

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.
---
 guix/channels.scm  | 69 ++++++++++++++++++++++++++++++----------------
 tests/channels.scm | 29 +++++++++++++------
 2 files changed, 67 insertions(+), 31 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))))))
+  (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 (read-channel-metadata instance)
+(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)))
diff --git a/tests/channels.scm b/tests/channels.scm
index 8540aef435..1f1357fca7 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -26,8 +26,12 @@
   #:use-module (guix derivations)
   #:use-module (guix sets)
   #:use-module (guix gexp)
+  #:use-module ((guix utils)
+                #:select (error-location? error-location location-line))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 match))
 
@@ -46,6 +50,9 @@
                               #:name name))
 
 (define instance--boring (make-instance))
+(define instance--unsupported-version
+  (make-instance #:spec
+                 '(channel (version 42) (dependencies whatever))))
 (define instance--no-deps
   (make-instance #:spec
                  '(channel
@@ -78,24 +85,30 @@
                      (name test-channel)
                      (url "https://example.com/test-channel-elsewhere"))))))
 
-(define read-channel-metadata
-  (@@ (guix channels) read-channel-metadata))
+(define channel-instance-metadata
+  (@@ (guix channels) channel-instance-metadata))
 
 \f
-(test-equal "read-channel-metadata returns #f if .guix-channel does not exist"
+(test-equal "channel-instance-metadata returns #f if .guix-channel does not exist"
   #f
-  (read-channel-metadata instance--boring))
+  (channel-instance-metadata instance--boring))
 
-(test-assert "read-channel-metadata returns <channel-metadata>"
+(test-equal "channel-instance-metadata rejects unsupported version"
+  1                              ;line number in the generated '.guix-channel'
+  (guard (c ((and (message-condition? c) (error-location? c))
+             (location-line (error-location c))))
+    (channel-instance-metadata instance--unsupported-version)))
+
+(test-assert "channel-instance-metadata returns <channel-metadata>"
   (every (@@ (guix channels) channel-metadata?)
-         (map read-channel-metadata
+         (map channel-instance-metadata
               (list instance--no-deps
                     instance--simple
                     instance--with-dupes))))
 
-(test-assert "read-channel-metadata dependencies are channels"
+(test-assert "channel-instance-metadata dependencies are channels"
   (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
-               (read-channel-metadata instance--simple))))
+               (channel-instance-metadata instance--simple))))
     (match deps
       (((? channel? dep)) #t)
       (_ #f))))
-- 
2.22.0

[bug#36699] [PATCH 2/4] channels: Remove unneeded 'version' field of <channel-metadata>.

[Ludovic Courtès]

The idea is that 'read-channel-metadata' will take care of converting
possibly older versions to the current data type.  Thus, storing the
version number is unnecessary.

* guix/channels.scm (<channel-metadata>)[version]: Remove.
(read-channel-metadata, channel-instance-dependencies): Adjust
accordingly.
---
 guix/channels.scm | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index e92148abf2..87ad729a70 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -108,9 +108,8 @@
   (checkout  channel-instance-checkout))
 
 (define-record-type <channel-metadata>
-  (channel-metadata version directory dependencies)
+  (channel-metadata directory dependencies)
   channel-metadata?
-  (version       channel-metadata-version)
   (directory     channel-metadata-directory)
   (dependencies  channel-metadata-dependencies))
 
@@ -130,7 +129,6 @@ if valid metadata could not be read from PORT."
      (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)
@@ -180,7 +178,7 @@ file."
 channel INSTANCE."
   (match (channel-instance-metadata instance)
     (#f '())
-    (($ <channel-metadata> version directory dependencies)
+    (($ <channel-metadata> directory dependencies)
      dependencies)))
 
 (define* (latest-channel-instances store channels #:optional (previous-channels '()))
-- 
2.22.0

[bug#36699] [PATCH 3/4] channels: Always provide a <channel-metadata> record.

[Ludovic Courtès]

This simplifies the code since one no longer needs to think about
whether '.guix-channel' was present.

* guix/channels.scm (read-channel-metadata): Always pass a string as the
first argument to 'channel-metadata'.
(read-channel-metadata-from-source): Always return a <channel-metadata>
record.
(channel-instance-dependencies): Remove now unneeded 'match'.
(standard-module-derivation): Assume DIRECTORY is never #f and contains
a leading slash.
* tests/channels.scm (channel-metadata-directory)
(channel-metadata-dependencies): New procedures.
("channel-instance-metadata returns #f if .guix-channel does not
exist"): Remove.
("channel-instance-metadata returns default if .guix-channel does not
exist"): New test.
(make-instance): Use 'write' instead of 'display' when creating
'.guix-channel'.
(instance--no-deps): Remove dependencies.
(instance--sub-directory): New variable.
("channel-instance-metadata and default dependencies")
("channel-instance-metadata and directory"): New tests.
("latest-channel-instances excludes duplicate channel dependencies"):
Expect 'channel-commit' to return a string and adjust accordingly.
---
 guix/channels.scm  | 27 ++++++++++++---------------
 tests/channels.scm | 45 +++++++++++++++++++++++++++++----------------
 2 files changed, 41 insertions(+), 31 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 87ad729a70..415246cbd1 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -110,8 +110,8 @@
 (define-record-type <channel-metadata>
   (channel-metadata directory dependencies)
   channel-metadata?
-  (directory     channel-metadata-directory)
-  (dependencies  channel-metadata-dependencies))
+  (directory     channel-metadata-directory)      ;string with leading slash
+  (dependencies  channel-metadata-dependencies))  ;list of <channel>
 
 (define (channel-reference channel)
   "Return the \"reference\" for CHANNEL, an sexp suitable for
@@ -129,7 +129,9 @@ if valid metadata could not be read from PORT."
      (let ((directory    (and=> (assoc-ref properties 'directory) first))
            (dependencies (or (assoc-ref properties 'dependencies) '())))
        (channel-metadata
-        directory
+        (cond ((not directory) "/")
+              ((string-prefix? "/" directory) directory)
+              (else (string-append "/" directory)))
         (map (lambda (item)
                (let ((get (lambda* (key #:optional default)
                             (or (and=> (assoc-ref item key) first) default))))
@@ -157,29 +159,26 @@ if valid metadata could not be read from PORT."
 
 (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."
+description file, or return the default channel-metadata record if that file
+doesn't exist."
   (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
+          (channel-metadata "/" '())
           (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."
+description file or its default value."
   (read-channel-metadata-from-source (channel-instance-checkout instance)))
 
 (define (channel-instance-dependencies instance)
   "Return the list of channels that are declared as dependencies for the given
 channel INSTANCE."
-  (match (channel-instance-metadata instance)
-    (#f '())
-    (($ <channel-metadata> directory dependencies)
-     dependencies)))
+  (channel-metadata-dependencies (channel-instance-metadata instance)))
 
 (define* (latest-channel-instances store channels #:optional (previous-channels '()))
   "Return a list of channel instances corresponding to the latest checkouts of
@@ -261,7 +260,7 @@ objects.  The assumption is that SOURCE contains package modules to be added
 to '%package-module-path'."
 
   (let* ((metadata (read-channel-metadata-from-source source))
-         (directory (and=> metadata channel-metadata-directory)))
+         (directory (channel-metadata-directory metadata)))
 
     (define build
       ;; This is code that we'll run in CORE, a Guix instance, with its own
@@ -281,9 +280,7 @@ to '%package-module-path'."
               (string-append #$output "/share/guile/site/"
                              (effective-version)))
 
-            (let* ((subdir (if #$directory
-                               (string-append "/" #$directory)
-                               ""))
+            (let* ((subdir #$directory)
                    (source (string-append #$source subdir)))
               (compile-files source go (find-files source "\\.scm$"))
               (mkdir-p (dirname scm))
diff --git a/tests/channels.scm b/tests/channels.scm
index 1f1357fca7..e83b5437d3 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -42,9 +42,9 @@
                         (commit "cafebabe")
                         (spec #f))
   (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
-  (and spec
-       (with-output-to-file (string-append instance-dir "/.guix-channel")
-         (lambda _ (format #t "~a" spec))))
+  (when spec
+    (call-with-output-file (string-append instance-dir "/.guix-channel")
+      (lambda (port) (write spec port))))
   (checkout->channel-instance instance-dir
                               #:commit commit
                               #:name name))
@@ -55,12 +55,10 @@
                  '(channel (version 42) (dependencies whatever))))
 (define instance--no-deps
   (make-instance #:spec
-                 '(channel
-                   (version 0)
-                   (dependencies
-                    (channel
-                     (name test-channel)
-                     (url "https://example.com/test-channel"))))))
+                 '(channel (version 0))))
+(define instance--sub-directory
+  (make-instance #:spec
+                 '(channel (version 0) (directory "modules"))))
 (define instance--simple
   (make-instance #:spec
                  '(channel
@@ -87,11 +85,26 @@
 
 (define channel-instance-metadata
   (@@ (guix channels) channel-instance-metadata))
+(define channel-metadata-directory
+  (@@ (guix channels) channel-metadata-directory))
+(define channel-metadata-dependencies
+  (@@ (guix channels) channel-metadata-dependencies))
 
 \f
-(test-equal "channel-instance-metadata returns #f if .guix-channel does not exist"
-  #f
-  (channel-instance-metadata instance--boring))
+(test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
+  '("/" ())
+  (let ((metadata (channel-instance-metadata instance--boring)))
+    (list (channel-metadata-directory metadata)
+          (channel-metadata-dependencies metadata))))
+
+(test-equal "channel-instance-metadata and default dependencies"
+  '()
+  (channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
+
+(test-equal "channel-instance-metadata and directory"
+  "/modules"
+  (channel-metadata-directory
+   (channel-instance-metadata instance--sub-directory)))
 
 (test-equal "channel-instance-metadata rejects unsupported version"
   1                              ;line number in the generated '.guix-channel'
@@ -141,7 +154,7 @@
                ("test" (values test-dir 'whatever))
                (_ (values "/not-important" 'not-important)))))
           (let ((instances (latest-channel-instances #f (list channel))))
-            (and (eq? 2 (length instances))
+            (and (= 2 (length instances))
                  (lset= eq?
                         '(test test-channel)
                         (map (compose channel-name channel-instance-channel)
@@ -152,9 +165,9 @@
                          (and (eq? (channel-name
                                     (channel-instance-channel instance))
                                    'test-channel)
-                              (eq? (channel-commit
-                                    (channel-instance-channel instance))
-                                   'abc1234)))
+                              (string=? (channel-commit
+                                         (channel-instance-channel instance))
+                                        "abc1234")))
                        instances))))))
 
 (test-assert "channel-instances->manifest"
-- 
2.22.0

[bug#36699] [PATCH 4/4] channels: Reject directories with '..' in '.guix-channel' file.

[Ludovic Courtès]

* guix/channels.scm (read-channel-metadata)[sexp, location]: New
variables.
[sane-directory]: New procedure.
Call it when DIRECTORY is true.
* tests/channels.scm (instance--fishy-directory): New variable.
("channel-instance-metadata and fishy directory"): New test.
---
 guix/channels.scm  | 30 ++++++++++++++++++++----------
 tests/channels.scm | 11 +++++++++++
 2 files changed, 31 insertions(+), 10 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index 415246cbd1..641dee8dbb 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -124,14 +124,28 @@
   "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)
+  (define sexp
+    (read port))
+
+  (define location
+    (source-properties->location (source-properties sexp)))
+
+  (define (sane-directory directory)
+    ;; If DIRECTORY contains '..', raise an error; otherwise return it.
+    (when (member ".." (string-split directory #\/))
+      (raise (condition
+              (&message (message "channel sub-directory must not contain '..'"))
+              (&error-location (location location)))))
+    directory)
+
+  (match sexp
     (('channel ('version 0) properties ...)
      (let ((directory    (and=> (assoc-ref properties 'directory) first))
            (dependencies (or (assoc-ref properties 'dependencies) '())))
        (channel-metadata
         (cond ((not directory) "/")
-              ((string-prefix? "/" directory) directory)
-              (else (string-append "/" directory)))
+              ((string-prefix? "/" directory) (sane-directory directory))
+              (else (string-append "/" (sane-directory directory))))
         (map (lambda (item)
                (let ((get (lambda* (key #:optional default)
                             (or (and=> (assoc-ref item key) first) default))))
@@ -144,18 +158,14 @@ if valid metadata could not be read from PORT."
                     (url url)
                     (commit (get 'commit))))))
              dependencies))))
-    ((and ('channel ('version version) _ ...) sexp)
+    (('channel ('version version) _ ...)
      (raise (condition
              (&message (message "unsupported '.guix-channel' version"))
-             (&error-location
-              (location (source-properties->location
-                         (source-properties sexp)))))))
+             (&error-location (location location)))))
     (sexp
      (raise (condition
              (&message (message "invalid '.guix-channel' file"))
-             (&error-location
-              (location (source-properties->location
-                         (source-properties sexp)))))))))
+             (&error-location (location location)))))))
 
 (define (read-channel-metadata-from-source source)
   "Return a channel-metadata record read from channel's SOURCE/.guix-channel
diff --git a/tests/channels.scm b/tests/channels.scm
index e83b5437d3..402025dea3 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -59,6 +59,11 @@
 (define instance--sub-directory
   (make-instance #:spec
                  '(channel (version 0) (directory "modules"))))
+(define instance--fishy-directory
+  (make-instance #:spec
+                 '(channel (version 0)
+                           (directory "../../../../../etc"))))
+
 (define instance--simple
   (make-instance #:spec
                  '(channel
@@ -106,6 +111,12 @@
   (channel-metadata-directory
    (channel-instance-metadata instance--sub-directory)))
 
+(test-assert "channel-instance-metadata and fishy directory"
+  (guard (c ((and (message-condition? c) (error-location? c))
+             #t))
+    (channel-instance-metadata instance--fishy-directory)
+    #f))
+
 (test-equal "channel-instance-metadata rejects unsupported version"
   1                              ;line number in the generated '.guix-channel'
   (guard (c ((and (message-condition? c) (error-location? c))
-- 
2.22.0

[bug#36699] [PATCH 4/4] channels: Reject directories with '..' in '.guix-channel' file.

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

> +  (define (sane-directory directory)
> +    ;; If DIRECTORY contains '..', raise an error; otherwise return it.
> +    (when (member ".." (string-split directory #\/))
> +      (raise (condition
> +              (&message (message "channel sub-directory must not contain '..'"))
> +              (&error-location (location location)))))
> +    directory)

On second thought, it’s probably kind of useless since the only place
where ‘directory’ is used is in the derivation that builds the channel,
which is normally running in a chroot:

  (let* ((subdir #$directory)
         (source (string-append #$source subdir)))
    (compile-files source go (find-files source "\\.scm$"))
    (mkdir-p (dirname scm))
    (symlink (string-append #$source subdir) scm))

So I guess we can drop this patch.  Thoughts?

Ludo’.

[bug#36699] [PATCH 4/4] channels: Reject directories with '..' in '.guix-channel' file.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1578 bytes --]

Hi Ludo,

On Wed, 17 Jul 2019 01:29:39 +0200
Ludovic Courtès <ludo@gnu.org> wrote:

> Ludovic Courtès <ludo@gnu.org> skribis:
> 
> > +  (define (sane-directory directory)
> > +    ;; If DIRECTORY contains '..', raise an error; otherwise return it.
> > +    (when (member ".." (string-split directory #\/))
> > +      (raise (condition
> > +              (&message (message "channel sub-directory must not contain '..'"))
> > +              (&error-location (location location)))))
> > +    directory)  
> 
> On second thought, it’s probably kind of useless since the only place
> where ‘directory’ is used is in the derivation that builds the channel,
> which is normally running in a chroot:
> 
>   (let* ((subdir #$directory)
>          (source (string-append #$source subdir)))
>     (compile-files source go (find-files source "\\.scm$"))
>     (mkdir-p (dirname scm))
>     (symlink (string-append #$source subdir) scm))
> 
> So I guess we can drop this patch.  Thoughts?

I generally don't like weird name matching like this.  The Linux VFS can do
arbitrary things (which would complicate the situation) to the name tree.
Even now, a symlink "x" to ".." would work and not be caught.  To say nothing
of what a custom file system could do.

Why single out this one way?  It gives the illusion of security.

Containers are better indeed.

Except when the match is not for security but only for usability, then I'm
fine with it (and then it should be a warning - who knows, maybe ".." means
"current directory" in WeirdFS :->).

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#36699] [PATCH 4/4] channels: Reject directories with '..' in '.guix-channel' file.

[Ludovic Courtès]

Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> On Wed, 17 Jul 2019 01:29:39 +0200
> Ludovic Courtès <ludo@gnu.org> wrote:
>
>> Ludovic Courtès <ludo@gnu.org> skribis:
>> 
>> > +  (define (sane-directory directory)
>> > +    ;; If DIRECTORY contains '..', raise an error; otherwise return it.
>> > +    (when (member ".." (string-split directory #\/))
>> > +      (raise (condition
>> > +              (&message (message "channel sub-directory must not contain '..'"))
>> > +              (&error-location (location location)))))
>> > +    directory)  
>> 
>> On second thought, it’s probably kind of useless since the only place
>> where ‘directory’ is used is in the derivation that builds the channel,
>> which is normally running in a chroot:
>> 
>>   (let* ((subdir #$directory)
>>          (source (string-append #$source subdir)))
>>     (compile-files source go (find-files source "\\.scm$"))
>>     (mkdir-p (dirname scm))
>>     (symlink (string-append #$source subdir) scm))
>> 
>> So I guess we can drop this patch.  Thoughts?
>
> I generally don't like weird name matching like this.  The Linux VFS can do
> arbitrary things (which would complicate the situation) to the name tree.
> Even now, a symlink "x" to ".." would work and not be caught.  To say nothing
> of what a custom file system could do.
>
> Why single out this one way?  It gives the illusion of security.
>
> Containers are better indeed.

Yes, and since that’s what we have, we can forget about this patch.

I definitely agree with everything you wrote; it’s just that the kernel
Linux being what it is, one sometimes have to resort to hacks like this.
Fortunately, that was misguided here, so let’s forget about this.  :-)

Ludo’.

bug#36699: [PATCH 0/4] Strengthen '.guix-channel' file handling

[Ludovic Courtès]

Hello,

Ludovic Courtès <ludo@gnu.org> skribis:

> Ludovic Courtès (4):
>   channels: Strictly check the version of '.guix-channel'.
>   channels: Remove unneeded 'version' field of <channel-metadata>.
>   channels: Always provide a <channel-metadata> record.
>   channels: Reject directories with '..' in '.guix-channel' file.

I pushed the first three patches and discarded the last one, as
discussed with Danny.

Ludo’.