move mimetype guessing to file
1 files changed, 44 insertions(+), 55 deletions(-)

M wispserve/serve.w
M wispserve/serve.w +44 -55
@@ 43,7 43,7 @@ import
     srfi srfi-1 ;; list operations
     only (srfi srfi-27) random-integer
     only (srfi srfi-9) define-record-type
-    only (ice-9 popen) open-input-pipe
+    only (ice-9 popen) open-input-pipe close-pipe open-pipe*
     only (ice-9 rdelim) read-string
     ice-9 optargs
     ice-9 format

          
@@ 92,11 92,12 @@ define : run-ipv6-standard-server handle
     run-server handler-with-path 'http `(#:family ,AF_INET6 #:addr (inet-pton AF_INET6 ip) #:port 8083 #:socket ,s)
 
 define-record-type <served>
-    served serverpath accesspath size sha256
+    served serverpath accesspath size mimetype sha256
     . served-file?
     serverpath served-serverpath
     accesspath served-accesspath
     size served-sizebytes
+    mimetype served-mimetype
     sha256 served-sha256
 
 define xalt : list ;; per file: (hash IP IP ...)

          
@@ 305,38 306,27 @@ define : xalt->header xalt
     ;; pretty-print xalt
     string-join (remove not (append (map second xalt) seed-server-ips)) ","
 
-define : guess-content-type path
+define : guess-mime-type  path
+    define port : open-pipe* OPEN_READ "file" "-b" "--mime-type" path
+    define mime-type : read port
+    close-pipe port
     cond
-        : string-suffix-ci? ".mp4" path
-          . `(video/mp4 (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".mpg" path
-          . `(video/mpeg (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".mpeg" path
-          . `(video/mpeg (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".mkv" path
-          . `(video/webm (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".webm" path
-          . `(video/webm (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".ogv" path
-          . `(video/ogv (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".ogg" path
-          . `(video/ogg (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".mp3" path
-          . `(audio/mpeg (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".avi" path
-          . `(video/x-msvideo (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".txt" path
-          . `(text/plain (charset  . "ISO-8859-1"))
-        : string-suffix-ci? ".w" path
-          . `(text/plain (charset  . "ISO-8859-1"))
-        else
-          . `(application/octet-stream)
+        : not mime-type
+          . 'application/octet-stream
+        : equal? mime-type 'video/x-matroska
+          . 'video/webm
+        else mime-type
 
-define : hash-if-unknown! served-file
+define : content-type mime-type
+    ` ,mime-type (charset . "ISO-8859-1")
+
+define : hash-and-mime-if-unknown! served-file
     define accesspath : and=> (and=> served-file cdr) served-accesspath
     define served-cdr : and=> served-file cdr
-    when served-cdr
-        when : not : served-sha256 served-cdr
+    if : not served-cdr
+        . served-file
+        if : and (served-sha256 served-cdr) (served-mimetype served-cdr)
+            . served-file
             let
                 :
                     new-served

          
@@ 344,15 334,17 @@ define : hash-if-unknown! served-file
                             served-serverpath served-cdr
                             served-accesspath served-cdr
                             served-sizebytes served-cdr
-                            sha256sum : served-accesspath served-cdr
+                            guess-mime-type accesspath
+                            sha256sum accesspath
+                ;; write new-served
                 set! served-files
                     cons new-served
                         delete served-cdr served-files
                 set! served-hashes : vhash-cons (served-sha256 new-served) new-served served-hashes
                 set! served-paths : vhash-cons (served-serverpath new-served) new-served : vhash-delete (served-serverpath served-cdr) served-paths
-
+                cons (car served-file) new-served
 
-define : server-serve-file range-requested begin-end path
+define : server-serve-file range-requested begin-end served-file
    define 16B : expt 2 4
    define 4KiB : expt 2 12
    define 32KiB : expt 2 15

          
@@ 362,16 354,16 @@ define : server-serve-file range-request
    define 2MiB : expt 2 21
    define 32MiB : expt 2 25
    define range-begin : car begin-end
-   define served-file : resolve-path path
    define filesize
        or : and=> (and=> (and=> (and=> served-file cdr) served-accesspath) stat) stat:size
           . 32KiB
-   set! range-requested : or range-requested (> filesize 2MiB)
    define range-end
-       if range-requested
+       if : not : or range-requested (> filesize 2MiB)
+          . #f
           or
               cdr begin-end
-              min filesize ;; if no size is requested, optimize for streaming video
+               ;; if no size is requested, optimize for streaming video
+              min : - filesize 1
                   + range-begin
                       cond
                         : zero? range-begin

          
@@ 379,30 371,24 @@ define : server-serve-file range-request
                         : < range-begin 2MiB
                           . 256KiB
                         else 2MiB
-          . #f
-   let*
-       :
-         ;; foo : pretty-print served-file
-         data
+   define code : if (not served-file) 404 : if range-end 206 : if (zero? filesize) 204 200
+   define base-headers `((content-type . ,(or (and served-file (content-type (served-mimetype (cdr served-file)))) '(application/octet-stream)))
+                         (accept-ranges . (bytes))
+                         (X-Alt . ,(xalt->header xalt)))
+   define file-size : if (not served-file) 0 : served-sizebytes : cdr served-file
+   define data
              if : not served-file
                  . "File not found"
                  get-file-chunk
                      served-accesspath (cdr served-file)
                      . range-begin
                      . range-end
-         code : if (not served-file) 404 : if range-requested 206 : if (zero? filesize) 204 200
-         base-headers `((content-type . ,(guess-content-type path))
-                        (accept-ranges . (bytes))
-                        (X-Alt . ,(xalt->header xalt)))
-         file-size : if (not served-file) 0 : served-sizebytes : cdr served-file
-         range-end : and range-end : min range-end {file-size - 1}
-         headers
+   define headers
              if : and range-end (not (zero? filesize))
                 cons `(content-range . ,(format #f "bytes ~d-~d/~d" range-begin range-end file-size))
                      . base-headers
                 . base-headers
-       hash-if-unknown! served-file
-       values
+   values
           build-response
             . #:headers headers
             . #:code code

          
@@ 517,8 503,6 @@ define* : string-split-string s substr #
 
 
 define : server-file-download-handler folder-path request body
-    ;; TODO: serve range requests, see https://developer.mozilla.org/en-US/docs/Web/HTTP/Range_requests
-    ;; TODO: return status code 206 for range requests (also for initial?): https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/206
     define headers : request-headers request
     let*
         : range-requested : assoc-item headers 'range

          
@@ 550,7 534,8 @@ define : server-file-download-handler fo
                       alist-cons sha256
                           delete-duplicates : cons ipv6 : or (assoc-ref xalt sha256) : list
                           . xalt
-              server-serve-file range-requested begin-end path
+              server-serve-file range-requested begin-end
+                  hash-and-mime-if-unknown! served-file
 
 define : sha256sum path
   let*

          
@@ 566,7 551,11 @@ define : hash-folder-tree folder-path
     define : leaf name stat result
         let : : serverpath : string-drop name : + 1 : string-length folder-path
           display "."
-          cons : served serverpath name (stat:size stat) (if hash-eagerly? (sha256sum name) #f)
+          cons 
+               served serverpath name 
+                   stat:size stat 
+                   if hash-eagerly? (guess-mime-type name) #f
+                   if hash-eagerly? (sha256sum name) #f
                . result
     ;; skip dot-directories
     define : enter? name stat result