diff --git a/_web_server/server/favicon.png b/_web_server/server/favicon.png new file mode 100644 index 0000000..85888fb Binary files /dev/null and b/_web_server/server/favicon.png differ 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