Megatest

Diff
Login

Differences From Artifact [a4eeab2202]:

To Artifact [67f16e95fd]:


396
397
398
399
400
401
402
403
404


405
406
407
408
409
410
411
396
397
398
399
400
401
402


403
404
405
406
407
408
409
410
411







-
-
+
+







		      (begin
			(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "dbprep")
			(thread-sleep! 0.5) ;; give some margin for queries to complete before switching from file based access to server based access
			(set! *dbstruct-db*  (db:setup)) ;;  run-id))
			(set! server-going #t)
			(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "running")
			(server:write-dotserver *toppath* (conc iface ":" port))
			(delete-file* (conc *toppath* "/.starting-server")))
		      (begin ;; gotta exit nicely
                        (server:dotserver-starting-remove))
                      (begin ;; gotta exit nicely
			(tasks:server-set-state! (db:delay-if-busy tdbdat) server-id "collision")
			(http-transport:server-shutdown server-id port))))))

      ;; when things go wrong we don't want to be doing the various queries too often
      ;; so we strive to run this stuff only every four seconds or so.
      (let* ((sync-time (- (current-milliseconds) start-time))
	    (rem-time  (quotient (- 4000 sync-time) 1000)))
518
519
520
521
522
523
524
525
526

527
528
529
530
531
532
533
534
535
518
519
520
521
522
523
524


525


526
527
528
529
530
531
532







-
-
+
-
-







    (exit)))

;; all routes though here end in exit ...
;;
;; start_server? 
;;
(define (http-transport:launch run-id)
  (with-output-to-file
      (conc *toppath* "/.starting-server")
  (server:dotserver-starting)
    (lambda ()
      (print (current-process-id) " on " (get-host-name))))
  (let* ((tdbdat (tasks:open-db)))
    (set! *run-id*   run-id)
    (if (args:get-arg "-daemonize")
	(begin
	  (daemon:ize)
	  (if *alt-log-file* ;; we should re-connect to this port, I think daemon:ize disrupts it
	      (begin
550
551
552
553
554
555
556
557


558
559
560
561
562
563
564
547
548
549
550
551
552
553

554
555
556
557
558
559
560
561
562







-
+
+







		(thread-sleep! 2)
		(loop (tasks:server-lock-slot (db:delay-if-busy tdbdat) run-id 'http)
		      (- remtries 1)))
	      (begin
		;; since we didn't get the server lock we are going to clean up and bail out
		(debug:print-info 2 *default-log-port* "INFO: server pid=" (current-process-id) ", hostname=" (get-host-name) " not starting due to other candidates ahead in start queue")
		(tasks:server-delete-records-for-this-pid (db:delay-if-busy tdbdat) " http-transport:launch")
		(delete-file* (conc *toppath* "/.starting-server"))
                
                (server:dotserver-starting-remove)
		))
	  (let* ((th2 (make-thread (lambda ()
				     (debug:print-info 0 *default-log-port* "Server run thread started")
				     (http-transport:run 
				      (if (args:get-arg "-server")
					  (args:get-arg "-server")
					  "-")