From 185dcb350d3ece955436443ed7965f302e68842c Mon Sep 17 00:00:00 2001
From: Nikolay Puzanov <np@embddr.com>
Date: Fri, 2 Dec 2022 18:46:42 +0300
Subject: [PATCH] Fix content type of binary response. Add favicon

---
 _web_server/server/favicon.png           | Bin 0 -> 1390 bytes
 _web_server/server/playground-server.scm |  89 ++++++++++++++++-------
 2 files changed, 62 insertions(+), 27 deletions(-)
 create mode 100644 _web_server/server/favicon.png

diff --git a/_web_server/server/favicon.png b/_web_server/server/favicon.png
new file mode 100644
index 0000000000000000000000000000000000000000..85888fb314510b7723b902fba6f30b04ddf0a978
GIT binary patch
literal 1390
zcmeAS@N?(olHy`uVBq!ia0y~yU{C;I4mJh`hT^KKFANN<rk*a2ArbCpr&s&T4i!0Y
z{_n4?Yt}ySV$$=Tc5uOwhaNdjS90u*U0E<eB5lsX>H|jG6yJ)OFYZ>HxJ2jA#+8PV
zsfjjeOB@o_k`_&B;B*sH-^F9FQi?0f?4(<3;H`D6zkk@B-&?z8%Tqz7bF*veYrfB`
ze)oP}^*hVwLJ^797tE$@n#kd*)M(pMAjR}3Y|bh!-|fs3W-}Zz==)w=x9)gFz}uM4
ztW9$QQh%?{n&)v&z-f!d>KMOyeccRlEGEBM{@q#19GUEWHc}+v{?z?XUjDOWR{Wr*
zHDPVaLl&br#s^N5T;e`od>#Ev=%ok80^`4vd{zED-|>1+sGf}VS*0I4_lonU_8;dv
z!uaCW+WyDusy})!KNLUDp6~m+d!3Ijh=d<le16)7fBLWZ4$t|VH^=8+oa~DERWrXn
z-sr>HAYztr_3*_eZiXi7>2>mPbGT;t?PcJ*t^1%-?t+p62NMeu<Bie}u@^+-6L;BN
zv}MlQ&ATK>^Y`+{A@6o7vz@4(xXW)tAjie?Z+o`6uqaeKn<t-q){l{;U-nIzHFHLG
zcJrrCpDY+y^$$FGq7uDg;X=kQRkbn>9fy^so|w<^+l9s9exhyvult=_lO+y3EHGf0
ze3B(KHMNkzYbA%-Y+a^+(9o?C3=5L$3Ib;zzLv!BWtFGpy+^b5>F!RJjXF@Ubt~VI
z`a2hH-8#j<#>RFa!^G*_<@FA2Y37svzT3n&NkwVPmMt6p@7rgWk(Jf-c6WTUZl$&I
zuZo#6+n(C<FVgt6$1c%5_-C0m^M&$0Q^7zRt8dQyU*ar8vs+Am*K3pt%dC^<c&V%_
zpMBN+q-RgTB9}eAdruiSBql0~h=>?CzVhjm+RFAfOe;7#n)^=M6b=U7FuUa`#uvBu
zPZR2!v2u}tLu{;UNO<`Ao99+8+OoxDhWHN+?g!6YZuoymd#!rs_(yiehJ6=&{7QP_
z+@qfbGrZoqe!=-4VoR1SYw{93XIx?CrP|Ze<KnYV>axlv2DUcoCoMOBnQsj+X^7Ed
z|8>#K+WIuZq3Z>v-TGxLFW4`O9B5~%F>%<!|K!=TLr0Dr`Nhy7@FSk#h^(WhC#Q(0
zsA2Z?D_0tBzm1dUX6a{`D<Ec-_{LIQU41<_L$Oor@eF166B{3x{*h9CnAx$7;qCIs
zKD7k}4<dV&)poJIk$PoqDA38TCLk!)A=LWlzmm|V0G)#YK4(`N_nQ?vXdPM@u`s~p
z5yM&5j8zt^i)GGnJY|Y%P|3PzWNd7_AjDQ^F1OzG>|!mamp{sVjx(NKJAeJDeYxun
zvc6YW*e<Kj`7b>!ZIfw?p16;%Z==sdCZoy?9?Px@gie__@!-F?e(FB{{?3y=B~Hi-
zaJeyMRmqL=Z<`aWo*BqaZ@W}@f$Q3L%ZBaA<(uSKJ2fWpzy7}ZX4J&47beqE_8qw6
ze`C9{RMK0<j-#(jY;H!(d>_ehU`>M5d9^(SyelK}7W6WmIe+Uwg24u3c`2!;b?esc
zn8dT^d&GrBxdjCRyLRsuo|+PD=eSAx*G8f6Y5No9E`Lz?wn&ama9vk&zgl3ZjJ9yF
zXtL{@`j!6z-ZjnA|9JSxsR}c3fn6^P|5PrPulf8g;_ifLKP6U}<tP8GkNMB`=iX0?
znP1k}+}NSnJa5ZU^@8<kRm*gLnJl(@__g}nqMQDU+Cpv5uGs!KX7Tx_Rr)p0HcmNh
z=ht8RE81^TkG*o!3fG6f%eC_MUz9!4{AsR(%JWy=o7Z@E>TwIq^HEM~5bpkXbvOIz
zKwi7U+mnnqr}?tH$yhmCLa(jxVcmZ3OP3>NK8=`UX!1k9`uh5%`S!xD3=9kmp00i_
I>zopr07B4&Y5)KL

literal 0
HcmV?d00001

diff --git a/_web_server/server/playground-server.scm b/_web_server/server/playground-server.scm
index 36bf7ec..23ecefb 100755
--- a/_web_server/server/playground-server.scm
+++ b/_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