Megatest

Check-in [2180fd1986]
Login
Overview
Comment:Improved db stats collection and switch to using WAL in /tmp
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.70
Files: files | file ages | folders
SHA1: 2180fd19863e39c88125d56ce7b22a7b5d11d4a0
User & Date: matt on 2022-10-23 10:57:41
Other Links: branch diff | manifest | tags
Context
2022-10-23
19:40
Hack to turn off multi-db-handles check-in: ffc3c2a09d user: matt tags: v1.70
10:57
Improved db stats collection and switch to using WAL in /tmp check-in: 2180fd1986 user: matt tags: v1.70
2022-09-30
18:13
Updated megatest version to 1.7007 check-in: 11f871fa5c user: mmgraham tags: v1.70, v1.7007
Changes

Modified api.scm from [8aaec3e750] to [2a41118e6c].

364
365
366
367
368
369
370
371
372
373






374
375
376
377
378
379
380
364
365
366
367
368
369
370



371
372
373
374
375
376
377
378
379
380
381
382
383







-
-
-
+
+
+
+
+
+







		   (else
		    (debug:print 0 *default-log-port* "ERROR: bad api call " cmd)
		    (conc "ERROR: BAD api call " cmd))))))

       
       ;; save all stats
       (let ((delta-t (- (current-milliseconds)
			 start-t)))
	 (hash-table-set! *db-api-call-time* cmd
			  (cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
			 start-t))
	     (modified-cmd (if (eq? cmd 'general-call)
			       (string->symbol (conc "general-call-" (car params)))
			       cmd)))
	 (hash-table-set! *db-api-call-time* modified-cmd
			  (cons delta-t (hash-table-ref/default *db-api-call-time* modified-cmd '()))))
       (if writecmd-in-readonly-mode
           (begin
             #;(common:telemetry-log (conc "api-out:"(->string cmd))
                                   payload: `((params . ,params)
                                              (ok-res . #t)))
	     (vector #f res))
           (begin

Modified db.scm from [131d871139] to [aa31c08948].

3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615








3616
3617
3618
3619
3620
3621
3622
3601
3602
3603
3604
3605
3606
3607








3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







		     (if (or (not (eq? newstate curr-state)) (not (eq?  newstatus curr-status)))
			 (db:set-run-state-status db run-id newstate newstatus )))))))
         (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 (dbdat db)
                                    (sqlite3:map-row
                                     (lambda (state status count)
                                        (make-dbr:counts state: state status: status count: count))
                                     db
                                     "SELECT state,status,count(id) FROM tests WHERE run_id=?  GROUP BY state,status;"
                                     run-id )))))
                          dbstruct #f #f
                          (lambda (dbdat db)
                            (sqlite3:map-row
                             (lambda (state status count)
                               (make-dbr:counts state: state status: status count: count))
                             db
                             "SELECT state,status,count(id) FROM tests WHERE run_id=?  GROUP BY state,status;"
                             run-id )))))
   test-count-recs))


;; BBnote: db:get-all-state-status-counts-for-test returns dbr:counts object aggregating state and status of items of a given test, *not including rollup state/status*
;;
;; NOTE: This is called within a transaction
;;

Modified dbfile.scm from [3c40c08f5f] to [162c384c6c].

252
253
254
255
256
257
258
259

260
261
262
263
264
265
266
252
253
254
255
256
257
258

259
260
261
262
263
264
265
266







-
+







;;
(define (dbfile:init-subdb dbstruct run-id init-proc)
  (let* ((dbname    (dbfile:run-id->dbname run-id))
	 (areapath  (dbr:dbstruct-areapath dbstruct))
	 (tmppath   (dbr:dbstruct-tmppath  dbstruct))
	 (mtdbpath  (dbfile:run-id->path areapath run-id))
	 (tmpdbpath (dbfile:run-id->path tmppath run-id))
	 (mtdbdat   (dbfile:open-sqlite3-db mtdbpath init-proc))
	 (mtdbdat   (dbfile:open-sqlite3-db mtdbpath init-proc sync-mode: 0 journal-mode: #f)) ;; "WAL"))
	 (newsubdb  (make-dbr:subdb dbname:    dbname
				    mtdbfile:  mtdbpath
				    tmpdbfile: tmpdbpath
				    mtdbdat:   mtdbdat)))
    (dbfile:set-subdb dbstruct run-id newsubdb)
    newsubdb)) ;; return the new subdb - but shouldn't really use it

285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311

312
313
314

315
316
317
318
319
320
321
285
286
287
288
289
290
291

292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

311
312
313

314
315
316
317
318
319
320
321







-
+


















-
+


-
+







	  (dbfile:init-subdb dbstruct run-id init-proc)
	  (dbfile:open-db dbstruct run-id init-proc))
	(let* ((dbdat (dbfile:get-dbdat dbstruct run-id)))
	  (if dbdat
	      dbdat
	      (let* ((tmppath   (dbr:dbstruct-tmppath  dbstruct))
		     (tmpdbpath (dbfile:run-id->path tmppath run-id)))
		(dbfile:open-sqlite3-db tmpdbpath init-proc)))))))
		(dbfile:open-sqlite3-db tmpdbpath init-proc sync-mode: 0 journal-mode: "WAL")))))))

;; COMBINE dbfile:open-sqlite-db and dbfile:lock-create-open
;;

;; this stuff is for initial debugging, please remove it when
;; this code stabilizes
(define *dbopens* (make-hash-table))
(define (dbfile:inc-db-open dbfile)
  (let* ((curr-opens-count (+ (hash-table-ref/default *dbopens* dbfile 0) 1)))
    ;; (if (> curr-opens-count 1) ;; this should NOT be happening
	;; (dbfile:print-err "INFO: db "dbfile" has been opened "curr-opens-count" times!"))
    (hash-table-set! *dbopens* dbfile curr-opens-count)
    curr-opens-count))

;; Open the classic megatest.db file (defaults to open in toppath)
;;
;;   NOTE: returns a dbdat not a dbstruct!
;;
(define (dbfile:open-sqlite3-db dbpath init-proc)
(define (dbfile:open-sqlite3-db dbpath init-proc #!key (sync-mode 0)(journal-mode #f))
  (let* ((dbexists     (file-exists? dbpath))
	 (write-access (file-write-access? dbpath))
	 (db           (dbfile:cautious-open-database dbpath init-proc))) #;(sqlite3:open-database dbpath)
	 (db           (dbfile:cautious-open-database dbpath init-proc sync-mode journal-mode))) #;(sqlite3:open-database dbpath)
    (dbfile:inc-db-open dbpath)
    ;; (init-proc db)
    (make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))

(define (dbfile:print-and-exit . params)
  (with-output-to-port
      (current-error-port)
467
468
469
470
471
472
473
474

475
476
477
478
479
480
481
482
483



484
485
486
487
488
489
490
491
492
493
494
495
496
497

498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
















513
514

515
516




517
518
519
520
521
522
523
524
525
526
467
468
469
470
471
472
473

474

475
476
477
478
479
480
481

482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497

498
499
500













501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516


517


518
519
520
521



522
523
524
525
526
527
528







-
+
-







-
+
+
+













-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
+
+
+
+
-
-
-







	  (dbfile:print-err "INFO: db:sync-all-tables-list done.")
	  )
	(dbfile:print-err " db, " (dbr:dbdat-dbfile tmpdb) " already exists or fresh enough, not propogating data from\n     " (dbr:dbdat-dbfile mtdb) " mod time delta: " modtimedelta) )
    ;; (db:multi-db-sync subdb 'old2new))  ;; migrate data from megatest.db automatically
    tmpdb))
		

(define (dbfile:cautious-open-database fname init-proc #!optional (tries-left 500))
(define (dbfile:cautious-open-database fname init-proc sync-mode journal-mode #!optional (tries-left 500))

  (let* ((busy-file  (conc fname"-journal"))
	 (delay-time (* (- 51 tries-left) 1.1))
      	 (write-access (file-write-access? fname))
         (dir-access (file-write-access? (pathname-directory fname)))
         (retry      (lambda ()
		       (thread-sleep! delay-time)
		       (if (> tries-left 0)
			   (dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
			   (dbfile:cautious-open-database fname init-proc
							  sync-mode: sync-mode journal-mode: journal-mode
							  (- tries-left 1))))))
    (assert (>= tries-left 0) (conc "FATAL: too many attempts in dbfile:cautious-open-database of "fname", giving up."))

    (if (and (file-write-access? fname)
	     (file-exists? busy-file))
	(begin
	  (if (common:low-noise-print 120 busy-file)
	      (dbfile:print-err "INFO: dbfile:cautious-open-database: journal file "
				busy-file" exists, trying again in few seconds."))
	  (thread-sleep! 1)
	  (if (eq? tries-left 2)
	      (begin
	  	(dbfile:print-err "INFO: forcing journal rollup "busy-file)
	  	(dbfile:brute-force-salvage-db fname)))
	  (dbfile:cautious-open-database fname init-proc (- tries-left 1)))
	  (dbfile:cautious-open-database fname init-proc sync-mode: sync-mode journal-mode: journal-mode (- tries-left 1)))

	(let* ((result (condition-case
		         (if dir-access
			   (dbfile:with-simple-file-lock
			    (conc fname ".lock")
			    (lambda ()
			      (let* ((db-exists (file-exists? fname))
				     (db        (sqlite3:open-database fname))) ;; creates an empty db if it did not already exist.
                                (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 30000))
                                (sqlite3:execute db (conc "PRAGMA synchronous = 0;"))
				(if (and init-proc (not db-exists))
				    (init-proc db))
				db)))
                            (begin
                               (if (file-exists? fname )
		           (if dir-access
			       (dbfile:with-simple-file-lock
				(conc fname ".lock")
				(lambda ()
				  (let* ((db-exists (file-exists? fname))
					 (db        (sqlite3:open-database fname))) ;; creates an empty db if it did not already exist.
                                    (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 30000))
				    (if sync-mode
					(sqlite3:execute db (conc "PRAGMA synchronous = "sync-mode";")))
				    (if journal-mode
					(sqlite3:execute db (conc "PRAGMA journal_mode = "journal-mode";")))
				    (if (and init-proc (not db-exists))
					(init-proc db))
				    db)))
                               (begin
				 (if (file-exists? fname )
                                   (begin
                                      (sqlite3:open-database fname)
                                     (let ((db (sqlite3:open-database fname)))
                                   )
                                   (print "file doesn't exist: " fname)
				       ;; pragmas synchronous not needed because this db is used read-only
				       ;; (sqlite3:execute db (conc "PRAGMA synchronous = "mode";")
				       db )
                                     (print "file doesn't exist: " fname))))
                               )
                            )
                         )
			 (exn (io-error)
			      (dbfile:print-err exn "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again.")
			      (retry))
			 (exn (corrupt)
			      (dbfile:print-err exn "ERROR: database " fname " is corrupt. Repair it to proceed.")
			      (retry))
			 (exn (busy)
597
598
599
600
601
602
603
604
605


606
607
608
609
610
611
612
599
600
601
602
603
604
605


606
607
608
609
610
611
612
613
614







-
-
+
+







	(let* ((dbname    (conc dbpath "/no-sync.db"))
	       (db-exists (file-exists? dbname))
	       (init-proc (lambda (db)
			    (if (not db-exists)
				(begin
				  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));"))
				)))
	       (db        (dbfile:cautious-open-database dbname init-proc))) ;; (sqlite3:open-database dbname)))
	  (sqlite3:execute db "PRAGMA synchronous = 0;")
	       (db        (dbfile:cautious-open-database dbname init-proc 0 "WAL"))) ;; (sqlite3:open-database dbname)))
	  ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	  (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
	  (set! *no-sync-db* db)
	  db))))

(define (db:no-sync-set db var val)
  (sqlite3:execute db "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))