421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
|
(string->number tmo))
(* 60 60 (string->number tmo))
;; default to three days
(* 3 24 60 60)))))
(debug:print-info 2 "server-timeout: " server-timeout ", server pid: " spid " on " iface ":" port)
(let loop ((count 0))
;; Use this opportunity to sync the inmemdb to db
(if *inmemdb* (db:sync-to *inmemdb* *db*))
(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)
(mutex-lock! *heartbeat-mutex*)
(set! sdat *runremote*)
|
>
>
>
|
>
>
>
>
>
>
|
|
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
|
(string->number tmo))
(* 60 60 (string->number tmo))
;; default to three days
(* 3 24 60 60)))))
(debug:print-info 2 "server-timeout: " server-timeout ", server pid: " spid " on " iface ":" port)
(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-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*))
(set! sync-time (- (current-milliseconds) start-time))
(debug:print 0 "SYNC: time= " sync-time)
(set! rem-time (quotient (- 4000 sync-time) 1000))
(if (and (< rem-time 4)
(> rem-time 0))
(thread-sleep! rem-time)))
;; (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)
(mutex-lock! *heartbeat-mutex*)
(set! sdat *runremote*)
|
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
|
(begin
(debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(loop 0))
(begin
(debug:print-info 0 "Starting to shutdown the server.")
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
(if *inmemdb* (db:sync-to *inmemdb* *db*))
(open-run-close tasks:server-deregister-self tasks:open-db (get-host-name))
(thread-sleep! 1)
(debug:print-info 0 "Max cached queries was " *max-cache-size*)
(debug:print-info 0 "Number of cached writes " *number-of-writes*)
(debug:print-info 0 "Average cached write time "
(if (eq? *number-of-writes* 0)
"n/a (no writes)"
|
|
|
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
|
(begin
(debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(loop 0))
(begin
(debug:print-info 0 "Starting to shutdown the server.")
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
(if *inmemdb* (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*))
(open-run-close tasks:server-deregister-self tasks:open-db (get-host-name))
(thread-sleep! 1)
(debug:print-info 0 "Max cached queries was " *max-cache-size*)
(debug:print-info 0 "Number of cached writes " *number-of-writes*)
(debug:print-info 0 "Average cached write time "
(if (eq? *number-of-writes* 0)
"n/a (no writes)"
|
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
|
(args:get-arg "-server")
"-"))) "Server run"))
(th3 (make-thread http-transport:keep-running "Keep running")))
;; (th1 (make-thread server:write-queue-handler "write queue")))
(set! *cache-on* #t)
(set! *db* (open-db))
(set! *inmemdb* (open-in-mem-db))
(db:sync-to *db* *inmemdb*)
(thread-start! th2)
(thread-start! th3)
;; (thread-start! th1)
(set! *didsomething* #t)
(thread-join! th2))
(debug:print 0 "ERROR: Failed to setup for megatest")))
|
|
|
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
(args:get-arg "-server")
"-"))) "Server run"))
(th3 (make-thread http-transport:keep-running "Keep running")))
;; (th1 (make-thread server:write-queue-handler "write queue")))
(set! *cache-on* #t)
(set! *db* (open-db))
(set! *inmemdb* (open-in-mem-db))
(db:sync-tables (db:tbls *db*) *db* *inmemdb*) ;; (db:sync-to *db* *inmemdb*)
(thread-start! th2)
(thread-start! th3)
;; (thread-start! th1)
(set! *didsomething* #t)
(thread-join! th2))
(debug:print 0 "ERROR: Failed to setup for megatest")))
|