serve: Fix 'file-extension' so that the right MIME type is chosen.

Reported by sirgazil at
<https://lists.gnu.org/archive/html/guile-user/2017-12/msg00070.html>.

* haunt/serve/mime-types.scm (%file-ext-regexp): Remove.
(file-extension): Rewrite using 'string-rindex'.
This commit is contained in:
Ludovic Courtès 2017-12-21 14:16:14 +01:00 committed by David Thompson
parent 4bf24d36f6
commit e7b1b290b1
1 changed files with 4 additions and 10 deletions

View File

@ -539,16 +539,10 @@
("vrml" . x-world/x-vrml) ("vrml" . x-world/x-vrml)
("wrl" . x-world/x-vrml)))) ("wrl" . x-world/x-vrml))))
(define %file-ext-regexp (define (file-extension file)
(make-regexp "(\\.(.*)|[~%])$")) "Return the extension of FILE or #f if there is none."
(let ((dot (string-rindex file #\.)))
(define (file-extension file-name) (and dot (substring file (+ 1 dot) (string-length file)))))
"Return the file extension for FILE-NAME, or #f if one is not
found."
(and=> (regexp-exec %file-ext-regexp file-name)
(lambda (match)
(or (match:substring match 2)
(match:substring match 1)))))
(define (mime-type file-name) (define (mime-type file-name)
"Guess the MIME type for FILE-NAME based upon its file extension." "Guess the MIME type for FILE-NAME based upon its file extension."