424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
|
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
|
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
-
+
-
+
+
+
+
-
+
|
(debug:print-info 0 *default-log-port* "Waiting for server alive signature")
(mutex-lock! *heartbeat-mutex*)
(set! sdat *server-info*)
(mutex-unlock! *heartbeat-mutex*)
(if (and sdat
(not changed)
(> (- (current-seconds) start-time) 2))
(let* ((servinfodir (conc *toppath*"/.servinfo"))
(ipaddr (car sdat))
(port (cadr sdat))
(servinf (conc servinfodir"/"ipaddr":"port)))
(if (not (file-exists? servinfodir))
(create-directory servinfodir #t))
(with-output-to-file servinf
(lambda ()
(print "SERVER STARTED: "ipaddr":"port" AT "(current-seconds)" server-id: "(server:get-client-signature))
(print "started: "(seconds->year-week/day-time (current-seconds)))))
(set! *on-exit-procs* (cons
(lambda ()
(begin
(delete-file* servinf))
*on-exit-procs*))
;; put data about this server into a simple flat file host.port
(debug:print-info 0 *default-log-port* "Received server alive signature")
(common:save-pkt `((action . alive)
#;(common:save-pkt `((action . alive)
(T . server)
(pid . ,(current-process-id))
(ipaddr . ,(car sdat))
(port . ,(cadr sdat)))
*configdat* #t)
sdat)
(begin
(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
(sleep 4)
(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
(begin
(let* ((ipaddr (car sdat))
(port (cadr sdat))
(servinf (conc *toppath*"/.servinfo/"ipaddr":"port)))
(debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
;; (delete-file* servinf) ;; handled by on-exit, can be removed
(common:save-pkt `((action . died)
#;(common:save-pkt `((action . died)
(T . server)
(pid . ,(current-process-id))
(ipaddr . ,(car sdat))
(port . ,(cadr sdat))
(msg . "Transport died?"))
*configdat* #t)
(exit))
|
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
|
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
|
-
+
-
+
+
+
+
|
;; (if (eq? *number-non-write-queries* 0)
;; "n/a (no queries)"
;; (/ *total-non-write-delay*
;; *number-non-write-queries*))
;; " ms")
(db:print-current-query-stats)
(common:save-pkt `((action . exit)
#;(common:save-pkt `((action . exit)
(T . server)
(pid . ,(current-process-id)))
*configdat* #t)
|
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
|
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
|
-
-
-
-
+
+
+
+
|
(exit)))
;; lets not even bother to start if there are already three or more server files ready to go
#;(let* ((num-alive (server:get-num-alive (server:get-list *toppath*))))
(if (> num-alive 3)
(begin
(cleanup-proc (conc "ERROR: Aborting server start because there are already " num-alive " possible servers either running or starting up"))
(exit))))
(common:save-pkt `((action . start)
(T . server)
(pid . ,(current-process-id)))
*configdat* #t)
#;(common:save-pkt `((action . start)
(T . server)
(pid . ,(current-process-id)))
*configdat* #t)
(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")
"-")
)) "Server run"))
|