Megatest

Check-in [e607892c7d]
Login
Overview
Comment:Merged fork
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: e607892c7d38fb47d2392677bbb3f92edc52da4b
User & Date: mrwellan on 2023-10-20 05:12:31
Other Links: branch diff | manifest | tags
Context
2023-10-24
12:40
merged fork check-in: e51e15945e user: mmgraham tags: v1.80
2023-10-20
05:12
Merged fork check-in: e607892c7d user: mrwellan tags: v1.80
2023-10-19
18:55
changed a debug msg to level2, increased delay from 0.5 to 2 secs Leaf check-in: 60b31fb56a user: mmgraham tags: v1.80-processes
2023-10-14
20:19
removed a bit of not-needed junk from rmt.scm Leaf check-in: ffe3df4e65 user: matt tags: v1.80-matt-fixme
Changes

Modified api.scm from [5fa313076b] to [13a08c65d1].

369
370
371
372
373
374
375

376

377
378
379
380
381
382
383
    ((dec-var)                      (apply db:dec-var dbstruct params))
    ((del-var)                      (apply db:del-var dbstruct params))
    ((add-var)                      (apply db:add-var dbstruct params))

    ((insert-run)                   (apply db:insert-run dbstruct params))

    ;; STEPS

    ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))

    ((delete-steps-for-test!)       (apply db:delete-steps-for-test! dbstruct params))
    
    ;; TEST DATA
    ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
    ((csv->test-data)               (apply db:csv->test-data dbstruct params))

    ;; MISC







>
|
>







369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
    ((dec-var)                      (apply db:dec-var dbstruct params))
    ((del-var)                      (apply db:del-var dbstruct params))
    ((add-var)                      (apply db:add-var dbstruct params))

    ((insert-run)                   (apply db:insert-run dbstruct params))

    ;; STEPS
    ((teststep-set-status!)
     ;; (apply db:teststep-set-status! dbstruct params))
     (db:add-cached-write dbstruct db:teststep-set-status! run-id params))
    ((delete-steps-for-test!)       (apply db:delete-steps-for-test! dbstruct params))
    
    ;; TEST DATA
    ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
    ((csv->test-data)               (apply db:csv->test-data dbstruct params))

    ;; MISC

Modified db.scm from [b1837f1312] to [0a367c507f].

2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
     (sqlite3:execute 
      db
      "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
      test-id teststep-name state-in status-in (current-seconds)
      (if comment comment "")
      (if logfile logfile "")))))



(define (db:delete-steps-for-test! dbstruct run-id test-id)
  ;; TODO: figure out why status is the key field rather than state (note:  CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state) )
  (db:with-db
   dbstruct
   run-id
   #t
   (lambda (dbdat db)







<
<







2737
2738
2739
2740
2741
2742
2743


2744
2745
2746
2747
2748
2749
2750
     (sqlite3:execute 
      db
      "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
      test-id teststep-name state-in status-in (current-seconds)
      (if comment comment "")
      (if logfile logfile "")))))



(define (db:delete-steps-for-test! dbstruct run-id test-id)
  ;; TODO: figure out why status is the key field rather than state (note:  CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state) )
  (db:with-db
   dbstruct
   run-id
   #t
   (lambda (dbdat db)
4245
4246
4247
4248
4249
4250
4251














































4252
4253
4254
4255
4256
4257
4258
	 (begin
	   (debug:print 0 *default-log-port* "WARNING: path given, " outputfile " is relative, prefixing with current directory")
	   (conc (current-directory) "/" outputfile)))
     results)
    ;; brutal clean up
    (dbfile:add-dbdat dbstruct #f dbdat)
    (system "rm -rf tempdir")))















































;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")

;;======================================================================
;; moving watch dogs here due to dependencies
;;======================================================================








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
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
	 (begin
	   (debug:print 0 *default-log-port* "WARNING: path given, " outputfile " is relative, prefixing with current directory")
	   (conc (current-directory) "/" outputfile)))
     results)
    ;; brutal clean up
    (dbfile:add-dbdat dbstruct #f dbdat)
    (system "rm -rf tempdir")))

;;======================================================================
;; cached writes stuff
;;======================================================================

(define (db:add-cached-write dbstruct proc run-id params)
  (debug:print 0 *default-log-port* "Adding cached write for run-id "run-id" params " params)
  (mutex-lock! *cached-writes-mutex*)
  (let* ((hkey                (cons dbstruct run-id))
	 (cached-writes-queue (hash-table-ref/default *cached-writes-queues* hkey '())))
    (hash-table-set! *cached-writes-queues* hkey (cons (list proc params) cached-writes-queue)))
  (if (not *cached-writes-flag*)
      (begin
	(set! *cached-writes-flag* #t)
	(thread-start! (make-thread
			(lambda ()
			  (debug:print 0 *default-log-port* "process cached writes thread started.")
			  (thread-sleep! 1)
			  (db:process-cached-writes-queue))))))
  (mutex-unlock! *cached-writes-mutex*))

(define (db:process-cached-writes-queue)
  (mutex-lock! *cached-writes-mutex*)
  (hash-table-for-each
   *cached-writes-queues*
   (lambda (hkey writes-list)
     (let* ((dbstruct (car hkey))
	    (run-id   (cdr hkey)))
       (debug:print 0 *default-log-port* "Processing "(length writes-list)" cached writes for run "run-id)
       (db:with-db
	dbstruct
	run-id
	#t 
	(lambda (dbdat db)
	  (sqlite3:with-transaction
	   db
	   (lambda ()
	     (for-each
	      (lambda (queued-write)
		(match queued-write
		       ((proc params)(apply proc dbstruct params))
		       (else (assert #f "BAD queued-write"))))
	      writes-list)))
	  (hash-table-delete! *cached-writes-queues* hkey))))))
  (set! *cached-writes-flag* #f)
  (mutex-unlock! *cached-writes-mutex*))

;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")

;;======================================================================
;; moving watch dogs here due to dependencies
;;======================================================================

Modified dbfile.scm from [b5eea0764a] to [5eebf6582a].

1577
1578
1579
1580
1581
1582
1583










1584
1585
	 (result      (or stmth
			  (let* ((newstmth (sqlite3:prepare db stmt)))
			    ;; (db:hoh-set! stmt-cache db stmt newstmth)
			    (hash-table-set! stmt-cache stmt newstmth)
			    newstmth))))
    (mutex-unlock! *get-cache-stmth-mutex*)
    result))











)







>
>
>
>
>
>
>
>
>
>


1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
	 (result      (or stmth
			  (let* ((newstmth (sqlite3:prepare db stmt)))
			    ;; (db:hoh-set! stmt-cache db stmt newstmth)
			    (hash-table-set! stmt-cache stmt newstmth)
			    newstmth))))
    (mutex-unlock! *get-cache-stmth-mutex*)
    result))

;;======================================================================
;; cached writes - run list of procs inside transaction
;;   NOTE: this only works because we have once database per process
;;======================================================================

(define *cached-writes-mutex* (make-mutex))
(define *cached-writes-flag*  #f)
(define *cached-writes-queues* (make-hash-table)) ;; dbstruct->list of writes


)

Modified dbmod.scm from [9f0ce614a3] to [00037bb607].

117
118
119
120
121
122
123
124

125

126
127
128
129
130
131
132
			      (debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, will try "count" more times.")
			      (thread-sleep! 1)
			      (loop (- count 1)))
			    (begin
			      (debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, giving up.")
			      (exit 1))))
		   (exn ()
			(dbfile:print-err exn "ERROR: Unknown error with database for run-id "run-id", message: "

					  ((condition-property-accessor 'exn 'message) exn))

			(exit 2))))))
      (if use-mutex (mutex-unlock! *db-with-db-mutex*))
      res)))

(define (db:with-db dbstruct run-id w/r proc . params)
  (dbmod:with-db dbstruct run-id w/r proc params))








|
>
|
>







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
			      (debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, will try "count" more times.")
			      (thread-sleep! 1)
			      (loop (- count 1)))
			    (begin
			      (debug:print-info 0 *default-log-port* "dbmod:with-db, database is busy, giving up.")
			      (exit 1))))
		   (exn ()
			(dbfile:print-err exn "ERROR: Unknown error with db for run-id "
					  run-id", message: "
					  ((condition-property-accessor 'exn 'message) exn)
					  ", details: "(condition->list exn))
			(exit 2))))))
      (if use-mutex (mutex-unlock! *db-with-db-mutex*))
      res)))

(define (db:with-db dbstruct run-id w/r proc . params)
  (dbmod:with-db dbstruct run-id w/r proc params))

Modified rmt.scm from [564930aec3] to [b6600b2d34].

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
  (assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.")

  (if (not (eq? (rmt:transport-mode) 'nfs))
      (begin
	(if (> attemptnum 2)
	    (debug:print 0 *default-log-port* "INFO: attemptnum in rmt:send-receive is " attemptnum))
	
	(cond
	 ((> attemptnum 2) (thread-sleep! 0.05))
	 ((> attemptnum 10) (thread-sleep! 0.5))
	 ((> attemptnum 20) (thread-sleep! 1)))
	
	;; I'm turning this off, it may make sense to move it
	;; into http-transport-handler
	(if (and (> attemptnum 5) (= 0 (modulo attemptnum 15)))  
	    (begin
	      (debug:print 0 *default-log-port* "ERROR: can't connect to server, trying to start a server.")
	      (case (rmt:transport-mode)
		((http)
		 (server:run *toppath*)
		 (thread-sleep! 3))
		(else
		 (thread-sleep! 1) ;; for tcp the server is started by routines in tcp-transportmod. For nfs there is no server
		 ))))))
  
  ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote
  ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds.
  ;; 3. do the query, if on homehost use local access
  ;;
  (let* ((start-time    (current-seconds)) ;; snapshot time so all use cases get same value
         (areapath      *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
	 (runremote     (or area-dat







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







70
71
72
73
74
75
76
77























78
79
80
81
82
83
84

(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
  (assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.")
	























  ;; 1. check if server is started IFF cmd is a write OR if we are not on the homehost, store in runremote
  ;; 2. check the age of the connections. refresh the connection if it is older than timeout-20 seconds.
  ;; 3. do the query, if on homehost use local access
  ;;
  (let* ((start-time    (current-seconds)) ;; snapshot time so all use cases get same value
         (areapath      *toppath*);; TODO - resolve from dbstruct to be compatible with multiple areas
	 (runremote     (or area-dat