Fix content type of binary response. Add favicon

_web_server/server/playground-server.scm

@@ -54,31 +54,6 @@
   (apply string-append
          (insert-between strings "\n")))
 
-(define (not-found request)
-  (values (build-response #:code 404)
-          (string-append "Resource not found: "
-                         (uri->string (request-uri request)))))
-
-(define* (make-response str #:key (type 'text/html))
-  (values (build-response
-           #:headers `((content-type . (,type (charset . "utf-8"))))
-           #:code 200)
-          str))
-
-(define* (file-reader file-name #:key (max-read-length 512))
-  (lambda (port)
-    (with-input-from-file file-name
-      (lambda ()
-        (let loop ()
-          (let ((data (get-bytevector-n (current-input-port)
-                                        max-read-length)))
-            (when (not (eof-object? data))
-              (put-bytevector port data)
-              (loop))))))))
-
-(define* (file-response file #:key (type 'text/html))
-  (make-response (file-reader file) #:type type))
-
 (define-syntax guard
   (syntax-rules ()
     ((_ default code...)
@@ -162,6 +137,59 @@
     (apply string-append
            (append-map (cut list <> "\n") lines))))
 
+;;;
+;;; 404 response
+;;;
+(define (not-found request)
+  (values (build-response #:code 404)
+          (string-append "Resource not found: "
+                         (uri->string (request-uri request)))))
+
+;;;
+;;; Common text/html response
+;;;
+(define* (make-response str #:key
+                        (content-type 'text/html)
+                        (content-type-params '((charset . "utf-8"))))
+  (values (build-response
+           #:headers `((content-type . (,content-type ,@content-type-params)))
+           ;; #:headers `((content-type . (,(if (null? encoding)
+           ;;                                   type
+           ;;                                   (cons type encoding)))))
+           #:code 200)
+          str))
+
+;;;
+;;; File reader
+;;;
+(define* (file-reader file-name #:key
+                      (max-read-length 512)
+                      (max-file-size #f))
+  (lambda (port)
+    (guard ""
+      (call-with-input-file file-name
+        (lambda (in)
+          (let loop ((readed 0))
+            (when (or (not max-file-size)
+                      (< readed max-file-size))
+              (let ((data (get-bytevector-n in max-read-length)))
+                (when (not (eof-object? data))
+                  (put-bytevector port data)
+                  (loop (+ readed (bytevector-length data))))))))
+        #:binary #t))))
+
+;;;
+;;; File response
+;;;
+(define* (file-response file #:key
+                        (content-type 'application/octet-stream)
+                        (content-type-params '((charset . "")))
+                        (max-file-size #f))
+  (make-response
+   (file-reader file #:max-file-size max-file-size)
+   #:content-type content-type
+   #:content-type-params content-type-params))
+
 ;;;
 ;;; Execute system command and capture stdout and stderr to string list
 ;;;
@@ -445,6 +473,13 @@
             (make-response
              (substitute index-html "@~a@" `((CODE ,DEFAULT-CODE)))))
 
+           ;; Site favicon
+           ((equal? path (append root-path '("favicon.ico")))
+            (logger LOG-DBG "Request favicon.ico")
+            (file-response "favicon.png"
+                           #:content-type 'image/png
+                           #:max-file-size 10000))
+
            ;; Get saved snippet
            ((and (= (length path)
                     (+ (length root-path) 1))
@@ -485,7 +520,7 @@
                        work-base
                        #:vvp-exe vvp-exe
                        #:iverilog-exe iverilog-exe)
-             #:type 'text/plain))
+             #:content-type 'text/plain))
 
            ;; Save snippet
            ((or (equal? path savecode-path)
@@ -507,7 +542,7 @@
                 (make-response
                  (encode-and-join-uri-path
                   (append root-path `(,stor-dir)))
-                 #:type 'text/plain))))
+                 #:content-type 'text/plain))))
 
            ;; Wrong POST request
            (else