Megatest

Check-in [0ac0c8e72f]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: 0ac0c8e72faf4f235b6c2ad6502200f3241cc3ac
User & Date: matt on 2023-02-20 10:32:42
Other Links: branch diff | manifest | tags
Context
2023-02-20
14:17
wip. better but now there are run-away issues in ext-tests: check-in: 94e5d1fb43 user: matt tags: v1.80-tcp-inmem
10:32
wip check-in: 0ac0c8e72f user: matt tags: v1.80-tcp-inmem
08:35
wip, dashboard and list-runs work check-in: 4eb82b3919 user: matt tags: v1.80-tcp-inmem
Changes

Modified Makefile from [fc4261f834] to [c01f62811d].

35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49







-
+








all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut tcmt

transport-mode.scm : transport-mode.scm.template
	cp transport-mode.scm.template transport-mode.scm

dashboard-mode.scm : transport-mode.scm.template
	cp transport-mode.scm.template transport-mode.scm
	cp transport-mode.scm.template dashboard-transport-mode.scm

megatest.scm : transport-mode.scm

# dbmod.import.o is just a hack here
mofiles/dbfile.o     : mofiles/debugprint.o mofiles/commonmod.o dbmod.import.o
db.o : dbmod.import.o
mofiles/debugprint.o : mofiles/mtargs.o

Modified rmt.scm from [c413a62f3a] to [2482b80340].

138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152







-
+







      (let* ((newremote  (make-and-init-remote areapath)))
	(set! *runremote* newremote)
	(set! runremote newremote)))
  (let* ((dbfname (conc (dbfile:run-id->dbnum run-id)".db"))) ;;(dbfile:run-id->path areapath run-id)))
    (tt:handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)))
	
(define (http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode)
  ;; do all the prep locked under the rmt-mutex
    ;; do all the prep locked under the rmt-mutex
  (mutex-lock! *rmt-mutex*)
  
  ;; ensure we have a record for our connection for given area
  (if (not runremote)                   ;; can remove this one. should never get here.         
      (begin
	(set! *runremote* (make-and-init-remote areapath))
        (let* ((server-info (remote-server-info *runremote*))) 

Modified tcp-transportmod.scm from [fd0be5effa] to [c554113ebe].

103
104
105
106
107
108
109
110

111
112
113
114
115

116
117
118
119
120
121
122
103
104
105
106
107
108
109

110
111
112
113
114

115
116
117
118
119
120
121
122







-
+




-
+








(define (tt:make-remote areapath)
  (make-tt areapath: areapath))

;; do all the busy work of finding and setting up conn for
;; connecting to a server
;; 
(define (tt:client-connect-to-server ttdat dbfname run-id )
(define (tt:client-connect-to-server ttdat dbfname run-id testsuite)
  (let* ((conn (hash-table-ref/default (tt-conns ttdat) dbfname #f))
	 (server-start-proc (lambda ()
			      (tt:server-process-run
			       (tt-areapath ttdat)
			       (dbfile:testsuite-name)
			       testsuite ;; (dbfile:testsuite-name)
			       (common:find-local-megatest)
			       run-id))))
    (if conn
	conn ;; we are already connected to the server
	(let* ((sdat (tt:get-current-server-info ttdat dbfname run-id)))
	  (match sdat
	    ((host port start-time server-id pid dbfname2)
134
135
136
137
138
139
140
141

142
143
144
145

146
147
148
149
150
151
152
134
135
136
137
138
139
140

141
142
143
144

145
146
147
148
149
150
151
152







-
+



-
+







	       ;; verify we can talk to this server
	       (if (tt:ping host port server-id)
		   conn
		   (begin
		     ;; rm the (last server) would go here
		     (server-start-proc)
		     (thread-sleep! 1)
		     (tt:client-connect-to-server ttdat dbfname run-id)))))
		     (tt:client-connect-to-server ttdat dbfname run-id testsuite)))))
	    (else
	     (server-start-proc)
	     (thread-sleep! 1)
	     (tt:client-connect-to-server ttdat dbfname run-id)))))))
	     (tt:client-connect-to-server ttdat dbfname run-id testsuite)))))))
    
(define (tt:ping host port server-id)
  (let*  ((res (tt:send-receive-direct host port `(ping #f #f #f)))) ;; please send me your server-id
    ;;
    ;; need two threads, one a 5 second timer
    ;;
    (match res
160
161
162
163
164
165
166
167

168
169
170
171
172
173
174
160
161
162
163
164
165
166

167
168
169
170
171
172
173
174







-
+







       (debug:print 0 *default-log-port* "res not in form (status errmsg resutl meta), got: "res)
       #f))))

;; client side handler
;;
(define (tt:handler ttdat cmd run-id params attemptnum area-dat areapath readonly-mode dbfname testsuite mtexe)
  ;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now.
  (let* ((conn (tt:client-connect-to-server ttdat dbfname run-id))) ;; (hash-table-ref/default (tt-conns ttdat) dbfname #f)))
  (let* ((conn (tt:client-connect-to-server ttdat dbfname run-id testsuite))) ;; (hash-table-ref/default (tt-conns ttdat) dbfname #f)))
    (if conn
	;; have connection, call the server
	(let* ((res (tt:send-receive ttdat conn cmd run-id params)))
	  ;; res is (status errmsg result meta)
	  (match res
	    ((status errmsg result meta)
	     (case status
449
450
451
452
453
454
455



456
457
458
459
460
461
462
463
464
465
466
467
468
469
470








471
472
473
474
475
476
477
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468





469
470
471
472
473
474
475
476
477
478
479
480
481
482
483







+
+
+










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








;; Given an area path,  start a server process    ### NOTE ### > file 2>&1 
;; if the target-host is set 
;; try running on that host
;;   incidental: rotate logs in logs/ dir.
;;
(define  (tt:server-process-run areapath testsuite mtexe run-id #!key (profile-mode "")) ;; areapath is *toppath* for a given testsuite area
  (assert areapath  "FATAL: tt:server-process-run called without areapath defined.")
  (assert testsuite "FATAL: tt:server-process-run called without testsuite defined.")
  (assert mtexe     "FATAL: tt:server-process-run called without mtexe defined.")
  (let* ((logfile   (conc areapath "/logs/server.log")) ;; -" curr-pid "-" target-host ".log"))
	 (cmdln     (conc
		     mtexe
		     " -server - ";; (or target-host "-")
		     " -m testsuite:" testsuite
		     " -run-id " (or run-id "main")
		     " -db "  (dbmod:run-id->dbfname run-id)
		     " " profile-mode
		     ))) ;; (conc " >> " logfile " 2>&1 &")))))
    ;; we want the remote server to start in *toppath* so push there
    (push-directory areapath)
    (debug:print 0 *default-log-port* "INFO: Trying to start server in tcp mode (" cmdln ") ...")
    (debug:print 0 *default-log-port* "INFO: starting server at " (common:human-time))
    (system (conc "nbfake " cmdln))
    (pop-directory)))
    ;; (push-directory areapath) ;; use cd in the command line instead
    (debug:print 0 *default-log-port* "INFO: Trying to start server in tcp mode (" cmdln ") at "(common:human-time)"...")
    ;; (debug:print 0 *default-log-port* "INFO: starting server at " (common:human-time))
    (setenv "NBFAKE_QUIET" "yes") ;; BUG: change to with-environment-variable ...
    (system (conc "cd "areapath" ; nbfake " cmdln))
    (unsetenv "NBFAKE_QUIET")
    ;;(pop-directory)
    ))

;;======================================================================
;; tcp connection stuff
;;======================================================================

;; find a port and start tcp-server. This only starts the tcp portion of
;; the server, look at (tt:start-server ...) above for the entry point

Modified utils/nbfake from [3dc733e001] to [3e514ddfd2].

37
38
39
40
41
42
43

44
45
46
47
48
49
50
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51







+







nbfake <command to run>

nbfake behavior can be changed by setting the following env vars:
   NBFAKE_HOST       SSH to \$NBFAKE_HOST and run command
   NBFAKE_LOG        Logfile for nbfake output
   NB_WASH_GROUPS    comma-separated list of groups to wash into
   NB_WASH_ENABLED   must be set in order to enable wash groups
   NBFAKE_QUIET      set to suppress informational output

__EOF
  exit
fi

#==============================================================================
# Setup
85
86
87
88
89
90
91

92
93
94
95
96
97

98
99
100
101
102
103
104
105
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108







+






+








   WASHCMD="wash -q -n $grouplist -X"
fi

#==============================================================================
# Run and log
#==============================================================================

if [[ -z "$NBFAKE_QUIET" ]];then
cat <<__EOF >&2
#======================================================================
# NBFAKE logging command to: $MY_NBFAKE_LOG
#     $WASHCMD $*
#======================================================================
__EOF
fi

if [[ -z "$MY_NBFAKE_HOST" ]]; then
  # Run locally
  sh -c "cd $CURRWD;export DISPLAY=$DISPLAY; export PATH=\"$PATH\"; nohup $WASHCMD $* >> $MY_NBFAKE_LOG 2>&1 &"
else
  # run remotely
  ssh -X -n -f $MY_NBFAKE_HOST "sh -c \"cd $CURRWD;export DISPLAY=$DISPLAY; export PATH=\"$PATH\"; nohup $WASHCMD $* >> $MY_NBFAKE_LOG 2>&1 &\""
fi