From cd486030b6e5c92446a0d5a2f502fd2014b6334e Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Thu, 26 Jan 2023 06:22:42 -0800
Subject: Refactor: flash data system made threadsafe

---
 flash.lisp | 49 +++++++++++++++++++++++++++++--------------------
 1 file changed, 29 insertions(+), 20 deletions(-)

(limited to 'flash.lisp')

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)))))
 
-- 
cgit v1.2.3