Serve static content

This commit is contained in:
Tony Garnock-Jones 2016-11-20 18:12:03 +13:00
parent 4a1ad72ab8
commit 42edd5397a
1 changed files with 19 additions and 0 deletions

View File

@ -4,11 +4,15 @@
(require racket/dict)
(require racket/exn)
(require racket/file)
(require racket/format)
(require racket/runtime-path)
(require racket/set)
(require net/url)
(require net/uri-codec)
(require file/sha1)
(require web-server/dispatchers/filesystem-map)
(require web-server/private/mime-types)
(require/activate syndicate/drivers/timer)
(require/activate syndicate/drivers/timestate)
@ -128,6 +132,21 @@
(resource->url
(web-request-header-resource req)))))))))))
(begin-for-declarations
(define-runtime-path htdocs-path "htdocs")
(define path->mime-type (make-path->mime-type "/etc/mime.types")))
(actor #:name 'static-content-server
(define url->path (make-url->path htdocs-path))
(during (local-host $host-name)
(on (web-request-get (id req) (vh host-name) ,_)
(define-values (path path-pieces)
(url->path (resource->url (web-request-header-resource req))))
(when (file-exists? path)
(web-respond/bytes! id
#:header (web-response-header #:mime-type (path->mime-type path))
(file->bytes path))))))
(actor #:name 'local-topic-manager
(field [topics (set)])