diff options
| -rw-r--r-- | guix-data-service/web/controller.scm | 25 | ||||
| -rw-r--r-- | guix-data-service/web/render.scm | 21 | ||||
| -rw-r--r-- | guix-data-service/web/server.scm | 18 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 6 |
4 files changed, 39 insertions, 31 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 8482272..c06b24c 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -31,6 +31,7 @@ #:use-module (squee) #:use-module (json) #:use-module (guix-data-service comparison) + #:use-module (guix-data-service database) #:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model guix-revision) @@ -537,7 +538,27 @@ (define (parse-build-status s) s) -(define (controller request method-and-path-components mime-types body conn) +(define (controller request method-and-path-components mime-types body) + (match method-and-path-components + ((GET "assets" rest ...) + (or (render-static-asset (string-join rest "/") + (request-headers request)) + (not-found (request-uri request)))) + + (_ + (with-postgresql-connection + (lambda (conn) + (controller-with-database-connection request + method-and-path-components + mime-types + body + conn)))))) + +(define (controller-with-database-connection request + method-and-path-components + mime-types + body + conn) (define query-parameters (-> request request-uri @@ -694,4 +715,4 @@ target-commit target-revision-id))))) ((GET path ...) - (render-static-asset request)))) + (not-found (request-uri request))))) diff --git a/guix-data-service/web/render.scm b/guix-data-service/web/render.scm index 2318a19..5b0ff7a 100644 --- a/guix-data-service/web/render.scm +++ b/guix-data-service/web/render.scm @@ -49,22 +49,13 @@ ("ttf" . (application/octet-stream)) ("html" . (text/html)))) -(define (render-static-asset request) - (render-static-file (%config 'assets-dir) request)) +(define (render-static-asset path headers) + (render-static-file (%config 'assets-dir) path headers)) (define %not-slash (char-set-complement (char-set #\/))) -(define (render-static-file root request) - (define path - (uri-path (request-uri request))) - - (define failure - (not-found (build-uri 'http - #:host (%config 'host) - #:port (%config 'port) - #:path path))) - +(define (render-static-file root path headers) (let ((file-name (string-append root "/" path))) (if (not (any (cut string-contains <> "..") (string-tokenize path %not-slash))) @@ -79,7 +70,7 @@ (call-with-input-file file-name get-bytevector-all))) (if (and stat (not (eq? 'directory (stat:type stat)))) - (cond ((assoc-ref (request-headers request) 'if-modified-since) + (cond ((assoc-ref headers 'if-modified-since) => (lambda (client-date) (if (time>? modified (date->time-utc client-date)) @@ -88,8 +79,8 @@ #f)))) (else (send-file))) - failure)) - failure))) + #f)) + #f))) (define* (render-html #:key sxml (extra-headers '()) (code 200)) diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm index f390da1..8072dfe 100644 --- a/guix-data-service/web/server.scm +++ b/guix-data-service/web/server.scm @@ -23,22 +23,18 @@ #:use-module (web request) #:use-module (web uri) #:use-module (fibers web server) - #:use-module (guix-data-service database) #:use-module (guix-data-service web controller) #:use-module (guix-data-service web util) #:export (start-guix-data-service-web-server)) (define (run-controller controller request body) - (with-postgresql-connection - (lambda (conn) - (let-values (((request-components mime-types) - (request->path-components-and-mime-type request))) - (controller request - (cons (request-method request) - request-components) - mime-types - body - conn))))) + (let-values (((request-components mime-types) + (request->path-components-and-mime-type request))) + (controller request + (cons (request-method request) + request-components) + mime-types + body))) (define (handler request body controller) (format #t "~a ~a\n" diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index cec4c19..61a24f2 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -74,18 +74,18 @@ (@ (rel "stylesheet") (media "screen") (type "text/css") - (href "/css/reset.css"))) + (href "/assets/css/reset.css"))) (link (@ (rel "stylesheet") (media "screen") (type "text/css") - (href "/css/bootstrap.css"))) + (href "/assets/css/bootstrap.css"))) ,@head (link (@ (rel "stylesheet") (media "screen") (type "text/css") - (href "/css/screen.css")))) + (href "/assets/css/screen.css")))) (body ,@body (footer (p "Copyright © 2016—2019 by the GNU Guix community." |