summaryrefslogtreecommitdiff
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