| ︙ | | |
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
|
+
|
(if (debug:debug-mode 1)
(debug:print-info 0 *default-log-port* "couldn't talk to server, trying again ...")
(begin
(debug:print 0 *default-log-port* "WARNING: failure in with-input-from-request to " fullurl ".")
(debug:print 0 *default-log-port* " message: " msg ", exn=" exn)
(debug:print 0 *default-log-port* " cmd: " cmd " params: " params " key:" (or server-id "thekey"))
(debug:print 0 *default-log-port* " call-chain: " call-chain)))
;; what if another thread is communicating ok? Can't happen due to mutex
(set! *runremote* #f)
(set! runremote #f)
;; (if runremote
;; (remote-conndat-set! runremote #f))
;; Killing associated server to allow clean retry.")
;; (tasks:kill-server-run-id run-id) ;; better to kill the server in the logic that called this routine?
(mutex-unlock! *http-mutex*)
|
| ︙ | | |
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
|
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
|
-
+
+
|
(begin
(print-call-chain (current-error-port))
(debug:print-error 0 *default-log-port* "call to http-transport:server-dat-update-last-access with non-vector!!"))))
;;
;; connect
;;
(define (http-transport:client-connect iface port server-id)
(define (http-transport:client-connect iface port server-id)
(debug:print-info 0 *default-log-port* "Connecting to client at "iface":"port", with server-id "server-id)
(let* ((api-url (conc "http://" iface ":" port "/api"))
(api-uri (uri-reference (conc "http://" iface ":" port "/api")))
(api-req (make-request method: 'POST uri: api-uri))
(server-dat (vector iface port api-uri api-url api-req (current-seconds) server-id)))
server-dat))
|
| ︙ | | |
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
|
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
471
472
473
474
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
-
+
-
+
+
+
+
-
+
|
(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 ()
(let* ((serv-id (server:mk-signature)))
(set! *server-id* serv-id)
(print "SERVER STARTED: "ipaddr":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id))
(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))
|
| ︙ | | |
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
|
-
+
|
(if (not (equal? sdat (list iface port)))
(let ((new-iface (car sdat))
(new-port (cadr sdat)))
(debug:print-info 0 *default-log-port* "WARNING: interface changed, refreshing iface and port info")
(set! iface new-iface)
(set! port new-port)
(if (not *server-id*)
(set! *server-id* (server:mk-signature)))
|
| ︙ | | |
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
|
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
|
-
+
-
+
+
+
+
|
;; (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
|
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
|
-
-
-
-
+
+
+
+
|
(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"))
|
| ︙ | | |