Megatest

Diff
Login

Differences From Artifact [c84c869b01]:

To Artifact [fe01ff5087]:


429
430
431
432
433
434
435
436
437

438

439
440


441
442
443
444
445
446
447
429
430
431
432
433
434
435

436
437

438
439

440
441
442
443
444
445
446
447
448







-

+
-
+

-
+
+







    (let loop ((count 0))
      ;; Use this opportunity to sync the inmemdb to db
      (let ((start-time (current-milliseconds))
	    (sync-time  #f)
	    (rem-time   #f))
	(if *inmemdb* (db:sync-touched *inmemdb*))
	(set! sync-time  (- (current-milliseconds) start-time))
	;; (debug:print 0 "SYNC: time= " sync-time)
	(set! rem-time (quotient (- 4000 sync-time) 1000))
	(debug:print 0 "SYNC: time= " sync-time ", rem-time=" rem-time)
	(if (and (< rem-time 4)
	(if (and (<= rem-time 4)
		 (> rem-time 0))
	    (thread-sleep! rem-time)))
	    (thread-sleep! rem-time)
	    (thread-sleep! 4))) ;; fallback for if the math is changed ...

      ;; (thread-sleep! 4) ;; no need to do this very often

      (if (< count 1) ;; 3x3 = 9 secs aprox
	  (loop (+ count 1)))
      
      ;; Check that iface and port have not changed (can happen if server port collides)
458
459
460
461
462
463
464


465
466
467

468
469
470
471
472
473
474
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478







+
+



+







	    (set! spid  (tasks:server-get-server-id tdb #f iface port #f))))
      
      ;; NOTE: Get rid of this mechanism! It really is not needed...
      ;; (open-run-close tasks:server-update-heartbeat tasks:open-db spid)
      (tasks:server-update-heartbeat tdb spid)
      
      ;; (if ;; (or (> numrunning 0) ;; stay alive for two days after last access

      ;; Transfer *last-db-access* to last-access to use in checking that we are still alive
      (mutex-lock! *heartbeat-mutex*)
      (set! last-access *last-db-access*)
      (mutex-unlock! *heartbeat-mutex*)

      ;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
      (if (and *server-run*
	       (> (+ last-access server-timeout)
		  (current-seconds)))
	  (begin
	    (debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
	    (loop 0))
522
523
524
525
526
527
528

529
530
531
532
533
534
535
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540







+







	      ;; Database connection
	      (set! *inmemdb*  (db:setup))
	      (thread-start! th2)
	      (thread-start! th3)
	      (set! *didsomething* #t)
	      (thread-join! th2))
	    (debug:print 0 "ERROR: Failed to setup for megatest")))
    (sdb:qry 'finalize)
    (exit)))

(define (http-transport:server-signal-handler signum)
  (handle-exceptions
   exn
   (debug:print " ... exiting ...")
   (let ((th1 (make-thread (lambda ()