Megatest

Check-in [a23657561e]
Login
Overview
Comment:Dashboard starts
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-real-new-runs-view-wip3
Files: files | file ages | folders
SHA1: a23657561e28b29c9dd425e9d7044b059f50f9cd
User & Date: matt on 2021-02-28 02:18:13
Other Links: branch diff | manifest | tags
Context
2021-02-28
07:41
Used codesplitter to confirm no important differences with v1.65-real-new-runs-view, d85f01faff9033 check-in: a0ffba076b user: matt tags: v1.65-real-new-runs-view-wip3, good-one
02:18
Dashboard starts check-in: a23657561e user: matt tags: v1.65-real-new-runs-view-wip3
2021-02-27
21:44
Fixed order of uses in dashboard.scm check-in: ff6cbfba6c user: matt tags: v1.65-real-new-runs-view-wip3
Changes

Modified commonmod.scm from [9d235648e1] to [3c7c56e5e8].

3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
  (mutex-lock! *homehost-mutex*)
  (cond
   (*home-host*
    (mutex-unlock! *homehost-mutex*)
    *home-host*)
   ((not *toppath*)
    (mutex-unlock! *homehost-mutex*)
    ((launch:setup) ;; safely mutexed now
     (if (> trynum 0)
	 (begin
	   (thread-sleep! 2)
	   (common:get-homehost trynum: (- trynum 1)))
	 #f))
    (else
     (let* ((currhost (get-host-name))
	    (bestadrs (server:get-best-guess-address currhost))
	    ;; first look in config, then look in file .homehost, create it if not found
	    (homehost (or (configf:lookup *configdat* "server" "homehost" )
			  (handle-exceptions
			   exn
			   (if (> trynum 0)
			       (let ((delay-time (* (- 5 trynum) 5)))
				 (mutex-unlock! *homehost-mutex*)
				 (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying "
					      delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn)
					      ", exn=" exn)
				 (thread-sleep! delay-time)
				 (common:get-homehost trynum: (- trynum 1)))
			       (begin
				 (mutex-unlock! *homehost-mutex*)
				 (debug:print 0 *default-log-port* "ERROR: ["(common:human-time)
					      "] Failed to read .homehost file after trying five times. Giving up and exiting, message: "
					      ((condition-property-accessor 'exn 'message) exn))
				 ;;======================================================================
				 (exit 1)))
			   (let ((hhf (conc *toppath* "/.homehost")))
			     (if (common:file-exists? hhf)
				 (with-input-from-file hhf read-line)
				 (if (file-write-access? *toppath*)
				     (begin
				       (with-output-to-file hhf
					 (lambda ()
					   (print bestadrs)))
				       (begin
					 (mutex-unlock! *homehost-mutex*)
					 (car (common:get-homehost))))
				     #f))))))
	    (at-home  (or (equal? homehost currhost)
			  (equal? homehost bestadrs))))
       (set! *home-host* (cons homehost at-home))
       (mutex-unlock! *homehost-mutex*)
       *home-host*)))))

(define (common:wait-for-homehost-load maxnormload msg)
  (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
		     #f
		     (common:get-homehost)))
	 (hh     (if hh-dat (car hh-dat) #f)))
    (common:wait-for-normalized-load maxnormload msg hh)))







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







3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893

3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
  (mutex-lock! *homehost-mutex*)
  (cond
   (*home-host*
    (mutex-unlock! *homehost-mutex*)
    *home-host*)
   ((not *toppath*)
    (mutex-unlock! *homehost-mutex*)
    (launch:setup) ;; safely mutexed now
    (if (> trynum 0)
	(begin
	  (thread-sleep! 2)
	  (common:get-homehost trynum: (- trynum 1)))
	#f))
   (else
    (let* ((currhost (get-host-name))
	   (bestadrs (server:get-best-guess-address currhost))
	   ;; first look in config, then look in file .homehost, create it if not found
	   (homehost (or (configf:lookup *configdat* "server" "homehost" )
			 (handle-exceptions
			  exn
			  (if (> trynum 0)
			      (let ((delay-time (* (- 5 trynum) 5)))
				(mutex-unlock! *homehost-mutex*)
				(debug:print 0 *default-log-port* "ERROR: ["(common:human-time)"] Failed to read .homehost file, delaying "
					     delay-time " seconds and trying again, message: "  ((condition-property-accessor 'exn 'message) exn)
					     ", exn=" exn)
				(thread-sleep! delay-time)
				(common:get-homehost trynum: (- trynum 1)))
			      (begin
				(mutex-unlock! *homehost-mutex*)
				(debug:print 0 *default-log-port* "ERROR: ["(common:human-time)
					     "] Failed to read .homehost file after trying five times. Giving up and exiting, message: "
					     ((condition-property-accessor 'exn 'message) exn))

				(exit 1)))
			  (let ((hhf (conc *toppath* "/.homehost")))
			    (if (common:file-exists? hhf)
				(with-input-from-file hhf read-line)
				(if (file-write-access? *toppath*)
				    (begin
				      (with-output-to-file hhf
					(lambda ()
					  (print bestadrs)))
				      (begin
					(mutex-unlock! *homehost-mutex*)
					(car (common:get-homehost))))
				    #f))))))
	   (at-home  (or (equal? homehost currhost)
			 (equal? homehost bestadrs))))
      (set! *home-host* (cons homehost at-home))
      (mutex-unlock! *homehost-mutex*)
      *home-host*))))

(define (common:wait-for-homehost-load maxnormload msg)
  (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
		     #f
		     (common:get-homehost)))
	 (hh     (if hh-dat (car hh-dat) #f)))
    (common:wait-for-normalized-load maxnormload msg hh)))

Modified dashboard.scm from [04a8971b96] to [c9eae66688].

61
62
63
64
65
66
67



68
69
70
71
72
73
74

(declare (uses dcommonmod))
(import dcommonmod)
(declare (uses dcommonmod.import))

(declare (uses apimod))
(import apimod)




;; (declare (uses ods))
;; (import ods)
;; 
(declare (uses dbmod))
(import dbmod)
;; (declare (uses dbmod.import))







>
>
>







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

(declare (uses dcommonmod))
(import dcommonmod)
(declare (uses dcommonmod.import))

(declare (uses apimod))
(import apimod)

(declare (uses rmtmod))
(import rmtmod)

;; (declare (uses ods))
;; (import ods)
;; 
(declare (uses dbmod))
(import dbmod)
;; (declare (uses dbmod.import))
95
96
97
98
99
100
101


102
103
104
105
106
107
108
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
;; (include "megatest-fossil-hash.scm")
(include "vg_records.scm")



;; This is the new runs view
(include "dashboard-new-runs-view.scm")

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "







>
>







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
;; (include "megatest-fossil-hash.scm")
(include "vg_records.scm")

;; (print "Got here #1")

;; This is the new runs view
(include "dashboard-new-runs-view.scm")

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
179
180
181
182
183
184
185












186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204


205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221


222
223
224
225
226
227
228
        (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
          (setenv "PWD" fullpath)
          (change-directory fullpath))
	(begin
	  (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
 	  (exit 1))))













;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; deal with RH 5.11 gtk lib or iup lib missing detachbox feature
;; first check for the switch
;;
(if (or (args:get-arg "-rh5.11")
	(configf:lookup *configdat* "dashboard" "no-detachbox")
        (not (file-exists? "/etc/os-release")))
    (set! iup:detachbox iup:vbox))

(if (not (common:on-homehost?))
    (begin
      (debug:print 0 *default-log-port* "WARNING: Current policy requires running dashboard on homehost: " (common:get-homehost))))
    


;; RA => Might require revert for filters 
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")

(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (if (not (args:get-arg "-use-db-cache"))
;;     (begin
;;       (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;;       (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;;)

;; data common to all tabs in dboard:commondat struct moved to dcommonmod
  ;; data from sql db
;; (keys       (rmt:get-keys))         ;; to be removed when targets handling is r



;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary)
;;
(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
  (let* ((tnum (or tab-num
		   (dboard:commondat-curr-tab-num commondat)
		   0)) ;; tab-num value is curr-tab-num value in passed commondat







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


















|
>
>

















>
>







184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
        (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
          (setenv "PWD" fullpath)
          (change-directory fullpath))
	(begin
	  (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
 	  (exit 1))))

;; (use trace)
;; (trace-call-sites #t)
;; (trace
;;  launch:setup
;;  configf:lookup
;;  common:on-homehost?
;;  common:get-homehost
;;  server:get-best-guess-address
;;  )

;; (print "Got here #1.5")

;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; deal with RH 5.11 gtk lib or iup lib missing detachbox feature
;; first check for the switch
;;
(if (or (args:get-arg "-rh5.11")
	(configf:lookup *configdat* "dashboard" "no-detachbox")
        (not (file-exists? "/etc/os-release")))
    (set! iup:detachbox iup:vbox))

(if (not (common:on-homehost?))
    (begin
      (debug:print 0 *default-log-port* "WARNING: Current policy requires running dashboard on homehost: " (common:get-homehost))))

;; (print "Got here #1.6")

;; RA => Might require revert for filters 
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")

(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (if (not (args:get-arg "-use-db-cache"))
;;     (begin
;;       (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;;       (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;;)

;; data common to all tabs in dboard:commondat struct moved to dcommonmod
  ;; data from sql db
;; (keys       (rmt:get-keys))         ;; to be removed when targets handling is r

;; (print "Got here #1.7")

;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary)
;;
(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
  (let* ((tnum (or tab-num
		   (dboard:commondat-curr-tab-num commondat)
		   0)) ;; tab-num value is curr-tab-num value in passed commondat
358
359
360
361
362
363
364


365
366
367
368
369
370
371
  (let ((t-sort (assoc (configf:lookup *configdat* "dashboard" "testsort") *tests-sort-type-index*)))
    (if t-sort
	(cadr t-sort)
	3)))

(define (get-curr-sort)
  (vector-ref *tests-sort-options* *tests-sort-reverse*))



;;======================================================================

;;======================================================================
(common:debug-setup)

;; (define uidat #f)







>
>







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
  (let ((t-sort (assoc (configf:lookup *configdat* "dashboard" "testsort") *tests-sort-type-index*)))
    (if t-sort
	(cadr t-sort)
	3)))

(define (get-curr-sort)
  (vector-ref *tests-sort-options* *tests-sort-reverse*))

;; (print "Got here #2")

;;======================================================================

;;======================================================================
(common:debug-setup)

;; (define uidat #f)
1121
1122
1123
1124
1125
1126
1127


1128
1129
1130
1131
1132
1133
1134
				  (if (eq? tstate 0)
				      (hash-table-delete! alltgls item)
				      (hash-table-set! alltgls item #t))
				  (let ((all (hash-table-keys alltgls)))
				    (proc all)))
				"text-list-toggle-box"))))
		items))))



;; Extract the various bits of data from tabdat and create the command line equivalent that will be displayed
;;
(define (dashboard:update-run-command tabdat)
  (let* ((cmd-tb       (dboard:tabdat-command-tb tabdat))
	 (cmd          (dboard:tabdat-command    tabdat))
	 (test-patt    (let ((tp (dboard:tabdat-test-patts tabdat)))







>
>







1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
				  (if (eq? tstate 0)
				      (hash-table-delete! alltgls item)
				      (hash-table-set! alltgls item #t))
				  (let ((all (hash-table-keys alltgls)))
				    (proc all)))
				"text-list-toggle-box"))))
		items))))

;; (print "Got here #3")

;; Extract the various bits of data from tabdat and create the command line equivalent that will be displayed
;;
(define (dashboard:update-run-command tabdat)
  (let* ((cmd-tb       (dboard:tabdat-command-tb tabdat))
	 (cmd          (dboard:tabdat-command    tabdat))
	 (test-patt    (let ((tp (dboard:tabdat-test-patts tabdat)))
3470
3471
3472
3473
3474
3475
3476


3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))
	    (th2 (make-thread iup:main-loop "Main loop")))
	(thread-start! th2)
	(thread-join! th2)))))



;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

(if (args:get-arg "-repl")
    (repl)
    (main))








>
>










3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))
	    (th2 (make-thread iup:main-loop "Main loop")))
	(thread-start! th2)
	(thread-join! th2)))))

;; (print "Got here #4")

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

(if (args:get-arg "-repl")
    (repl)
    (main))

Modified dcommon.scm from [f3a8d144b3] to [bb4fd504cd].

43
44
45
46
47
48
49



50
51
52
53
54
55
56
(import configfmod)

(declare (uses dcommonmod))
(import dcommonmod)

(declare (uses servermod))
(import servermod)




;; (declare (uses synchash))

(include "megatest-version.scm")
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")







>
>
>







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
(import configfmod)

(declare (uses dcommonmod))
(import dcommonmod)

(declare (uses servermod))
(import servermod)

(declare (uses rmtmod))
(import rmtmod)

;; (declare (uses synchash))

(include "megatest-version.scm")
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")