From ae1a4caa27cf49e3c9bdd40bd6ea04e99f0f2366 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sat, 28 Jan 2023 23:49:29 +0000 Subject: web: Change to repository directory when handling requests. Files in the repository may be read. So, we must change into a checkout of the repository when handling requests. * tissue/web/server.scm (handler): Change to repository directory when handling requests. --- tissue/web/server.scm | 62 ++++++++++++++++++++++++++------------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/tissue/web/server.scm b/tissue/web/server.scm index e794ed0..43093f8 100644 --- a/tissue/web/server.scm +++ b/tissue/web/server.scm @@ -152,38 +152,40 @@ See `start-web-server' for documentation of HOSTS." (host-parameters (or (assoc-ref hosts hostname) (raise (condition (make-message-condition "Unknown host") - (make-irritants-condition hostname)))))) + (make-irritants-condition hostname))))) + (repository-directory (assq-ref host-parameters 'repository-directory))) (log-request request) (parameterize ((%current-git-repository - (repository-open - (assq-ref host-parameters 'repository-directory)))) - (cond - ;; Static files - ((let ((file-path - (find file-exists? - (map (cut string-append (assq-ref host-parameters 'website-directory) <>) - (try-paths path))))) - (and file-path - ;; Check that the file really is within the document - ;; root. - (string-prefix? (string-append (assq-ref host-parameters 'website-directory) "/") - (canonicalize-path file-path)) - (canonicalize-path file-path))) - => (lambda (file-path) - (values `((content-type . ,(mime-type-for-extension - (file-name-extension file-path)))) - (call-with-input-file file-path - get-bytevector-all)))) - ;; Search page. We look for the search page only after files - ;; because we want to let files shadow the search page if - ;; necessary. - ((member path (list "/" "/search")) - (search-handler request body - (assq-ref host-parameters 'xapian-directory) - (assq-ref host-parameters 'project))) - ;; Not found - (else - (404-response request)))))) + (repository-open repository-directory))) + (call-with-current-directory repository-directory + (lambda () + (cond + ;; Static files + ((let ((file-path + (find file-exists? + (map (cut string-append (assq-ref host-parameters 'website-directory) <>) + (try-paths path))))) + (and file-path + ;; Check that the file really is within the document + ;; root. + (string-prefix? (string-append (assq-ref host-parameters 'website-directory) "/") + (canonicalize-path file-path)) + (canonicalize-path file-path))) + => (lambda (file-path) + (values `((content-type . ,(mime-type-for-extension + (file-name-extension file-path)))) + (call-with-input-file file-path + get-bytevector-all)))) + ;; Search page. We look for the search page only after files + ;; because we want to let files shadow the search page if + ;; necessary. + ((member path (list "/" "/search")) + (search-handler request body + (assq-ref host-parameters 'xapian-directory) + (assq-ref host-parameters 'project))) + ;; Not found + (else + (404-response request)))))))) (define (start-web-server socket-address hosts) "Start web server listening on SOCKET-ADDRESS. -- cgit v1.2.3