Megatest

Check-in [23a0587e45]
Login
Overview
Comment:Experimentatal change to more aggressively try to connect to servers
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 23a0587e45d3ffc925c187aaf3693d2d6dd7ef0f
User & Date: matt on 2014-02-24 22:41:52
Other Links: branch diff | manifest | tags
Context
2014-02-24
23:17
Merged in last few changes to v1.55 check-in: c5c6fa7396 user: matt tags: v1.60
22:41
Experimentatal change to more aggressively try to connect to servers check-in: 23a0587e45 user: matt tags: v1.60
22:15
Added debugging tags to server state changes. Cleaned up dashboard to display new server data. check-in: 904e5f7d6c user: matt tags: v1.60
Changes

Modified http-transport.scm from [462dc5100a] to [a5ab69b6ac].

404
405
406
407
408
409
410
411


412

413
414
415
416
417









418
419
420
421
422
423
424
404
405
406
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! *run-id*   run-id)
  (if (args:get-arg "-daemonize")
      (daemon:ize))
  (if (server:check-if-running run-id)
      (begin
	(debug:print 0 "INFO: Server for run-id " run-id " already running")
	(exit 0)))
  (let ((server-id (open-run-close tasks:server-lock-slot tasks:open-db run-id)))
  (let loop ((server-id (open-run-close tasks:server-lock-slot tasks:open-db run-id))
	     (remtries  4))
    (if (not server-id)
	(if (> remtries 0)
	(begin
	  ;; since we didn't get the server lock we are going to clean up and bail out
	  (debug:print-info 2 "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue")
	  (open-run-close tasks:server-delete-records-for-this-pid tasks:open-db " http-transport:launch")
	  )
	    (begin
	      (thread-sleep! 2)
	      (loop (open-run-close tasks:server-lock-slot tasks:open-db run-id)
		    (- remtries 1)))
	    (begin
	      ;; since we didn't get the server lock we are going to clean up and bail out
	      (debug:print-info 2 "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue")
	      (open-run-close tasks:server-delete-records-for-this-pid tasks:open-db " http-transport:launch")
	      ))
	(let* ((th2 (make-thread (lambda ()
				   (http-transport:run 
				    (if (args:get-arg "-server")
					(args:get-arg "-server")
					"-")
				    run-id
				    server-id)) "Server run"))