summaryrefslogtreecommitdiff
path: root/flash.lisp
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2023-03-05 16:36:44 -0800
committercolin <colin@cicadas.surf>2023-03-05 16:36:44 -0800
commitf7abccc38ceda7024ca375d34ed88f4fb561ef02 (patch)
tree432d6673e9e8d53b5fbc43e25a684b654f6dea1d /flash.lisp
parent89d0d687992b41f7f0f9b0d3da19d9d587f06010 (diff)
Reorganized codebase
Diffstat (limited to 'flash.lisp')
-rw-r--r--flash.lisp71
1 files changed, 0 insertions, 71 deletions
diff --git a/flash.lisp b/flash.lisp
deleted file mode 100644
index b655fa0..0000000
--- a/flash.lisp
+++ /dev/null
@@ -1,71 +0,0 @@
-;;;; flash.lisp -- communicating between page loads
-
-(in-package :dnd)
-
-(defvar *flashes*
- (make-hash-table :test #'equal :synchronized t))
-(defvar *flash-lock*
- (bt:make-lock "flash lock"))
-
-(defparameter +flash-cookie-name+ "DNDFLASHKEY")
-(defparameter +flash-value-lifetime+ 10
- "Number of seconds a flashed value lives.")
-
-(defstruct flash-entry
- "TABLE is a PLIST"
- (timestamp (get-universal-time))
- (table nil))
-
-(defun flash-entry-alive-p (entry)
- "Returns T if ENTRY has not expired."
- (<= (get-universal-time)
- (+ (flash-entry-timestamp entry) +flash-value-lifetime+)))
-
-(defun flash (label value)
- "A flash is a one-time inter-request value. Once stored, it can only
-be retrieved once. And if not retrieved in a short period of time, it
-expires."
- (check-type label keyword)
- (let* ((key
- (or (lzb:request-cookie +flash-cookie-name+) (nuid)))
- (now
- (get-universal-time)))
- ;; holding a lock here b/c I do stuff in between getting an entry
- ;; and writing to it.
- (bt:with-lock-held (*flash-lock*)
- (let ((entry
- (or (gethash key *flashes*)
- (make-flash-entry))))
- ;; update the entry
- (setf (flash-entry-timestamp entry) now
- (getf (flash-entry-table entry) label) value
- (gethash key *flashes*) entry)))
- ;; set the cookie, updating its expiration if necessary
- (lzb:set-response-cookie
- +flash-cookie-name+ key
- ;; TODO: generalize domain
- :path "/" :domain "localhost"
- :expires (+ +flash-value-lifetime+ now))))
-
-
-(defun flashed-value (label)
- "Retrieves and deletes the flashed value with label LABEL associated
-with this request. If the value exists, return it. Otherwise return
-NIL."
- (bt:with-lock-held (*flash-lock*)
- (a:when-let* ((key (lzb:request-cookie +flash-cookie-name+))
- (entry (gethash key *flashes*)))
- (cond
- ((flash-entry-alive-p entry)
- (let ((val (getf (flash-entry-table entry) label)))
- ;; can only retrieve once
- (remf (flash-entry-table entry) label)
- ;; might as well delete the entry if its table is empty.
- (when (null (flash-entry-table entry))
- (remhash key *flashes*))
- val))
- (t
- ;; drop expired entries and return nil
- (remhash key *flashes*)
- nil)))))
-