From bd8b9f951cdcba9eaab6e614ba5f0927176b2600 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 12 May 2019 09:32:58 +0100 Subject: Fix extension handling a bit more Previously, it was spliting versions up for the package pages. To stop this, now it just matches the extensions it knows about (currently .html and .json). --- guix-data-service/web/util.scm | 54 +++++++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 24 deletions(-) diff --git a/guix-data-service/web/util.scm b/guix-data-service/web/util.scm index 3792389..108c9ec 100644 --- a/guix-data-service/web/util.scm +++ b/guix-data-service/web/util.scm @@ -46,37 +46,43 @@ '(("json" . application/json) ("html" . text/html))) + (define (ends-with-recognised-extension? path) + (any (lambda (extension) + (string-suffix? (string-append "." extension) + path)) + (map car extensions-to-mime-types))) + (match (split-and-decode-uri-path (uri-path (request-uri request))) (() (values '() (or (request-accept request) (list 'text/html)))) ((single-component) - (match (string-split single-component #\.) - ((part) - (values (list single-component) - (or (request-accept request) - (list 'text/html)))) - ((first-parts ... extension) - (values (list (string-join first-parts ".")) - (or (cons - (or (assoc-ref extensions-to-mime-types extension) - 'text/html) - (request-accept request))))))) + (if (ends-with-recognised-extension? single-component) + (match (string-split single-component #\.) + ((first-parts ... extension) + (values (list (string-join first-parts ".")) + (or (cons + (assoc-ref extensions-to-mime-types extension) + (or (request-accept request) + (list 'text/html))))))) + (values (list single-component) + (or (request-accept request) + (list 'text/html))))) ((first-components ... last-component) - (match (string-split last-component #\.) - ((part) - (values (append first-components - (list part)) - (or (request-accept request) - (list 'text/html)))) - ((first-parts ... extension) - (values (append first-components - (list (string-join first-parts "."))) - (or (cons - (or (assoc-ref extensions-to-mime-types extension) - 'text/html) - (request-accept request))))))))) + (if (ends-with-recognised-extension? last-component) + (match (string-split last-component #\.) + ((first-parts ... extension) + (values (append first-components + (list (string-join first-parts "."))) + (or (cons + (assoc-ref extensions-to-mime-types extension) + (or (request-accept request) + (list 'text/html))))))) + (values (append first-components + (list last-component)) + (or (request-accept request) + (list 'text/html))))))) (define (file-extension file-name) (last (string-split file-name #\.))) -- cgit v1.2.3