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.

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