+
+
+(defmacro with-wol-page ((req ent
+ &key (format :html) (precompute t) headers
+ (response-code 200)
+ timeout)
+ &body body)
+ `(if (request-aserve-server ,req)
+ (net.aserve:with-http-response
+ ((aserve-request ,req)
+ (entity-aserve-entity ,ent)
+ :content-type (ml::format-string ,format ,headers)
+ :timeout ,timeout
+ :response
+ (case ,response-code
+ (302 net.aserve::*response-moved-permanently*)
+ (307 net.aserve::*response-temporary-redirect*)
+ (404 net.aserve::*response-not-found*)
+ (otherwise net.aserve::*response-ok*)))
+ (set-cookie ,req ,ent)
+ (net.aserve:with-http-body
+ ((aserve-request ,req)
+ (entity-aserve-entity ,ent)
+ :headers ,headers)
+ (let ((*html-stream* net.html.generator:*html-stream*))
+ ,@body)))
+ (%with-wol-page (,req ,ent :format ,format :precompute ,precompute
+ :headers ,headers
+ :response-string
+ (case ,response-code
+ (302 "302 Moved Permanently")
+ (307 "307 Temporary Redirect")
+ (404 "404 Not Found")
+ (otherwise "200 OK")))
+ ,@body)))
+
+
+(defmacro %with-wol-page ((req ent
+ &key (format :html) (precompute t) headers
+ (response-string "200 OK"))
+ &body body)
+ (declare (ignore req ent))
+ (let ((fmt (gensym "FMT-"))
+ (precomp (gensym "PRE-"))
+ (result (gensym "RES-"))
+ (outstr (gensym "STR-"))
+ (stream (gensym "STRM-"))
+ (hdr (gensym "HDR-")))
+ `(let ((,fmt ,format)
+ (,precomp ,precompute)
+ ,result ,outstr ,stream)
+ (declare (ignorable ,stream))
+ (write-header-line "Status" ,response-string)
+ (write-header-line "Content-Type" (ml::format-string ,fmt ,headers))
+ (dolist (,hdr ,headers)
+ (write-header-line (car ,hdr) (cdr ,hdr)))
+ (unless ,precomp
+ (write-string "end" *wol-stream*)
+ (write-char #\NewLine *wol-stream*))
+ (setq ,outstr
+ (with-output-to-string (,stream)
+ (let ((*html-stream* (if ,precomp
+ ,stream
+ *wol-stream*))
+ (*wol-stream* (if ,precomp
+ ,stream
+ *wol-stream*)))
+ (setq ,result (progn ,@body)))))
+ (cond
+ (,precomp
+ (write-header-line "Content-Length"
+ (write-to-string (length ,outstr)))
+ (write-header-line "Keep-Socket" "1")
+ (write-header-line "Connection" "Keep-Alive")
+ (write-string "end" *wol-stream*)
+ (write-char #\NewLine *wol-stream*)
+ (write-string ,outstr *wol-stream*)
+ (finish-output *wol-stream*)
+ (setq *close-modlisp-socket* nil))
+ (t
+ (finish-output *wol-stream*)
+ (setq *close-modlisp-socket* t)))
+ ,result)))
+
+
+(defun no-url-handler (req ent)
+ (with-wol-page (req ent :response-code 404)
+ (html
+ (:html
+ (:head
+ (:title "404 - NotFound"))
+ (:body
+ (:h1 "Not Found")
+ (:p "The request for "
+ (:b (:write-string (render-uri (request-uri req) nil)))
+ " was not found on this server.")
+ (:hr)
+ (:div (:i "WOL "
+ (:write-string (wol-version-string)))))))))