Megatest

Check-in [79f9af8364]
Login
Overview
Comment:WIP, getting nfs working again
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 79f9af8364b27d40e82a983de3c5701d13aa30f0
User & Date: matt on 2023-03-11 10:37:06
Other Links: branch diff | manifest | tags
Context
2023-03-11
12:39
fixed unprotected vector-length check-in: c2a555afb1 user: matt tags: v1.80
10:37
WIP, getting nfs working again check-in: 79f9af8364 user: matt tags: v1.80
2023-03-03
18:32
no crashes (yet) check-in: 349234dd61 user: mrwellan tags: v1.80
Changes

Modified api.scm from [9b20a45ffe] to [41ca383751].

1
2
3
4
5
6
7
8
9


1
2
3
4
5
6
7
-
-









;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by

Modified dashboard-transport-mode.scm.template from [883292db61] to [e2fa9f346c].











1



2
3

1
2
3
4
5
6
7
8
9
10

11
12
13
14

15
+
+
+
+
+
+
+
+
+
+
-
+
+
+

-
+
;;======================================================================
;; set up transport, db cache and sync methods
;;
;; sync-method:        'original, 'attach or 'none
;; cache-method:       'tmp, 'inmem or 'none
;; rmt:transport-mode: 'http, 'tcp, 'nfs
;;
;; NOTE: NOT ALL COMBINATIONS WORK
;;
;;======================================================================
;; 'http or 'tcp

(dbfile:sync-method 'none)
(dbfile:cache-method 'none)
(rmt:transport-mode 'nfs)
;; (rmt:transport-mode 'http)

Modified dashboard.scm from [b72cad9255] to [c294083769].

414
415
416
417
418
419
420


421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437

















438
439
440
441
442
443
444
414
415
416
417
418
419
420
421
422

















423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446







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








(define (dboard:runsdat-make-init)
  (make-dboard:runsdat
   runs-index: (make-hash-table)
   tests-index: (make-hash-table)
   matrix-dat: (make-sparse-array)))

;; duplicated in dcommon.scm
;;
;; used to keep the rundata from rmt:get-tests-for-run
;; in sync. 
;;
(defstruct dboard:rundat
  run
  tests-drawn    ;; list of id's already drawn on screen
  tests-notdrawn ;; list of id's NOT already drawn
  rowsused       ;; hash of lists covering what areas used - replace with quadtree
  hierdat        ;; put hierarchial sorted list here
  tests          ;; hash of id => testdat
  ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
  key-vals
  ((last-update   0)                 : number)    ;; last query to db got records from before last-update
  ((last-db-time  0)                 : number)    ;; last timestamp on main.db
  ((data-changed  #f)                : boolean)   
  ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
  (db-path #f))
;; ;; used to keep the rundata from rmt:get-tests-for-run
;; ;; in sync. 
;; ;;
;; (defstruct dboard:rundat
;;   run
;;   tests-drawn    ;; list of id's already drawn on screen
;;   tests-notdrawn ;; list of id's NOT already drawn
;;   rowsused       ;; hash of lists covering what areas used - replace with quadtree
;;   hierdat        ;; put hierarchial sorted list here
;;   tests          ;; hash of id => testdat
;;   ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
;;   key-vals
;;   ((last-update   0)                 : number)    ;; last query to db got records from before last-update
;;   ((last-db-time  0)                 : number)    ;; last timestamp on main.db
;;   ((data-changed  #f)                : boolean)   
;;   ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
;;   (db-path #f))

;; for the new runs view lets build up a few new record types and then consolidate later
;;
;; this is a two level deep pipeline for the incoming data:
;;   sql query data ==> filters ==> data for display
;;
(defstruct dboard:rdat

Modified dbfile.scm from [0f128aa628] to [0f7631a253].

38
39
40
41
42
43
44
45
46


47



48


49
50
51
52
53
54
55
38
39
40
41
42
43
44


45
46
47
48
49
50

51
52
53
54
55
56
57
58
59







-
-
+
+

+
+
+
-
+
+







	files
	ports

	commonmod
	debugprint
	)

(define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
(define num-run-dbs    (make-parameter 10))     ;; number of db's in .megatest
;; parameters
;;
(define dbfile:testsuite-name (make-parameter #f))

(define keep-age-param        (make-parameter 10))      ;; qif file age, if over move to attic
(define num-run-dbs           (make-parameter 10))      ;; number of db's in .megatest
(define dbfile:sync-method (make-parameter 'attach)) ;; 'attach or 'original
(define dbfile:sync-method    (make-parameter 'attach)) ;; 'attach or 'original
(define dbfile:cache-method   (make-parameter 'inmem))  ;; 'direct

;; 'original     - use old condition code
;; 'suicide-mode - create mtrah/stop-the-train with info on what went wrong
;; else use no condition code (should be production mode)
;;
(define no-condition-db-with-db (make-parameter 'suicide-mode))

440
441
442
443
444
445
446

447

448
449
450
451
452







453
454
455
456
457
458
459
444
445
446
447
448
449
450
451
452
453





454
455
456
457
458
459
460
461
462
463
464
465
466
467







+

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








(define (dbfile:with-no-sync-db dbpath proc)
  (let* ((db  (dbfile:raw-open-no-sync-db dbpath))
	 (res (proc db)))
    (sqlite3:finalize! db)
    res))

(define *no-sync-db-mutex* (make-mutex))
(define (dbfile:open-no-sync-db dbpath)
  (mutex-lock! *no-sync-db-mutex*)
  (if *no-sync-db*
      *no-sync-db*
      (let* ((db (dbfile:raw-open-no-sync-db dbpath)))
	(set! *no-sync-db* db)
	db)))
  (let* ((res (if *no-sync-db*
		  *no-sync-db*
		  (let* ((db (dbfile:raw-open-no-sync-db dbpath)))
		    (set! *no-sync-db* db)
		    db))))
    (mutex-unlock! *no-sync-db-mutex*)
    res))

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

(define (db:no-sync-del! db var)
  (sqlite3:execute db "DELETE FROM no_sync_metadat WHERE var=?;" var))

Modified dbmod.scm from [cf9c562387] to [575706269e].

61
62
63
64
65
66
67

68
69
70
71
72
73
74
75
76
77
78
79

80
81
82
83
84
85
86
61
62
63
64
65
66
67
68
69
70
71
72
73







74
75
76
77
78
79
80
81







+





-
-
-
-
-
-
-
+








;;======================================================================
;; Read-only inmem cached direct from disk method
;;======================================================================

(define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct

;; called in rmt.scm nfs-transport-handler
(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath)
  (assert areapath "FATAL: dbmod:nfs-get-dbstruct called without areapath set.")
  (let* ((dbfname  (dbmod:run-id->dbfname run-id))
	 (dbstruct (hash-table-ref/default *dbmod:nfs-db-handles* dbfname #f)))
    (if dbstruct
	(let* ((last-update (dbr:dbstruct-last-update dbstruct))
	       (curr-secs   (current-seconds)))
	  (if (> (- curr-secs last-update) 2)
	      (begin
		((dbr:dbstruct-sync-proc dbstruct) last-update)
		(dbr:dbstruct-last-update-set! dbstruct curr-secs)))
	  dbstruct)
	dbstruct
	(let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'fromdisk)))
	  (hash-table-set! *dbmod:nfs-db-handles* dbfname newdbstruct)
	  newdbstruct))))

;;======================================================================
;; The inmem one-db file per server method goes in here
;;======================================================================
102
103
104
105
106
107
108















109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
136
137












138
139
140
141
142
143

144
145


146
147

148
149
150
151
152
153
154
155
156
157
158

159
160
161
162
163
164
165
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139









140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158


159
160
161

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















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






+
-
-
+
+

-
+











+







  (or (dbr:dbstruct-dbdat dbstruct)
      (let* ((dbdat (make-dbr:dbdat
		     dbfile: (dbr:dbstruct-dbfile dbstruct)
		     dbh:    (dbr:dbstruct-inmem  dbstruct)
		     )))
	(dbr:dbstruct-dbdat-set! dbstruct dbdat)
	dbdat)))

(define (dbmod:need-on-disk-db-handle)
    (case (dbfile:cache-method)
      ((none tmp) #t)
      ((inmem)
       (case (dbfile:sync-method)
	 ((original) #t)
	 ((attach)   #f)
	 (else
	  (debug:print 0 *default-log-port* "Unknown dbfile:sync-method setting: "
		       (dbfile:sync-method)))))
      (else
       (debug:print 0 *default-log-port* "Unknown dbfile:cache-method setting: "
		    (dbfile:cache-method))
       #f)))

;; Open the inmem db and the on-disk db
;; populate the inmem db with data
;;
;; Updates fields in dbstruct
;; Returns dbstruct
;;
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;; 
(define (dbmod:open-dbmoddb areapath run-id dbfname-in init-proc keys
			    #!key (dbstruct-in #f)
			    (syncdir 'todisk))
  (let* ((dbstruct     (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
	 (dbfname      (or dbfname-in (dbmod:run-id->dbfname run-id)))
	 (dbpath       (dbmod:get-dbdir dbstruct))             ;; directory where all the .db files are kept
	 (dbfullname   (conc dbpath"/"dbfname)) ;; (dbmod:run-id->full-dbfname dbstruct run-id))
	 (dbexists     (file-exists? dbfullname))
	 (inmem        (dbmod:open-inmem-db init-proc))
	 (write-access (file-write-access? dbpath))
	 (open-the-db  (lambda ()
	 (db           (dbfile:with-simple-file-lock
			(conc dbfullname".lock")
			(lambda ()
			  (let* ((db      (sqlite3:open-database dbfullname))
				 (handler (sqlite3:make-busy-timeout 136000)))
			    (sqlite3:set-busy-handler! db handler)
			    (if write-access
				(init-proc db))
			    db))))
			 (dbfile:with-simple-file-lock
			  (conc dbfullname".lock")
			  (lambda ()
			    (let* ((db      (sqlite3:open-database dbfullname))
				   (handler (sqlite3:make-busy-timeout 136000)))
			      (sqlite3:set-busy-handler! db handler)
			      (if write-access
				  (init-proc db))
			      db)))))
	 (db            (if (dbmod:need-on-disk-db-handle)
			    (open-the-db)
			    #f))
	 (tables       (db:sync-all-tables-list keys)))
    (dbr:dbstruct-inmem-set!    dbstruct inmem)
    (dbr:dbstruct-ondiskdb-set! dbstruct db)
    (dbr:dbstruct-dbfile-set!   dbstruct dbfullname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)
				   (if db
				   (sync-gasket tables last-update inmem db
						dbfullname syncdir)))
				       (sync-gasket tables last-update inmem db
						    dbfullname syncdir))))
    ;; (dbmod:sync-tables tables #f db inmem)
    (sync-gasket tables #f inmem db dbfullname 'fromdest)
    (if db (sync-gasket tables #f inmem db dbfullname 'fromdest))
    (dbr:dbstruct-last-update-set! dbstruct (current-seconds)) ;; should this be offset back in time by one second?
    dbstruct))

;;    (if (eq? syncdir 'todisk) ;; sync to disk normally, sync from in dashboard
;;        (dbmod:sync-tables tables last-update inmem db)
;;        (dbmod:sync-tables tables last-update db inmem))))

;; direction: 'fromdest 'todest
;;
(define (sync-gasket tables last-update inmem dbh dbfname direction)
  (case (dbfile:sync-method)
    ((none) #f)
    ((attach)
     (dbmod:attach-sync tables inmem dbfname direction))
    (else
     (case direction
       ((todest)
	(dbmod:sync-tables tables last-update inmem dbh))
       (else

Modified rmt.scm from [6a03756866] to [ee23eeb29c].

89
90
91
92
93
94
95



96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115




















116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

134
135
136

137
138
139
140
141
142
143
89
90
91
92
93
94
95
96
97
98




















99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

136
137
138

139
140
141
142
143
144
145
146







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

















-
+


-
+








(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
	   ))))
	(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
			    *runremote*))
         (attemptnum    (+ 1 attemptnum))
	 (readonly-mode (rmtmod:calc-ro-mode runremote *toppath*))
	 (testsuite     (common:get-testsuite-name))
	 (mtexe         (common:find-local-megatest)))

    (case (rmt:transport-mode)
      ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))
      ((tcp) (tcp-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
      ((nfs) (nfs:transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
      ((nfs) (nfs-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
      )))

(define (nfs:transport-handler  runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
(define (nfs-transport-handler  runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
  (let* ((keys     (common:get-fields *configdat*))
	 (dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath)))
    (api:dispatch-request dbstruct cmd run-id params)))
	 
(define (tcp-transport-handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
  (if (not runremote)
      (let* ((newremote  (make-and-init-remote areapath)))

Modified transport-mode.scm.template from [0281a19fe7] to [e2fa9f346c].











1
2
3





1
2
3
4
5
6
7
8
9
10



11
12
13
14
15
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
;;======================================================================
;; set up transport, db cache and sync methods
;;
;; sync-method:        'original, 'attach or 'none
;; cache-method:       'tmp, 'inmem or 'none
;; rmt:transport-mode: 'http, 'tcp, 'nfs
;;
;; NOTE: NOT ALL COMBINATIONS WORK
;;
;;======================================================================
;; 'http or 'tcp
(rmt:transport-mode 'tcp)
;; (rmt:transport-mode 'http)

(dbfile:sync-method 'none)
(dbfile:cache-method 'none)
(rmt:transport-mode 'nfs)