summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2022-12-24 00:36:40 +0000
committerArun Isaac2022-12-24 19:27:53 +0000
commit6f56c8a021ce51244525c4043d59a99d09fbedba (patch)
treee3fb867962bed4e69cd8a1f65b4b64051b4eb35e
parentc6f9002a10d0693c801c38aad748d19befeecf4f (diff)
downloadtissue-6f56c8a021ce51244525c4043d59a99d09fbedba.tar.gz
tissue-6f56c8a021ce51244525c4043d59a99d09fbedba.tar.lz
tissue-6f56c8a021ce51244525c4043d59a99d09fbedba.zip
dev: Implement development web server.
* tissue/web/dev.scm: New file.
-rw-r--r--tissue/web/dev.scm78
1 files changed, 78 insertions, 0 deletions
diff --git a/tissue/web/dev.scm b/tissue/web/dev.scm
new file mode 100644
index 0000000..ba43930
--- /dev/null
+++ b/tissue/web/dev.scm
@@ -0,0 +1,78 @@
+;;; tissue --- Text based issue tracker
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of tissue.
+;;;
+;;; tissue is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; tissue is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with tissue. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (tissue web dev)
+ #:use-module (rnrs io ports)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 filesystem)
+ #:use-module (web request)
+ #:use-module (web response)
+ #:use-module (web server)
+ #:use-module (web uri)
+ #:use-module (xapian xapian)
+ #:use-module (tissue utils)
+ #:use-module (tissue web server)
+ #:use-module (tissue web static)
+ #:export (start-dev-web-server))
+
+(define (handler request body xapian-index css files)
+ "Handle web @var{request} with @var{body} and return two values---the
+response headers and body. See @code{start-dev-web-server} for
+documentation of @var{xapian-index}, @var{css} and @var{files}."
+ (let ((path (uri-path (request-uri request))))
+ (log-request request)
+ (cond
+ ;; Search page
+ ((member path (list "/" "/search"))
+ (search-handler request body xapian-index css))
+ ;; Files
+ ((any (lambda (web-file)
+ (cond
+ ((find (cut string=?
+ (string-append "/" (file-name web-file))
+ <>)
+ (try-paths path))
+ => (cut file <> (file-writer web-file)))
+ (else #f)))
+ files)
+ => (lambda (file)
+ (values `((content-type . ,(mime-type-for-extension
+ (file-name-extension (file-name file)))))
+ (call-with-values open-bytevector-output-port
+ (lambda (port get-bytevector)
+ ((file-writer file) port)
+ (get-bytevector))))))
+ ;; Not found
+ (else
+ (404-response request)))))
+
+(define (start-dev-web-server port xapian-index css files)
+ "Start development web server listening on
+@var{port}. @var{xapian-index} is the path to the Xapian index to
+search in. @var{css} is a URI to a stylesheet. @var{files} is a list
+of @code{<file>} objects describing files to serve."
+ (format (current-error-port)
+ "Tissue development web server listening at http://localhost:~a~%" port)
+ ;; Explicitly dereference the module and handler variable each time
+ ;; so as to support live hacking.
+ (run-server (cut (module-ref (resolve-module '(tissue web dev))
+ 'handler)
+ <> <> xapian-index css files)
+ 'http
+ (list #:port port)))