Fix content type of binary response. Add favicon
This commit is contained in:
parent
28d86fb98d
commit
185dcb350d
BIN
_web_server/server/favicon.png
Normal file
BIN
_web_server/server/favicon.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.4 KiB |
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user