summary refs log tree commit diff
diff options
context:
space:
mode:
authorArun Isaac2022-07-01 01:25:58 +0530
committerArun Isaac2022-07-01 01:25:58 +0530
commitb15edb1e6910a8a2b4994d8225f2ec5097e648ab (patch)
tree4c026539c65cbd2940e1e84a73e89bb54948afd9
parent33ddc67e439a697907566b07f63be19b0d304f7b (diff)
downloadtissue-b15edb1e6910a8a2b4994d8225f2ec5097e648ab.tar.gz
tissue-b15edb1e6910a8a2b4994d8225f2ec5097e648ab.tar.lz
tissue-b15edb1e6910a8a2b4994d8225f2ec5097e648ab.zip
web: server: Make CSS a host-specific parameter.
* bin/tissue (tissue-run-web): Pass CSS as a host-specific parameter.
* tissue/web/server.scm (handler): Remove css argument. Accept CSS as
a host-specific parameter.
(start-web-server): Remove css argument.
-rwxr-xr-xbin/tissue20
-rw-r--r--tissue/web/server.scm13
2 files changed, 20 insertions, 13 deletions
diff --git a/bin/tissue b/bin/tissue
index 2237652..2c739b3 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -251,12 +251,20 @@ Run a web search service reading configuration from CONFIG-FILE.
                                    listen-repl)
                            (make-unix-domain-server-socket #:path listen-repl))))))
        (start-web-server (listen->socket-address (assq-ref args 'listen))
-                         (or (assq-ref args 'hosts)
-                             ;; Assume current directory as default.
-                             `(("localhost"
-                                (indexed-repository . ,(getcwd)))))
-                         %xapian-index
-                         (tissue-configuration-web-css (load-config)))))))
+                         (map (match-lambda
+                                ((name parameters ...)
+                                 ;; Set CSS for each host.
+                                 (call-with-current-directory (assq-ref parameters 'indexed-repository)
+                                   (lambda ()
+                                     (cons name
+                                           (acons 'css
+                                                  (tissue-configuration-web-css (load-config))
+                                                  parameters))))))
+                              (or (assq-ref args 'hosts)
+                                  ;; Assume current directory as default.
+                                  `(("localhost"
+                                     (indexed-repository . ,(getcwd))))))
+                         %xapian-index)))))
 
 ;; 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 89e8104..be783db 100644
--- a/tissue/web/server.scm
+++ b/tissue/web/server.scm
@@ -165,12 +165,11 @@ operators "
            (string-split query #\&))
       '()))
 
-(define (handler request body hosts xapian-index css)
+(define (handler request body hosts xapian-index)
   "Handle web REQUEST with BODY and return two values---the response
 headers and body.
 
-See `start-web-server' for documentation of HOSTS, XAPIAN-INDEX and
-CSS."
+See `start-web-server' for documentation of HOSTS and XAPIAN-INDEX."
   (let ((path (uri-path (request-uri request)))
         (parameters (query-parameters (uri-query (request-uri request))))
         (host-parameters (or (assoc-ref hosts
@@ -209,19 +208,19 @@ CSS."
                                         mset))
                             search-query
                             (MSet-get-matches-estimated mset)
-                            css))))))))
+                            (assq-ref host-parameters 'css)))))))))
          (else
           (values (build-response #:code 404)
                   (string-append "Resource not found: "
                                  (uri->string (request-uri request))))))))))
 
-(define (start-web-server socket-address hosts xapian-index css)
+(define (start-web-server socket-address hosts xapian-index)
   "Start web server listening on SOCKET-ADDRESS.
 
 HOSTS is an association list mapping host names to another association
 list containing parameters for that host. XAPIAN-INDEX is the path to
 the xapian database relative to the top-level of the git
-repository. CSS is a URI to a stylesheet."
+repository."
   (format (current-error-port)
           "Tissue web server listening on ~a~%"
           (cond
@@ -245,7 +244,7 @@ repository. CSS is a URI to a stylesheet."
                 ;; variable each time so as to support live hacking.
                 ((module-ref (resolve-module '(tissue web server))
                              'handler)
-                 request body hosts xapian-index css))
+                 request body hosts xapian-index))
               'http
               (cond
                ;; IPv4 or IPv6 address