︙ | | | ︙ | |
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
;;======================================================================
;; Database access
;;======================================================================
;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc
(use (srfi 18) extras tcp stack) ;; RADT => use of require-extension?
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 typed-records sql-null)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:)) ;; RADT => prefix??
(include "/nfs/site/disks/icf_fdk_cw_gwa002/srehman/fossil/dbi/dbi.scm")
(import (prefix dbi dbi:))
(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
|
|
|
|
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
;;======================================================================
;; Database access
;;======================================================================
;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc
(use (srfi 18) extras tcp stack)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 typed-records sql-null matchable)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(include "/nfs/site/disks/icf_fdk_cw_gwa002/srehman/fossil/dbi/dbi.scm")
(import (prefix dbi dbi:))
(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
|
︙ | | | ︙ | |
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
(db:dbdat-get-db dbdat)
dbstruct))
(use-mutex (> *api-process-request-count* 25)))
(if (and use-mutex
(common:low-noise-print 120 "over-50-parallel-api-requests"))
(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
(if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*))
(debug:print-info 0 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*))
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print-error 0 *default-log-port* "sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
;; there is no recovering at this time. exit
(exit 50))
|
|
|
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
(db:dbdat-get-db dbdat)
dbstruct))
(use-mutex (> *api-process-request-count* 25)))
(if (and use-mutex
(common:low-noise-print 120 "over-50-parallel-api-requests"))
(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
(if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*))
(debug:print-info 2 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*))
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print-error 0 *default-log-port* "sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
;; there is no recovering at this time. exit
(exit 50))
|
︙ | | | ︙ | |
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
'("comment" "TEXT")
'("fail_count" "INTEGER")
'("pass_count" "INTEGER"))
(list "test_meta"
'("id" "INTEGER" 'key)
'("testname" "TEXT")
'("owner" "TEXT")
'("description" "TEXT")
'("reviewed" "INTEGER")
'("iterated" "TEXT")
'("avg_runtime" "REAL")
'("avg_disk" "REAL")
'("tags" "TEXT")
'("jobgroup" "TEXT")))))
(define (db:sync-all-tables-list dbstruct)
|
>
|
|
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
|
'("comment" "TEXT")
'("fail_count" "INTEGER")
'("pass_count" "INTEGER"))
(list "test_meta"
'("id" "INTEGER" 'key)
'("testname" "TEXT")
'("author" "TEXT")
'("owner" "TEXT")
'("description" "TEXT")
'("reviewed" "TEXT")
'("iterated" "TEXT")
'("avg_runtime" "REAL")
'("avg_disk" "REAL")
'("tags" "TEXT")
'("jobgroup" "TEXT")))))
(define (db:sync-all-tables-list dbstruct)
|
︙ | | | ︙ | |
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
|
"\"\n")
(exit) ;; we can not safely continue when a db was corrupted - even if fixed.
)
;; test read/write access to the database
(let ((db (dbi:open 'sqlite3 (cons (cons ('dbname dbpath) '())))))
(cond
((equal? fname "megatest.db")
(sqlite3:executeute db "DELETE FROM tests WHERE state='DELETED';"))
((equal? fname "main.db")
(sqlite3:executeute db "DELETE FROM runs WHERE state='deleted';"))
((string-match "\\d.db" fname)
(sqlite3:executeute db "UPDATE tests SET state='DELETED' WHERE state='DELETED';"))
((equal? fname "monitor.db")
(sqlite3:executeute "DELETE FROM servers WHERE state LIKE 'defunct%';"))
(else
(sqlite3:executeute db "vacuum;")))
(dbi:close db)
#t))))))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
;;
;; if last-update specified ("field-name" . time-in-seconds)
;; then sync only records where field-name >= time-in-seconds
|
|
|
|
|
|
|
|
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
|
"\"\n")
(exit) ;; we can not safely continue when a db was corrupted - even if fixed.
)
;; test read/write access to the database
(let ((db (dbi:open 'sqlite3 (cons (cons ('dbname dbpath) '())))))
(cond
((equal? fname "megatest.db")
(sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';"))
((equal? fname "main.db")
(sqlite3:execute db "DELETE FROM runs WHERE state='deleted';"))
((string-match "\\d.db" fname)
(sqlite3:execute db "UPDATE tests SET state='DELETED' WHERE state='DELETED';"))
((equal? fname "monitor.db")
(sqlite3:execute "DELETE FROM servers WHERE state LIKE 'defunct%';"))
(else
(sqlite3:execute db "vacuum;")))
(sqlite3:finalize! db)
#t))))))
;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
;; db's are dbdat's
;;
;; if last-update specified ("field-name" . time-in-seconds)
;; then sync only records where field-name >= time-in-seconds
|
︙ | | | ︙ | |
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
|
(if (not (launch:setup))
(debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
(let* ((mtdb (dbr:dbstruct-mtdb dbstruct))
(tmpdb (db:get-db dbstruct))
(refndb (dbr:dbstruct-refndb dbstruct))
(slave-dbs (dbr:dbstruct-slave-dbs dbstruct))
(allow-cleanup #t) ;; (if run-ids #f #t))
(tdbdat (tasks:open-db))
(servers (tasks:get-all-servers (db:delay-if-busy tdbdat)))
(data-synced 0)) ;; count of changed records (I hope)
;; kill servers
(if (member 'killservers options)
(for-each
(lambda (server)
(tasks:server-delete-record (db:delay-if-busy tdbdat) (vector-ref server 0) "dbmigration")
(tasks:kill-server (vector-ref server 2)(vector-ref server 1)))
servers))
;; clear out junk records
;;
(if (member 'dejunk options)
(begin
(db:delay-if-busy mtdb) ;; ok to delay on mtdb
|
|
|
|
>
|
|
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
|
(if (not (launch:setup))
(debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.")
(let* ((mtdb (dbr:dbstruct-mtdb dbstruct))
(tmpdb (db:get-db dbstruct))
(refndb (dbr:dbstruct-refndb dbstruct))
(slave-dbs (dbr:dbstruct-slave-dbs dbstruct))
(allow-cleanup #t) ;; (if run-ids #f #t))
;; (tdbdat (tasks:open-db))
(servers (server:get-list *toppath*)) ;; (tasks:get-all-servers (db:delay-if-busy tdbdat)))
(data-synced 0)) ;; count of changed records (I hope)
;; kill servers
(if (member 'killservers options)
(for-each
(lambda (server)
(match-let (((mod-time host port start-time pid) server))
(if (and host pid)
(tasks:kill-server host pid))))
servers))
;; clear out junk records
;;
(if (member 'dejunk options)
(begin
(db:delay-if-busy mtdb) ;; ok to delay on mtdb
|
︙ | | | ︙ | |
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
|
(lambda (run-id)
(set! run-ids (cons run-id run-ids)))
db
"SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;")
(reverse run-ids)))))
;; get some basic run stats
;;
;; ( (runname (( state count ) ... ))
;; ( ...
(define (db:get-run-stats dbstruct)
(let* ((totals (make-hash-table))
(curr (make-hash-table))
(res '())
(runs-info '()))
;; First get all the runname/run-ids
(db:with-db
|
>
>
|
>
|
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
|
(lambda (run-id)
(set! run-ids (cons run-id run-ids)))
db
"SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;")
(reverse run-ids)))))
;; get some basic run stats
;;
;; data structure:
;;
;; ( (runname (( state count ) ... ))
;; ( ...
;;
(define (db:get-run-stats dbstruct)
(let* ((totals (make-hash-table))
(curr (make-hash-table))
(res '())
(runs-info '()))
;; First get all the runname/run-ids
(db:with-db
|
︙ | | | ︙ | |