Megatest

Check-in [370194c6a9]
Login
Overview
Comment:Removed the active client start code to ensure the dynamic server start is used.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 370194c6a9483c4c692736e060357393934861f3
User & Date: matt on 2014-09-04 23:31:01
Other Links: branch diff | manifest | tags
Context
2014-09-05
09:01
Added some checks for when there are no tests in a regression check-in: a389004ce8 user: mrwellan tags: v1.60
2014-09-04
23:31
Removed the active client start code to ensure the dynamic server start is used. check-in: 370194c6a9 user: matt tags: v1.60
18:22
Trying more agressive resistance to starting the server check-in: da01ac3b4f user: mrwellan tags: v1.60
Changes

Modified megatest.scm from [e18b6443a0] to [559efa54dd].

462
463
464
465
466
467
468
469
470
471

472
473
474
475
476
477
478
479
				  (string->number (args:get-arg "-run-id")))))
	      ;; (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
	      ;; if not list or kill then start a client (if appropriate)
	      (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
		      (eq? (length (hash-table-keys args:arg-hash)) 0))
		  (debug:print-info 1 "Server connection not needed")
		  (begin
		    (if run-id 
			(client:launch run-id) 
			(client:launch 0)      ;; without run-id we'll start a server for "0"

			)))))))

;; MAY STILL NEED THIS
;;		       (set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))

(if (or (args:get-arg "-list-servers")
	(args:get-arg "-stop-server"))
    (let ((tl (launch:setup-for-run)))







|
|
|
>
|







462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
				  (string->number (args:get-arg "-run-id")))))
	      ;; (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
	      ;; if not list or kill then start a client (if appropriate)
	      (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
		      (eq? (length (hash-table-keys args:arg-hash)) 0))
		  (debug:print-info 1 "Server connection not needed")
		  (begin
		    ;; (if run-id 
		    ;;     (client:launch run-id) 
		    ;;     (client:launch 0)      ;; without run-id we'll start a server for "0"
		    #t
		    ))))))

;; MAY STILL NEED THIS
;;		       (set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))

(if (or (args:get-arg "-list-servers")
	(args:get-arg "-stop-server"))
    (let ((tl (launch:setup-for-run)))

Modified rmt.scm from [9e1ede500b] to [caf7bcfa2c].

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
56
57
58
59
;; )


;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================



(define (rmt:write-frequency-over-limit? cmd run-id)
  (or (member cmd api:read-only-queries)
      (let* ((tmprec (hash-table-ref/default *write-frequency* run-id #f))
	     (record (if tmprec tmprec 
			 (let ((v (vector (current-seconds) 0)))
			   (hash-table-set! *write-frequency* run-id v)
			   v)))
	     (count  (+ 1 (vector-ref record 1)))
	     (start  (vector-ref record 0)))
	(vector-set! record 1 count)
	(if (and (> count 10) 
		 (< (/ (- (current-seconds) start)
		       count) ;; seconds per count
		    10))
	    (begin
	      (debug:print-info 1 "db write rate too high, starting a server")
	      #t)
	    #f)))) ;; less than 10 seconds per count - start up a server

;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(define (rmt:send-receive cmd rid params)







>
>

|













|







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
56
57
58
59
60
61
;; )


;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================

;; #t means - please start a server!
;;
(define (rmt:write-frequency-over-limit? cmd run-id)
  (or (not (member cmd api:read-only-queries))
      (let* ((tmprec (hash-table-ref/default *write-frequency* run-id #f))
	     (record (if tmprec tmprec 
			 (let ((v (vector (current-seconds) 0)))
			   (hash-table-set! *write-frequency* run-id v)
			   v)))
	     (count  (+ 1 (vector-ref record 1)))
	     (start  (vector-ref record 0)))
	(vector-set! record 1 count)
	(if (and (> count 10) 
		 (< (/ (- (current-seconds) start)
		       count) ;; seconds per count
		    10))
	    (begin
	      (debug:print-info 1 "db write rate too high, starting a server, count=" count " start=" start " run-id=" run-id)
	      #t)
	    #f)))) ;; less than 10 seconds per count - start up a server

;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(define (rmt:send-receive cmd rid params)
71
72
73
74
75
76
77



78
79
80
81
82
83
84
				    #f
				    (let loop ((numtries 100))
				      (let ((res (client:setup run-id)))
					(if res 
					    (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
					    (if (> numtries 0)
						(begin



						  (thread-sleep! 10)
						  (loop (- numtries 1)))
						(begin
						  (debug:print 0 "ERROR: 100 tries and no server, giving up")
						  (exit 1))))))))))
	 (jparams         (db:obj->string params)))
    (if connection-info







>
>
>







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
				    #f
				    (let loop ((numtries 100))
				      (let ((res (client:setup run-id)))
					(if res 
					    (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
					    (if (> numtries 0)
						(begin
						  ;; junk records can cause stuckness here. use this time to
						  ;; clean out
						  (open-run-close tasks:server-clean-out-old-records-for-run-id tasks:open-db run-id "auto-start-clean-up")
						  (thread-sleep! 10)
						  (loop (- numtries 1)))
						(begin
						  (debug:print 0 "ERROR: 100 tries and no server, giving up")
						  (exit 1))))))))))
	 (jparams         (db:obj->string params)))
    (if connection-info

Modified tasks.scm from [84494e5339] to [9d8c491acc].

153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

(define (tasks:num-in-available-state mdb run-id)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (num-in-queue)
       (set! res num-in-queue))
     mdb
     "SELECT count(id) FROM servers WHERE run_id=? AND state = 'available';"
     run-id)
    res))

(define (tasks:num-servers-non-zero-running mdb)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (num-running)







|







153
154
155
156
157
158
159
160
161
162
163
164
165
166
167

(define (tasks:num-in-available-state mdb run-id)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (num-in-queue)
       (set! res num-in-queue))
     mdb
     "SELECT count(id) FROM servers WHERE run_id=? AND state = 'available' AND (strftime('%s','now') - start_time) < 30 ;"
     run-id)
    res))

(define (tasks:num-servers-non-zero-running mdb)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (num-running)
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300

(define (tasks:server-running-or-starting? mdb run-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (id)
       (set! res id))
     mdb
     "SELECT id FROM servers WHERE run_id=? AND state in ('running','available');" run-id)
    res))

(define (tasks:get-all-servers mdb)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (id pid hostname interface port pubport start-time priority state mt-version last-update transport run-id)
       ;;                       0   1        2         3    4       5          6        7     8          9          10        11     12







|







286
287
288
289
290
291
292
293
294
295
296
297
298
299
300

(define (tasks:server-running-or-starting? mdb run-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (id)
       (set! res id))
     mdb
     "SELECT id FROM servers WHERE run_id=? AND (state = 'running' OR (state = 'available' AND  (strftime('%s','now') - start_time) < 30));" run-id)
    res))

(define (tasks:get-all-servers mdb)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (id pid hostname interface port pubport start-time priority state mt-version last-update transport run-id)
       ;;                       0   1        2         3    4       5          6        7     8          9          10        11     12

Modified tests/fullrun/megatest.config from [574df3ad54] to [2212730c5b].

126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
port 8080

# This server will keep running this number of hours after last access. 
# Three minutes is 0.05 hours
# timeout 0.025
timeout 0.01

daemonize yes
hostname #{scheme (get-host-name)}

## disks are:
## name host:/path/to/area
## -or-
## name /path/to/area
[disks]
disk0 /foobarbazz







|
|







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
port 8080

# This server will keep running this number of hours after last access. 
# Three minutes is 0.05 hours
# timeout 0.025
timeout 0.01

# daemonize yes
# hostname #{scheme (get-host-name)}

## disks are:
## name host:/path/to/area
## -or-
## name /path/to/area
[disks]
disk0 /foobarbazz

tests/installall/config/megatest.config.dat became a regular file with contents [736a5da885].

tests/installall/config/runconfigs.config.dat became a regular file with contents [3b8f260acb].