Megatest

Check-in [158a434c54]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Portlogger uses CREATE TABLE IF NOT EXISTS, so no need to test for file - just create the table every time. Added kill server when http-client has issue. Fixed typos in tasks:kill-server
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 158a434c54768e10ebfa3b5df1dee86ea5641779
User & Date: mrwellan on 2014-11-06 07:33:38
Other Links: branch diff | manifest | tags
Context
2014-11-06
08:52
Added safety net for server start failing, put server kills into log file server-kills.log check-in: cf0372bf78 user: mrwellan tags: v1.60
07:33
Portlogger uses CREATE TABLE IF NOT EXISTS, so no need to test for file - just create the table every time. Added kill server when http-client has issue. Fixed typos in tasks:kill-server check-in: 158a434c54 user: mrwellan tags: v1.60
2014-11-05
15:33
Fix issues in lock queue and portlogger check-in: 5bc446ef43 user: mrwellan tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [51076419ec] to [fba3cc219f].

︙
208
209
210
211
212
213
214
215

216
217
218
219
220
221
222

208
209
210
211
212
213
214

215
216
217
218
219
220
221
222








-
+








    (if val val default)))

(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "server" "testsuite" )
  (or (configf:lookup *configdat* "setup" "testsuite" )
       (pathname-file *toppath*)))

;;======================================================================
;; Misc utils
;;======================================================================

;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
︙

Modified http-transport.scm from [f3dd18aa3b] to [231b0ef76f].

︙
273
274
275
276
277
278
279
280

281


282
283
284
285
286
287
288

273
274
275
276
277
278
279

280
281
282
283
284
285
286
287
288
289
290








-
+

+
+








       (let* ((send-recieve (lambda ()
			      (mutex-lock! *http-mutex*)
			      ;; (condition-case (with-input-from-request "http://localhost"; #f read-lines)
			      ;;					       ((exn http client-error) e (print e)))
			      (set! res (handle-exceptions
					 exn
					 (begin
					   (debug:print 0 "ERROR: failure in with-input-from-request. Giving up.")
					   (debug:print 0 "WARNING: failure in with-input-from-request. Killing associated server to allow clean retry.")
					   (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
					   (hash-table-delete! *runremote* run-id)
					   (tasks:kill-server-run-id run-id)
					   #f)
					 (with-input-from-request ;; was dat
					  fullurl 
					  (list (cons 'key "thekey")
						(cons 'cmd cmd)
						(cons 'params params))
					  read-string)))
︙

Modified launch.scm from [1d44ba3939] to [56d8cf0de9].

︙
110
111
112
113
114
115
116





117
118
119
120
121
122
123

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








+
+
+
+
+








	  (if (not (launch:setup-for-run force: #t))
	      (begin
		(debug:print 0 "Failed to setup, exiting") 
		;; (sqlite3:finalize! db)
		;; (sqlite3:finalize! tdb)
		(exit 1)))
	  (change-directory *toppath*) 

	  ;; NOTE: Current order is to process runconfigs *before* setting the MT_ vars. This 
	  ;;       seems non-ideal but could well break stuff
	  ;;    BUG? BUG? BUG?

	  (let ((rconfig (full-runconfigs-read))) ;; (read-config (conc  *toppath* "/runconfigs.config") #f #t sections: (list "default" target))))
	    ;; (setup-env-defaults (conc *toppath* "/runconfigs.config") run-id (make-hash-table) keyvals target)
	    ;; (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id))
	    ;; Now have runconfigs data loaded, set environment vars
	    (for-each (lambda (section)
			(for-each (lambda (varval)
				    (let ((var (car varval))
︙
156
157
158
159
160
161
162
163



164
165
166
167
168
169
170

161
162
163
164
165
166
167

168
169
170
171
172
173
174
175
176
177








-
+
+
+








	      (list  "MT_TEST_RUN_DIR" work-area)
	      (list  "MT_TEST_NAME" test-name)
	      (list  "MT_ITEM_INFO" (conc itemdat))
	      (list  "MT_ITEMPATH"  item-path)
	      (list  "MT_RUNNAME"   runname)
	      (list  "MT_MEGATEST"  megatest)
	      (list  "MT_TARGET"    target)
	      (list  "MT_LINKTREE"  (configf:lookup *configdat* "setup" "linktree"))))
	      (list  "MT_LINKTREE"  (configf:lookup *configdat* "setup" "linktree"))
	      (list  "MT_TESTSUITENAME" (common:get-testsuite-name))))

	  (if mt-bindir-path (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path)))
	  ;; (change-directory top-path)
	  ;; Can setup as client for server mode now
	  ;; (client:setup)

	  
	  ;; environment overrides are done *before* the remaining critical envars.
︙

Modified portlogger.scm from [94a24592b0] to [7d6226a7b8].

︙
24
25
26
27
28
29
30








31
32
33
34
35
36




37
38
39
40

41
42
43
44
45
46
47

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40




41
42
43
44
45
46
47

48
49
50
51
52
53
54
55








+
+
+
+
+
+
+
+


-
-
-
-
+
+
+
+



-
+








	 (db       (if avail 
		       (sqlite3:open-database fname)
		       (begin
			 (system (conc "rm -f " fname))
			 (sqlite3:open-database fname))))
	 (handler  (make-busy-timeout 136000))
	 (canwrite (file-write-access? fname)))
	 ;; (db-init  (lambda ()
	 ;;             (sqlite3:execute 
	 ;;              db
	 ;;              "CREATE TABLE IF NOT EXISTS ports (
         ;;                 port INTEGER PRIMARY KEY,
         ;;                 state TEXT DEFAULT 'not-used',
         ;;                 fail_count INTEGER DEFAULT 0,
         ;;                 update_time TIMESTAMP DEFAULT (strftime('%s','now')) );"))))
    (sqlite3:set-busy-handler! db handler)
    (sqlite3:execute db "PRAGMA synchronous = 0;")
    (if (not exists)
	(sqlite3:execute 
	 db
	 "CREATE TABLE IF NOT EXISTS ports (
    ;; (if (not exists) ;; needed with IF NOT EXISTS?
    (sqlite3:execute 
     db
     "CREATE TABLE IF NOT EXISTS ports (
            port INTEGER PRIMARY KEY,
            state TEXT DEFAULT 'not-used',
            fail_count INTEGER DEFAULT 0,
            update_time TIMESTAMP DEFAULT (strftime('%s','now')) );"))
            update_time TIMESTAMP DEFAULT (strftime('%s','now')) );")
    db))

(define (portlogger:open-run-close proc . params)
  (let* ((fname  (conc "/tmp/." (current-user-name) "-portlogger.db"))
	 (avail  (tasks:wait-on-journal fname 10))) ;; wait up to about 10 seconds for the journal to go away
    (handle-exceptions
     exn
︙

Modified runs.scm from [31523ae98e] to [27619ede09].

︙
64
65
66
67
68
69
70

71
72
73
74
75
76
77

64
65
66
67
68
69
70
71
72
73
74
75
76
77
78








+








    (for-each (lambda (keyval)
		(setenv (car keyval)(cadr keyval)))
	      keyvals)
    ;; Set up various and sundry known vars here
    (setenv "MT_RUN_AREA_HOME" toppath)
    (setenv "MT_RUNNAME" runname)
    (setenv "MT_TARGET"  target)
    (setenv "MT_TESTSUITENAME" (common:get-testsuite-name))
    (set! envdat (append 
		  envdat
		  (list (list "MT_RUN_AREA_HOME" toppath)
			(list "MT_RUNNAME"       runname)
			(list "MT_TARGET"        target))))
    ;; Now can read the runconfigs file
    ;;
︙

Modified tasks.scm from [27fcff8907] to [40e15eef78].

︙
346
347
348
349
350
351
352
353

354
355

356
357
358
359



360
361
362



363
364
365
366
367
368
369

346
347
348
349
350
351
352

353
354

355
356
357


358
359
360
361


362
363
364
365
366
367
368
369
370
371








-
+

-
+


-
-
+
+
+

-
-
+
+
+








  (setenv "TARGETHOST_LOGF" "server-kills.log")
  (system (conc "nbfake kill " pid))
  (unsetenv "TARGETHOST_LOGF")
  (unsetenv "TARGETHOST"))
 
;; look up a server by run-id and send it a kill, also delete the record for that server
;;
(define (tasks:kill-server-run-id run-id)
(define (tasks:kill-server-run-id run-id #!key (tag "default"))
  (let* ((tdb  (tasks:open-db))
	 (sdat (tasks:get-server mdb run-id)))
	 (sdat (tasks:get-server tdb run-id)))
    (if sdat
	(let ((hostname (vector-ref sdat 6))
	      (pid      (vector-ref sdat 5)))
	  (debug:print-info 0 "Killing server for run-id " run-id " on host " hostname " with pid " pid)
	      (pid      (vector-ref sdat 5))
	      (server-id (vector-ref sdat 0)))
	  (debug:print-info 0 "Killing server " server-id " for run-id " run-id " on host " hostname " with pid " pid)
	  (tasks:kill-server hostname pid)
	  (tasks:server-delete-record mdb server-id tag) )
	(debug:print-info 0 "No server found for run-id " run-id ", nothing to kill"))))
	  (tasks:server-delete-record tdb server-id tag) )
	(debug:print-info 0 "No server found for run-id " run-id ", nothing to kill"))
    (sqlite3:finalize! tdb)))
    
;;   (if status ;; #t means alive
;;       (begin
;; 	(if (equal? hostname (get-host-name))
;; 	    (handle-exceptions
;; 	     exn
;; 	     (debug:print-info 0 "server may or may not be dead, check for megatest -server running as pid " pid "\n"
︙

This page was generated in about 0.113s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00