| ︙ | | |
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
-
+
-
+
|
;;======================================================================
(define-inline (zmqsock:get-pub dat)(vector-ref dat 0))
(define-inline (zmqsock:get-pull dat)(vector-ref dat 1))
(define-inline (zmqsock:set-pub! dat s)(vector-set! dat s 0))
(define-inline (zmqsock:set-pull! dat s)(vector-set! dat s 0))
(define (zmq-transport:run hostn)
(define (zmq-transport:run hostn area-dat)
(debug:print 2 "Attempting to start the server ...")
(if (not *toppath*)
(if (not (megatest:area-path area-dat))
(if (not (setup-for-run))
(begin
(debug:print 0 "ERROR: cannot find megatest.config, cannot start server, exiting")
(exit))))
(let* ((db (open-db)) ;; here we *do not* want to be opening and closing the db
(zmq-sdat1 #f)
(zmq-sdat2 #f)
|
| ︙ | | |
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
-
+
-
+
|
(set! zmq-sdat2 (cadr zmq-sockets-dat))
(set! pub-socket (cadr zmq-sdat2))
(set! p2 (caddr zmq-sdat2))
(set! *cache-on* #t)
(set! *runremote* (vector pull-socket pub-socket)) ;; overloading the use of *runremote* BUG!?
(set! *runremote* (vector pull-socket pub-socket)) ;; overloading the use of (common:get-remote remote) BUG!?
;; what to do when we quit
;;
;; (on-exit (lambda ()
;; (if (and *toppath* *server-info*)
;; (if (and toppath *server-info*)
;; (open-run-close tasks:server-deregister-self tasks:open-db (car *server-info*))
;; (let loop ()
;; (let ((queue-len 0))
;; (thread-sleep! (random 5))
;; (mutex-lock! *incoming-mutex*)
;; (set! queue-len (length *incoming-data*))
;; (mutex-unlock! *incoming-mutex*)
|
| ︙ | | |
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
-
-
-
+
+
+
-
+
|
(tasks:server-deregister-self tdb (get-host-name))
(thread-sleep! 1)
(debug:print-info 0 "Max cached queries was " *max-cache-size*)
(debug:print-info 0 "Server shutdown complete. Exiting")
(exit)))))))
;; all routes though here end in exit ...
(define (zmq-transport:launch)
(if (not *toppath*)
(if (not (setup-for-run))
(define (zmq-transport:launch run-id area-dat)
(if (not (megatest:area-path area-dat))
(if (not (launch:setup-for-run area-dat))
(begin
(debug:print 0 "ERROR: cannot find megatest.config, exiting")
(exit))))
(debug:print-info 2 "Starting zmq server")
(if *toppath*
(if (megatest:area-path area-dat)
(let* (;; (th1 (make-thread (lambda ()
;; (let ((server-info #f))
;; ;; wait for the server to be online and available
;; (let loop ()
;; (debug:print-info 2 "Waiting for the server to come online before starting heartbeat")
;; (thread-sleep! 2)
;; (mutex-lock! *heartbeat-mutex*)
|
| ︙ | | |
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
|
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
|
-
+
|
;; ;; server-info: server-id interface pullport pubport
;; (let ((iface (list-ref server-info 1))
;; (pullport (list-ref server-info 2))
;; (pubport (list-ref server-info 3)))
;; (zmq-transport:client-connect iface pullport pubport)
;; (let loop ()
;; (thread-sleep! 2)
;; (cdb:client-call *runremote* 'ping #t)
;; (cdb:client-call (common:get-remote remote) 'ping #t)
;; (debug:print 4 "zmq-transport:self-ping - I'm alive on " iface ":" pullport "/" pubport "!")
;; (mutex-lock! *heartbeat-mutex*)
;; (set! *server-loop-heart-beat* (current-seconds))
;; (mutex-unlock! *heartbeat-mutex*)
;; (loop))))
(define (zmq-transport:reply pubsock target query-sig success/fail result)
(debug:print-info 11 "zmq-transport:reply target=" target ", result=" result)
(send-message pubsock target send-more: #t)
(send-message pubsock (db:obj->string (vector success/fail query-sig result))))
|