summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2023-01-28 23:49:29 +0000
committerArun Isaac2023-01-28 23:49:29 +0000
commitae1a4caa27cf49e3c9bdd40bd6ea04e99f0f2366 (patch)
tree3ad0f383c723de2ce095f63df1d973bae35942f7
parentd5c1667374cb5e4ea016395e9f2b2ae89c5f6216 (diff)
downloadtissue-ae1a4caa27cf49e3c9bdd40bd6ea04e99f0f2366.tar.gz
tissue-ae1a4caa27cf49e3c9bdd40bd6ea04e99f0f2366.tar.lz
tissue-ae1a4caa27cf49e3c9bdd40bd6ea04e99f0f2366.zip
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.
-rw-r--r--tissue/web/server.scm62
1 files 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.