Megatest

Diff
Login

Differences From Artifact [e3a9a59227]:

To Artifact [5d7f3edf83]:


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
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







-
-
+
+
+
+
+







-
+
-
-
+
-








(define (server:keep-running db host:port)
  ;; if none running or if > 20 seconds since 
  ;; server last used then start shutdown
  (let loop ((count 0))
    (thread-sleep! 20) ;; no need to do this very often
    (let ((numrunning (db:get-count-tests-running db)))
      (if (or (not (> numrunning 0))
	      (> *last-db-access* (+ (current-seconds) 60)))
      (if (or (> numrunning 0)
	      (> (+ *last-db-access* 60)(current-seconds)))
	  (begin
	    (debug:print 0 "INFO: Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*))
	    (loop (+ 1 count)))
	  (begin
	    (debug:print 0 "INFO: Starting to shutdown the server side")
	    ;; need to delete only *my* server entry (future use)
	    (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' AND val like ?;"  host:port)
	    (thread-sleep! 10)
	    (debug:print 0 "INFO: Max cached queries was " *max-cache-size*)
	    (debug:print 0 "INFO: Server shutdown complete. Exiting")
	    (exit))
	    ;; (exit)))
	  (debug:print 0 "INFO: Server continuing, tests running: " numrunning ", seconds since last db access: " (- (current-seconds) *last-db-access*))
	  ))
	    )))))
    (loop (+ 1 count))))

(define (server:find-free-port-and-open port)
  (handle-exceptions
   exn
   (begin
     (print "Failed to bind to port " (rpc:default-server-port) ", trying next port")
     (server:find-free-port-and-open (+ port 1)))
197
198
199
200
201
202
203
204

205
206
207

208
209
210
198
199
200
201
202
203
204

205
206
207

208
209
210
211







-
+


-
+



		 ;;  (lambda (db . param) 
		 ;;    (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER'"))
		 ;;  #f)
		 (set! *runremote* #f))
	       (if (and (not (args:get-arg "-server")) ;; no point in the server using the server using the server
			((rpc:procedure 'server:login host portn) *toppath*))
		   (begin
		     (debug:print 2 "INFO: Connected to " host ":" port)
		     (debug:print 2 "INFO: Logged in and connected to " host ":" port)
		     (set! *runremote* (vector host portn)))
		   (begin
		     (debug:print 2 "INFO: Failed to connect to " host ":" port)
		     (debug:print 2 "INFO: Failed to login or connect to " host ":" port)
		     (set! *runremote* #f)))))
	    (debug:print 2 "INFO: no server available")))))