108 lines
4.5 KiB
Common Lisp
108 lines
4.5 KiB
Common Lisp
;;;; web.lisp
|
|
|
|
(in-package :lspx)
|
|
|
|
(defparameter *static-files* (make-hash-table :test 'equal)
|
|
"cache of our static file attributes")
|
|
|
|
(defun serve-static-file (path)
|
|
(log:debug "Serving static file at ~A" path)
|
|
(if (gethash path *static-files*)
|
|
(list 200 (gethash path *static-files*) (translate-logical-pathname path))
|
|
|
|
(with-open-file (stream path :direction :input)
|
|
(log:debug "Caching static file info...")
|
|
(list 200
|
|
(setf (gethash path *static-files*)
|
|
`(:content-type ,(mimes:mime path)
|
|
:content-length ,(file-length stream)
|
|
:cache-control "public, max-age=31556926"
|
|
:vary "Accept-Encoding" ;; https://www.maxcdn.com/blog/accept-encoding-its-vary-important/
|
|
:last-modified ,(local-time:format-rfc1123-timestring nil
|
|
(local-time:universal-to-timestamp (file-write-date path)))))
|
|
(translate-logical-pathname path)))))
|
|
|
|
(defun serve-dynamic-file (request-path path)
|
|
"serves a dynamic LSPX file at PATH
|
|
|
|
checks if the file needs to be re/compiled first.
|
|
if it does, we compile it and load it before FUNCALL-ing the page's render function"
|
|
(let ((faslpath (generate-filepath "cache" request-path ".fasl"))
|
|
(function-name (generate-page-function-name :path path :intern t)))
|
|
|
|
(log:debug "Request path: ~A ;; Serving file: ~A"
|
|
request-path path)
|
|
|
|
;; if we already have a compiled version of our page file
|
|
;; we check to ensure it's not out of date. if it is we
|
|
;; delete the fasl and recompile it.
|
|
;; if the fasl doesn't exist, we short circuit the logic and
|
|
;; don't try to delete the file
|
|
(unless (> (handler-case (file-write-date faslpath)
|
|
(file-error () -1))
|
|
(file-write-date path))
|
|
(ensure-directories-exist faslpath)
|
|
|
|
(log:debug "FASL ~:[doesn't exist~;out of date~]. ~:[C~;Rec~]ompiling file to ~A"
|
|
(uiop:file-exists-p faslpath)
|
|
(uiop:file-exists-p faslpath)
|
|
faslpath)
|
|
|
|
(let* ((*package* #.(find-package :lspx.user))
|
|
(*readtable* (copy-readtable nil))
|
|
(*standard-output* (make-broadcast-stream))
|
|
(*error-output* (if (log:debug) *error-output*
|
|
(make-broadcast-stream)))
|
|
(*read-eval* t))
|
|
(set-macro-character #\< #'read-html-tag)
|
|
|
|
;; i cannot get COMPILE-FILE to *not* print to *stdout*
|
|
;; i've tried binding it to a new broadcast stream
|
|
;; and binding it to a string
|
|
;; no clue! this must do some Special Bullshit:tm:
|
|
(compile-file path
|
|
:block-compile t
|
|
:entry-points (list function-name)
|
|
:output-file faslpath
|
|
:print nil
|
|
:progress nil
|
|
:verbose nil)
|
|
(load faslpath)))
|
|
|
|
`(200 nil (,(funcall function-name)))))
|
|
|
|
(defun web-handler (env)
|
|
"handle the request by searching for a lisp file that matches the path provided in the url
|
|
|
|
if we find the file we compile it using block compilation and load the fasl
|
|
if we cannot find the file we throw an error"
|
|
|
|
(destructuring-bind (&key path-info request-method &allow-other-keys) env
|
|
|
|
(unless (member request-method '(:head :get))
|
|
(log:debug "Dropping request with unsupported method ~A" request-method)
|
|
(return-from web-handler (501-handler)))
|
|
|
|
(with-printable-backtrace
|
|
(let ((filepath (generate-filepath (if (static-asset-p path-info)
|
|
"static" "pages")
|
|
path-info
|
|
|
|
(if (static-asset-p path-info)
|
|
(str:concat "." (pathname-type path-info))
|
|
".lspx"))))
|
|
|
|
(if (uiop:file-exists-p filepath)
|
|
|
|
;; if we have a file at the requested path
|
|
;; we check to see if its static or not
|
|
(if (static-asset-p path-info)
|
|
|
|
;; if the file is a static asset we return it straight up
|
|
(serve-static-file filepath)
|
|
|
|
;; if the filepath points to a lspx file we compile it and
|
|
;; render it's page
|
|
(serve-dynamic-file path-info filepath))
|
|
(404-handler))))))
|