diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-01 13:04:12 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-01 13:04:12 +0200 |
| commit | 5ddd131b95389712e17c7d556a28dc6f1ad6719e (patch) | |
| tree | ca3d79317072ade78e628417d112944907ff1c6b | |
| parent | Server make-routes now support custom regexes. (diff) | |
| download | calp-5ddd131b95389712e17c7d556a28dc6f1ad6719e.tar.gz calp-5ddd131b95389712e17c7d556a28dc6f1ad6719e.tar.xz | |
Server server any subdir under static.
| -rw-r--r-- | module/entry-points/server.scm | 32 |
1 files changed, 17 insertions, 15 deletions
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm index 83d80c27..3455540d 100644 --- a/module/entry-points/server.scm +++ b/module/entry-points/server.scm @@ -38,20 +38,22 @@ (with-output-to-string (lambda () (display "<!doctype html>\n") (sxml->xml sxml)))) +(define (// . args) (string-join args file-name-separator-string )) + (define (directory-table dir) `(table (thead (tr (th "") (th "Name") (th "Perm"))) (tbody ,@(map (lambda (k) - (let* ((stat (lstat k))) + (let* ((stat (lstat (// dir k)))) `(tr (td ,(case (stat:type stat) [(directory) "📁"] [(regular) "📰"] [else "🙃"])) - (td (a (@ (href "/" ,dir ,k)) ,k)) + (td (a (@ (href "/" ,dir "/" ,k)) ,k)) (td ,(number->string (stat:perms stat) 8))))) - (cddr (scandir dir)))))) + (cdr (scandir dir)))))) (define (make-make-routes calendar regular repeating events) @@ -115,23 +117,23 @@ (return (build-response code: 404) (format #f "No component with UID=~a found." uid)))) - (GET "/static" () - (return - '((content-type text/html)) - (sxml->html-string - (directory-table "static/")))) + ;; NOTE this only handles files with extensions. Limited, but since this + ;; is mostly for development, and something like nginx should be used in + ;; production it isn't a huge problem. - (GET "/static/:filename.css" (filename) + (GET "/static/:*{.*}.:ext" (* ext) (return - `((content-type text/css)) - (call-with-input-file (string-append "static/" filename ".css") + ;; TODO actually check mimetype + `((content-type ,(string->symbol (string-append "text/" ext)))) + (call-with-input-file (string-append "static/" * "." ext) read-string))) - (GET "/static/:filename.js" (filename) + (GET "/static/:*{.*}" (*) (return - `((content-type text/javascript)) - (call-with-input-file (string-append "static/" filename ".js") - read-string))) + '((content-type text/html)) + (sxml->html-string + (directory-table (// "static" *))))) + (GET "/count" () ;; (sleep 1) |