From 014765cfaa45414a87fc9b5da59a8d9e6c28648e Mon Sep 17 00:00:00 2001
From: Michiel de Mare <michieldemare@gmail.com>
Date: Wed, 28 Aug 2024 09:43:32 +0200
Subject: [PATCH] Don't throw error on release expired lock (#325)

* Don't throw error on release expired lock

* Log error when lock lost in extend

* Added nve suppression
---
 .nvd-suppressions.xml                    |  4 ++++
 src/nl/surf/eduhub_rio_mapper/worker.clj | 10 ++++++----
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/.nvd-suppressions.xml b/.nvd-suppressions.xml
index cc7bafe8..d09d07b2 100644
--- a/.nvd-suppressions.xml
+++ b/.nvd-suppressions.xml
@@ -4,4 +4,8 @@
     <notes>Using clojure higher than 1.9.0 and not earlier as implied by some dependencies.</notes>
     <cve>CVE-2017-20189</cve>
   </suppress>
+  <suppress>
+    <notes>We don't use zgrep</notes>
+    <cve>CVE-2022-1271</cve>
+  </suppress>
 </suppressions>
diff --git a/src/nl/surf/eduhub_rio_mapper/worker.clj b/src/nl/surf/eduhub_rio_mapper/worker.clj
index 5acf13c2..86811d7c 100644
--- a/src/nl/surf/eduhub_rio_mapper/worker.clj
+++ b/src/nl/surf/eduhub_rio_mapper/worker.clj
@@ -62,7 +62,7 @@
         lua-result (car/wcar redis-conn (car/lua lua-script {:k k} {:token token}))]
     (assert (number? lua-result))
     (when (not= 1 lua-result)
-      (throw (ex-info "Lock lost before release!" {:lock-name k})))))
+      (log/error (str "Lock " k " lost before release!")))))
 
 (defn extend-lock!
   "Extend TTL on lock on `queue` with `token` by `ttl-ms`.
@@ -79,7 +79,7 @@
         lua-result (car/wcar redis-conn (car/lua lua-script {:k k} {:token token, :ttl-ms ttl-ms}))]
     (assert (number? lua-result))
     (when (not= 1 lua-result)
-      (throw (ex-info "Lock lost before extend!" {:lock-name k})))))
+      (log/error (str "Lock lost before extend!" {:lock-name k})))))
 
 (defn- queue-key [config queue]
   (prefix-key config (str "queue:" queue)))
@@ -202,7 +202,8 @@
             retryable-fn
             run-job-fn
             set-status-fn]
-     :or {lock-ttl-ms   10000
+     ;; Set lock expiry to 1 minute; locks in production have unexpectedly expired with shorter intervals
+     :or {lock-ttl-ms   60000
           nap-ms        1000}} :worker
     :as                        config}
    stop-atom]
@@ -212,7 +213,8 @@
          (fn? run-job-fn) (fn? set-status-fn)
          (ifn? retryable-fn) (ifn? error-fn) (ifn? queue-fn)]}
 
-  (let [timeout-ms (/ lock-ttl-ms 2)]
+  ;; Extend lock at least each second
+  (let [timeout-ms (min 1000 (/ lock-ttl-ms 2))]
     (loop [queues (occupied-queues config)]
       (if-let [[queue & queues] queues]
         (do