diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-05-12 09:32:58 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-05-12 09:32:58 +0100 |
| commit | bd8b9f951cdcba9eaab6e614ba5f0927176b2600 (patch) | |
| tree | 36383257a392e700d251869c3b5152b4e1311f7d /guix-data-service | |
| parent | b15c8f706e5d31ed410fc285815f6c292b005a6e (diff) | |
| download | data-service-bd8b9f951cdcba9eaab6e614ba5f0927176b2600.tar data-service-bd8b9f951cdcba9eaab6e614ba5f0927176b2600.tar.gz | |
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).
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/web/util.scm | 54 |
1 files 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 #\.))) |