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:
		
				
					committed by
					
						
						David Thompson
					
				
			
			
				
	
			
			
			
						parent
						
							4bf24d36f6
						
					
				
				
					commit
					e7b1b290b1
				
			@@ -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."
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user