Megatest

Check-in [a2b1dcfd75]
Login
Overview
Comment:Added lock-in check for server. Removed inapropriate exit from server check
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | archiving
Files: files | file ages | folders
SHA1: a2b1dcfd75fd5a73280ad4c6a8fb6363db938da6
User & Date: matt on 2014-12-03 22:48:26
Other Links: branch diff | manifest | tags
Context
2014-12-04
22:23
Merged fixes back to v1.60 from archiving check-in: 33d8665511 user: matt tags: v1.60
2014-12-03
22:48
Added lock-in check for server. Removed inapropriate exit from server check Closed-Leaf check-in: a2b1dcfd75 user: matt tags: archiving
2014-12-02
23:19
Added small random delay in server lock. Fix bad params in rmt call in runs.scm check-in: bcc2bef4ad user: matt tags: archiving
Changes

Modified http-transport.scm from [9b98c664db] to [c0d3a601db].

407
408
409
410
411
412
413


414
415
416
417
418








419
420
421
422
423
424
425
407
408
409
410
411
412
413
414
415





416
417
418
419
420
421
422
423
424
425
426
427
428
429
430







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







	(set! rem-time (quotient (- 4000 sync-time) 1000))
	(debug:print 2 "SYNC: time= " sync-time ", rem-time=" rem-time)

      ;;
      ;; set_running after our first pass through and start the db
      ;;
      (if (eq? server-state 'available)
	  (let ((new-server-id (tasks:server-am-i-the-server? (db:delay-if-busy tdbdat) run-id))) ;; try to ensure no double registering of servers
	    (if (equal? new-server-id server-id)
	  (begin
	    (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
	    (thread-sleep! 5) ;; give some margin for queries to complete before switching from file based access to server based access
	    (set! *inmemdb*  (db:setup run-id))
	    (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")))
		(begin
		  (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
		  (thread-sleep! 5) ;; give some margin for queries to complete before switching from file based access to server based access
		  (set! *inmemdb*  (db:setup run-id))
		  (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running"))
		(begin ;; gotta exit nicely
		  (tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision")
		  (http-transport:server-shutdown server-id port)))))

      (if (and (<= rem-time 4)
	       (> rem-time 0))
	  (thread-sleep! rem-time)
	  (thread-sleep! 4))) ;; fallback for if the math is changed ...
      
      (if (< count 1) ;; 3x3 = 9 secs aprox

Modified tasks.scm from [097767a9cc] to [edd9ff6647].

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
















300
301
302
303
304
305
306
279
280
281
282
283
284
285














286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308







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







		(loop (get-rand-port)(- remtries 1))
		(get-rand-port))
	    port))))))

(define (tasks:server-am-i-the-server? mdb run-id)
  (let* ((all    (tasks:server-get-servers-vying-for-run-id mdb run-id))
	 (first  (if (null? all)
		     (begin (debug:print 0 "ERROR: no servers listed, should be at least one by now.") 
			    (sqlite3:finalize! mdb)
			    (exit 1))
		     (car (db:get-rows all))))
	 (header   (db:get-header all))
	 (id       (db:get-value-by-header first header "id"))
	 (hostname (db:get-value-by-header first header "hostname"))
	 (pid      (db:get-value-by-header first header "pid"))
	 (priority (db:get-value-by-header first header "priority")))
    (debug:print 0 "INFO: am-i-the-server got record " first)
    ;; for now a basic check. add tiebreaking by priority later
    (if (and (equal? hostname (get-host-name))
	     (equal? pid      (current-process-id)))
	id
		     #f;; (begin (debug:print 0 "ERROR: no servers listed, should be at least one by now.") 
		       ;;      (sqlite3:finalize! mdb)
		       ;;      (exit 1))
		     (car (db:get-rows all)))))
    (if first
	(let* ((header   (db:get-header all))
	       (id       (db:get-value-by-header first header "id"))
	       (hostname (db:get-value-by-header first header "hostname"))
	       (pid      (db:get-value-by-header first header "pid"))
	       (priority (db:get-value-by-header first header "priority")))
	  ;; (debug:print 0 "INFO: am-i-the-server got record " first)
	  ;; for now a basic check. add tiebreaking by priority later
	  (if (and (equal? hostname (get-host-name))
		   (equal? pid      (current-process-id)))
	      id
	      #f))
	#f)))
	     
;; Use: (db:get-value-by-header (car (db:get-rows dat)) (db:get-header dat) "fieldname")
;;  to extract info from the structure returned
;;
(define (tasks:server-get-servers-vying-for-run-id mdb run-id)
   (let* ((header (list "id" "hostname" "pid" "interface" "port" "pubport" "state" "run_id" "priority" "start_time"))