diff --git a/spidercat.scm b/spidercat.scm
index c18bc63..bfec856 100644
--- a/spidercat.scm
+++ b/spidercat.scm
@@ -24,11 +24,13 @@
(prefix uri-common uri:))
+;; Santize text for placement in HTML.
(define (sanitize-html text)
(irregex-replace/all
"{" (spiffy:htmlize text) "{"))
+;; Generate HTML from a template-file, substituting in variables as appropriate.
(define (html-from-template template-file variables-alist)
(let ([text (call-with-input-file template-file
(lambda (in-port) (read-string #f in-port)))])
@@ -42,6 +44,7 @@
text))
+;; Generate HTML for a listing of all rooms the user's joined.
(define (room-listing-html irc-dir)
(html-from-template
"templates/room-list.html"
@@ -58,26 +61,69 @@
(chatdir:channels irc-dir)))))))
+;; Send response for a listing of joined rooms.
(define (http-get-room irc-dir #!optional request continue)
(spiffy:send-response status: 'ok
body: (room-listing-html irc-dir)))
+;; Send response for the / index.
+(define (http-get-root #!optional irc-dir request continue)
+ (spiffy:send-response status: 'ok body: "
Index!!
"))
+
+
+;; Send a 404 response, with disappointed text.
+(define (http-404 #!optional irc-dir request continue)
+ (spiffy:send-response code: 404 body: "Sad!
"))
+
+
+;; Send the static style CSS.
+(define (http-get-style #!optional irc-dir request continue)
+ (spiffy:send-response
+ status: 'ok
+ body: (call-with-input-file "templates/style.css"
+ (lambda (in-port) (read-string #f in-port)))
+ headers: '((content-type "text/css"))))
+
+
+;; An associative list of all GET handlers, to be used by assoc-by-path.
+(define http-get-handlers
+ `(((/ "room") . ,http-get-room)
+ ((/ "style.css") . ,http-get-style)
+ ((/ "*") . ,http-404)
+ ((/ "") . ,http-get-root)))
+
+
+;; Get a pair from an associative list based on the closest match to the
+;; given path. Wild-cards acceptable! For example…
+;; '(/ "dad" "mom") matches, in order of precedence:
+;; '(/ "dad" "mom") '(/ "dad" "*") '(/ "*")
+(define (assoc-by-path path-list alist #!optional (top-level #t))
+ (print path-list)
+ (let* ([our-list=
+ (lambda (a b)
+ (list= equal? a b))]
+ [parent-path (drop-right path-list 1)]
+ [exact
+ (and top-level
+ (assoc path-list
+ alist our-list=))]
+ [inexact
+ (assoc (append parent-path '("*"))
+ alist our-list=)])
+ (or exact
+ inexact
+ (and (not (null? parent-path))
+ (assoc-by-path parent-path alist #f)))))
+
+
;; Handle all GET requests.
(define (http-get irc-dir request continue)
- (let ([path (uri:uri-path (intarweb:request-uri request))])
- (cond [(starts-with? path '(/ "room"))
- (http-get-room irc-dir request continue)]
- [(starts-with? path '(/ "style.css"))
- (spiffy:send-response
- status: 'ok
- body: (call-with-input-file "templates/style.css"
- (lambda (in-port) (read-string #f in-port)))
- headers: '((content-type "text/css")))]
- [(list= equal? path '(/))
- (spiffy:send-response status: 'ok body: "Index ♥
")]
- [#t
- (continue)])))
+ (let* ([path (uri:uri-path (intarweb:request-uri request))]
+ [handler (assoc-by-path path http-get-handlers)])
+ (if handler
+ (apply (cdr handler) (list irc-dir request continue))
+ (continue))))
;; Handle all POST requests.
@@ -112,4 +158,4 @@
list-start))
- (start-server "/home/jaidyn/Chat/IRC/leagueh/")
+;; (start-server "/home/jaidyn/Chat/IRC/leagueh/")