From 772d1b6c8a615a3ed1b5e1293127c8d4c31aed8f Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Thu, 21 Jul 2022 00:25:14 +0530 Subject: web: server: Be unaware of the state directory. The server should be unaware of the specifics of the state directory and its directory structure. It should be explicitly passed paths to all necessary directories. This way, the server can be repurposed for other applications such as the development web server---something that is coming soon in the subsequent commits. * tissue/web/server.scm (handler): Remove state-directory argument. Use directory paths in hosts argument. (start-web-server): Remove state-directory argument. Do not pass on state-directory to handler. * bin/tissue (tissue-web): Pass directory paths explicitly to start-web-server in hosts argument. Do not pass the removed state-directory argument. --- bin/tissue | 26 +++++++++++++++----------- tissue/web/server.scm | 24 ++++++++++++------------ 2 files changed, 27 insertions(+), 23 deletions(-) diff --git a/bin/tissue b/bin/tissue index 98073cb..30cad46 100755 --- a/bin/tissue +++ b/bin/tissue @@ -256,17 +256,21 @@ Serve repositories specified in CONFIG-FILE over HTTP. (start-web-server (listen->socket-address (assq-ref args 'listen)) (map (match-lambda ((name parameters ...) - ;; Set CSS for each host. - (parameterize ((%current-git-repository - (repository-open - (string-append (assq-ref args 'state-directory) - "/" name "/repository")))) - (cons name - (acons 'css - (tissue-configuration-web-css (load-config)) - parameters))))) - (assq-ref args 'hosts)) - (assq-ref args 'state-directory)))))) + ;; Add CSS, repository directory, + ;; website directory, xapian + ;; directory settings for each host. + (let* ((state-directory (assq-ref args 'state-directory)) + (repository-directory + (string-append state-directory "/" name "/repository"))) + (parameterize ((%current-git-repository + (repository-open repository-directory))) + (cons name + `((css . ,(tissue-configuration-web-css (load-config))) + (repository-directory . ,repository-directory) + (website-directory . ,(string-append state-directory "/" name "/website")) + (xapian-directory . ,(string-append state-directory "/" name "/xapian")) + ,@parameters)))))) + (assq-ref args 'hosts))))))) ;; This is a noop, since the index is built on any tissue command. It ;; exists just for the --help usage summary. diff --git a/tissue/web/server.scm b/tissue/web/server.scm index 7331e57..7a43a18 100644 --- a/tissue/web/server.scm +++ b/tissue/web/server.scm @@ -245,12 +245,11 @@ query. QUERY and FILTER are Xapian Query objects." db (new-Query (Query-OP-FILTER) query filter)) #:maximum-items (database-document-count db)))) -(define (handler request body hosts state-directory) +(define (handler request body hosts) "Handle web REQUEST with BODY and return two values---the response headers and the body. -See `start-web-server' for documentation of HOSTS and -STATE-DIRECTORY." +See `start-web-server' for documentation of HOSTS." (let* ((path (uri-path (request-uri request))) (parameters (query-parameters (uri-query (request-uri request)))) (hostname (match (assq-ref (request-headers request) 'host) @@ -264,7 +263,7 @@ STATE-DIRECTORY." path) (parameterize ((%current-git-repository (repository-open - (string-append state-directory "/" hostname "/repository")))) + (assq-ref host-parameters 'repository-directory)))) (cond ;; Search page ((member path (list "/" "/search")) @@ -280,7 +279,7 @@ STATE-DIRECTORY." (document . ,(parse-query "type:document"))))) (values '((content-type . (text/html))) (sxml->html - (call-with-database (string-append state-directory "/" hostname "/xapian") + (call-with-database (assq-ref host-parameters 'xapian-directory) (lambda (db) (let* ((query (parse-query search-query)) (mset (enquire-mset @@ -321,12 +320,14 @@ STATE-DIRECTORY." ((let ((file-path (find file-exists? ;; Try path and path.html. - (list (string-append state-directory "/" hostname "/website" path) - (string-append state-directory "/" hostname "/website" path ".html"))))) + (list (string-append (assq-ref host-parameters 'website-directory) + "/" path) + (string-append (assq-ref host-parameters 'website-directory) + "/" path ".html"))))) (and file-path ;; Check that the file really is within the document ;; root. - (string-prefix? (string-append state-directory "/" hostname "/website/") + (string-prefix? (string-append (assq-ref host-parameters 'website-directory) "/") (canonicalize-path file-path)) (canonicalize-path file-path))) => (lambda (file-path) @@ -341,12 +342,11 @@ STATE-DIRECTORY." (string-append "Resource not found: " (uri->string (request-uri request))))))))) -(define (start-web-server socket-address hosts state-directory) +(define (start-web-server socket-address hosts) "Start web server listening on SOCKET-ADDRESS. HOSTS is an association list mapping host names to another association -list containing parameters for that host. STATE-DIRECTORY is the path -to the tissue state directory." +list containing parameters for that host." (format (current-error-port) "Tissue web server listening on ~a~%" (cond @@ -370,7 +370,7 @@ to the tissue state directory." ;; variable each time so as to support live hacking. ((module-ref (resolve-module '(tissue web server)) 'handler) - request body hosts state-directory)) + request body hosts)) 'http (cond ;; IPv4 or IPv6 address -- cgit v1.2.3