From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:60083) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hnWoo-0006Ed-RA for guix-patches@gnu.org; Tue, 16 Jul 2019 19:25:12 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hnWok-0002hv-Kw for guix-patches@gnu.org; Tue, 16 Jul 2019 19:25:10 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:42487) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hnWoh-0002gv-Rq for guix-patches@gnu.org; Tue, 16 Jul 2019 19:25:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hnWoh-0003V1-Ml for guix-patches@gnu.org; Tue, 16 Jul 2019 19:25:03 -0400 Subject: [bug#36699] [PATCH 4/4] channels: Reject directories with '..' in '.guix-channel' file. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Wed, 17 Jul 2019 01:24:33 +0200 Message-Id: <20190716232433.16789-4-ludo@gnu.org> In-Reply-To: <20190716232433.16789-1-ludo@gnu.org> References: <20190716232433.16789-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 36699@debbugs.gnu.org * 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 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