Overview
| Comment: | Protect all transactions with mutex. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v2.0001 |
| Files: | files | file ages | folders |
| SHA1: |
3454f1583b337a57b8deb23b5f6f191f |
| User & Date: | matt on 2022-02-12 20:16:20 |
| Other Links: | branch diff | manifest | tags |
Context
|
2022-02-14
| ||
| 17:31 | removed setting of \*toppath\* from the scheme config eval, added import of testsmod and srfi-69 to config:std-imports. check-in: 9b51a90460 user: mmgraham tags: v2.0001 | |
|
2022-02-12
| ||
| 20:16 | Start over on dashboard check-in: e993580c2e user: matt tags: v2.0001-dashboard | |
| 20:16 | Protect all transactions with mutex. check-in: 3454f1583b user: matt tags: v2.0001 | |
|
2022-02-11
| ||
| 15:20 | turned off env-to-use in scheme eval, removed erroneous setting of toppath check-in: aad18f28ae user: mmgraham tags: v2.0001 | |
Changes
Modified dbmod.scm from [8c09a0af38] to [ea76b7f54c].
| ︙ | ︙ | |||
4176 4177 4178 4179 4180 4181 4182 |
(item-path (db:test-get-item-path testdat))
(tl-testdat (db:get-test-info dbstruct run-id test-name ""))
(tl-test-id (if tl-testdat
(db:test-get-id tl-testdat)
#f)))
(if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
(db:general-call dbstruct 'set-test-start-time run-id (list test-id)))
| < > | 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 |
(item-path (db:test-get-item-path testdat))
(tl-testdat (db:get-test-info dbstruct run-id test-name ""))
(tl-test-id (if tl-testdat
(db:test-get-id tl-testdat)
#f)))
(if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
(db:general-call dbstruct 'set-test-start-time run-id (list test-id)))
(db:with-db
dbstruct run-id #f
(lambda (db)
(mutex-lock! *db-transaction-mutex*)
(let ((tr-res
(sqlite3:with-transaction
db
(lambda ()
;; NB// Pass the db so it is part fo the transaction
;; this call sets the item state/status
(db:db-test-set-state-status db run-id test-id state status comment)
|
| ︙ | ︙ | |||
4202 4203 4204 4205 4206 4207 4208 |
(conc
(with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | "))
state-status-counts))); end debug:print
(if tl-test-id
(db:db-test-set-state-status db run-id tl-test-id newstate newstatus #f)) ;; we are still in the transaction - must access the db and not the dbstruct
))))))
| | | 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 |
(conc
(with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | "))
state-status-counts))); end debug:print
(if tl-test-id
(db:db-test-set-state-status db run-id tl-test-id newstate newstatus #f)) ;; we are still in the transaction - must access the db and not the dbstruct
))))))
(mutex-unlock! *db-transaction-mutex*)
(if (and test-id state status (equal? status "AUTO"))
(db:test-data-rollup dbstruct run-id test-id status))
tr-res)))
;; this was moved out of test-set-state-status
(mt:process-triggers dbstruct run-id test-id state status)))
|
| ︙ | ︙ | |||
4269 4270 4271 4272 4273 4274 4275 | "\n--> newstatus "newstatus "\n\n") ;; NB// Pass the db so it is part of the transaction (list newstate newstatus)))) (define (db:set-state-status-and-roll-up-run dbstruct run-id curr-state curr-status) | < | | | > | | | | | | | | | | | | | | | | < | 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 |
"\n--> newstatus "newstatus
"\n\n")
;; NB// Pass the db so it is part of the transaction
(list newstate newstatus))))
(define (db:set-state-status-and-roll-up-run dbstruct run-id curr-state curr-status)
(db:with-db
dbstruct #f #f
(lambda (db)
(mutex-lock! *db-transaction-mutex*)
(let ((tr-res
(sqlite3:with-transaction
db
(lambda ()
(let* ((state-status-counts (db:get-all-state-status-counts-for-run dbstruct run-id))
(state-statuses (db:roll-up-rules state-status-counts #f #f ))
(newstate (car state-statuses))
(newstatus (cadr state-statuses)))
(if (or (not (eq? newstate curr-state)) (not (eq? newstatus curr-status)))
(begin
(db:set-run-state-status dbstruct run-id newstate newstatus)
#t) ;; changes made
#f) ;; no changes
)))))
(mutex-unlock! *db-transaction-mutex*)
tr-res))))
(define (db:get-all-state-status-counts-for-run dbstruct run-id)
(let* ((test-count-recs (db:with-db
dbstruct #f #f
(lambda (db)
(sqlite3:map-row
(lambda (state status count)
|
| ︙ | ︙ | |||
5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 |
;; run this one in a transaction where first check if host:port is taken
(define (db:register-server dbstruct host port servkey pid ipaddr apath dbname)
(db:with-db
dbstruct
#f #f
(lambda (db)
(sqlite3:with-transaction
db
(lambda ()
| > | | | | | | | | | > > > | | | | | | | | | | | | | | > > | 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 5867 5868 5869 5870 5871 5872 5873 5874 5875 5876 5877 5878 5879 5880 5881 5882 5883 5884 5885 5886 5887 5888 |
;; run this one in a transaction where first check if host:port is taken
(define (db:register-server dbstruct host port servkey pid ipaddr apath dbname)
(db:with-db
dbstruct
#f #f
(lambda (db)
(mutex-lock! *db-transaction-mutex*)
(sqlite3:with-transaction
db
(lambda ()
(let* ((sinfo (db:get-server-info dbstruct apath dbname))
(res (if sinfo
(begin
(debug:print-info 0 *default-log-port* "Server already running at "sinfo ", while trying to register server " host":"port)
#f) ;; server already registered
(begin
(sqlite3:execute db "INSERT INTO servers (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
host port servkey pid ipaddr apath dbname)
(db:get-server-info dbstruct apath dbname)))))
(mutex-unlock! *db-transaction-mutex*)
res))))))
;; run this one in a transaction where first check if host:port is taken
(define (db:deregister-server dbstruct host port servkey pid ipaddr apath dbname)
(db:with-db
dbstruct
#f #f
(lambda (db)
(mutex-lock! *db-transaction-mutex*)
(let ((res (sqlite3:with-transaction
db
(lambda ()
(let* ((sinfo (db:get-server-info dbstruct apath dbname)))
(if (not sinfo)
(begin
(debug:print-info 0 *default-log-port* "Server already removed for "apath", "dbname) ;; at "sinfo ", while trying to register server " host":"port)
#f) ;; server already deregistered
(begin
(sqlite3:execute db "DELETE FROM servers WHERE apath=? AND dbname=?;" ;; (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
;; host port servkey pid ipaddr
apath dbname)
#;(db:get-server-info dbstruct apath dbname)
'done)))))))
(mutex-unlock! *db-transaction-mutex*)
res))))
(define (db:get-server-info dbstruct apath dbname)
(db:with-db
dbstruct
#f #f
(lambda (db)
(sqlite3:fold-row
|
| ︙ | ︙ |