Database locking: Tcl: Limit number of retries

If there is something fundamentally wrong, don't just sit looping
around every 500ms.

Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>

diff --git a/tcl/JobDB-Executive.tcl b/tcl/JobDB-Executive.tcl
index 8e45ea7b1ea6136521594eaf7b74f3d8154441e1..7dba49720879b0b0adf720f1788915beaf2a6a07 100644 (file)
--- a/tcl/JobDB-Executive.tcl
+++ b/tcl/JobDB-Executive.tcl
@@ -224,6 +224,8 @@ proc step-set-status {flight job stepno st} {
 }
 
 proc transaction {tables script} {
+    global errorInfo errorCode
+    set retries 100
     db-open
     while 1 {
         set ol {}
@@ -239,6 +241,10 @@ proc transaction {tables script} {
            } emsg]} {
                puts "commit failed: $emsg; retrying ..."
                db-execute ROLLBACK
+               if {[incr retries -1] <= 0} {
+                   error \
+ "commit failed, too many retries: $emsg\n$errorInfo\n$errorCode\n"
+               }
                after 500
                continue
            }