129 lines
5.6 KiB
Racket
129 lines
5.6 KiB
Racket
#lang racket/base
|
|
|
|
(require json
|
|
racket/string
|
|
web-server/http
|
|
web-server/http/json
|
|
web-server/http/xexpr)
|
|
|
|
(provide json-response
|
|
json-error
|
|
html-response
|
|
redirect-response
|
|
request-json
|
|
request-header/string
|
|
bytes-response
|
|
extension->mime)
|
|
|
|
(define security-headers
|
|
(list (make-header #"X-Content-Type-Options" #"nosniff")
|
|
(make-header #"Referrer-Policy" #"same-origin")
|
|
(make-header #"Content-Security-Policy"
|
|
#"default-src 'self'; img-src 'self' data:; style-src 'self' 'unsafe-inline'; script-src 'self'; connect-src 'self'; object-src 'none'; base-uri 'self'; form-action 'self'; frame-ancestors 'none'")))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Create a JSON HTTP response with the standard security headers.
|
|
; pre : value is JSON encodable and headers contains HTTP headers.
|
|
; post : No external state has been changed.
|
|
; result : An HTTP response value.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (json-response value #:code [code 200] #:headers [headers '()])
|
|
(response/jsexpr value
|
|
#:code code
|
|
#:headers (append security-headers headers)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Create a JSON error response.
|
|
; pre : code is an HTTP status code and message is displayable JSON text.
|
|
; post : No external state has been changed.
|
|
; result : An HTTP JSON response containing ok = #f and the error message.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (json-error code message)
|
|
(json-response (hash 'ok #f 'error message) #:code code))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Create an HTML response from an X-expression.
|
|
; pre : value is a valid X-expression and headers contains HTTP headers.
|
|
; post : No external state has been changed.
|
|
; result : An HTTP HTML response with the standard security headers.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (html-response value #:code [code 200] #:headers [headers '()])
|
|
(response/xexpr value
|
|
#:code code
|
|
#:headers (append security-headers headers)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Create a no-cache HTTP redirect response.
|
|
; pre : location is an absolute-path URL string for this server and headers
|
|
; contains optional response headers.
|
|
; post : No external state has been changed.
|
|
; result : An HTTP 303 response with a Location header and the supplied headers.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (redirect-response location #:headers [headers '()])
|
|
(response/full 303
|
|
#"See Other"
|
|
(current-seconds)
|
|
#"text/plain; charset=utf-8"
|
|
(append security-headers
|
|
headers
|
|
(list (make-header #"Location"
|
|
(string->bytes/utf-8 location))
|
|
(make-header #"Cache-Control" #"no-store")))
|
|
(list #"")))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Decode the JSON request body.
|
|
; pre : req is a web-server request whose body is empty or valid JSON.
|
|
; post : The request has only been inspected.
|
|
; result : The decoded JSON value, or an empty hash for an empty body.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (request-json req)
|
|
(define body (request-post-data/raw req))
|
|
(if body
|
|
(bytes->jsexpr body)
|
|
(hash)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Read a request header as UTF-8 text.
|
|
; pre : req is a web-server request and name is a header name string.
|
|
; post : The request has only been inspected.
|
|
; result : The header value as a string, or #f when absent.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (request-header/string req name)
|
|
(define found
|
|
(headers-assq* (string->bytes/utf-8 name)
|
|
(request-headers/raw req)))
|
|
(and found
|
|
(bytes->string/utf-8 (header-value found))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Create an HTTP response containing bytes.
|
|
; pre : bytes is the response body, mime is a MIME byte string and headers contains HTTP headers.
|
|
; post : No external state has been changed.
|
|
; result : An HTTP response value.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (bytes-response bytes mime #:headers [headers '()])
|
|
(response/full 200
|
|
#f
|
|
(current-seconds)
|
|
mime
|
|
(append security-headers headers)
|
|
(list bytes)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Map a supported filename extension to a MIME type.
|
|
; pre : filename is a string.
|
|
; post : No external state has been changed.
|
|
; result : A MIME byte string; application/octet-stream when the extension is unknown.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (extension->mime filename)
|
|
(define lower (string-downcase filename))
|
|
(cond
|
|
((regexp-match? #px"[.]png$" lower) #"image/png")
|
|
((regexp-match? #px"[.](jpg|jpeg)$" lower) #"image/jpeg")
|
|
((regexp-match? #px"[.]gif$" lower) #"image/gif")
|
|
((regexp-match? #px"[.]webp$" lower) #"image/webp")
|
|
((regexp-match? #px"[.]pdf$" lower) #"application/pdf")
|
|
((regexp-match? #px"[.]txt$" lower) #"text/plain; charset=utf-8")
|
|
(else #"application/octet-stream")))
|