summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--flash.lisp49
1 files changed, 29 insertions, 20 deletions
diff --git a/flash.lisp b/flash.lisp
index e7222f2..1fedd4a 100644
--- a/flash.lisp
+++ b/flash.lisp
@@ -4,6 +4,8 @@
(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
@@ -26,14 +28,17 @@ expires."
(let* ((key
(or (lzb:request-cookie +flash-cookie-name+) (nuid)))
(now
- (get-universal-time))
- (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)
+ (get-universal-time)))
+ ;; holdign 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
@@ -46,16 +51,20 @@ expires."
"Retrieves and deletes the flashed value with label LABEL associated
with this request. If the value exists, return it. Otherwise return
NIL."
- (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)
- val))
- (t
- ;; drop expired entries and return nil
- (remhash key *flashes*)
- 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)))))