| ︙ | | |
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
+
+
+
+
+
+
+
+
+
+
+
+
|
(define (server:mk-signature)
(message-digest-string (md5-primitive)
(with-output-to-string
(lambda ()
(write (list (current-directory)
(current-process-id)
(argv)))))))
(define (server:get-client-signature)
(if *my-client-signature* *my-client-signature*
(let ((sig (server:mk-signature))) ;; clients re-use the server:mk-signature logic
(set! *my-client-signature* sig)
*my-client-signature*)))
(define (server:get-server-id)
(if *server-id* *server-id*
(let ((sig (server:mk-signature))) ;; clients re-use the server:mk-signature logic
(set! *server-id* sig)
*server-id*)))
;; When using zmq this would send the message back (two step process)
;; with spiffy or rpc this simply returns the return data to be returned
;;
(define (server:reply return-addr query-sig success/fail result)
(debug:print-info 11 *default-log-port* "server:reply return-addr=" return-addr ", result=" result)
;; (send-message pubsock target send-more: #t)
|
| ︙ | | |
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
|
379
380
381
382
383
384
385
386
387
388
389
390
391
392
|
-
-
-
-
-
-
|
#f)
(match-let (((host port start-time server-id)
servr))
(if (and host port)
(conc host ":" port)
#f))))
(define (server:get-client-signature) ;; BB> why is this proc named "get-"? it returns nothing -- set! has not return value.
(if *my-client-signature* *my-client-signature*
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
|
| ︙ | | |
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
|
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
|
-
-
-
-
+
+
+
+
+
+
+
|
;; find oldest alive
;; 1. sort by age ascending and ping until good
;; find alive rand from youngest
;; 1. sort by age descending
;; 2. take five
;; 3. check alive, discard if not and repeat
(let* ((serversdat (server:get-servers-info areapath))
(by-time-asc (sort (hash-table-keys serversdat) ;; list of "host:port"
(lambda (a b)
(>= (list-ref (hash-table-ref serversdat a) 2)
(list-ref (hash-table-ref serversdat b) 2))))))
(servkeys (hash-table-keys serversdat))
(by-time-asc (if (not (null? servkeys))
(sort servkeys ;; list of "host:port"
(lambda (a b)
(>= (list-ref (hash-table-ref serversdat a) 2)
(list-ref (hash-table-ref serversdat b) 2))))
'())))
(if (not (null? by-time-asc))
(let* ((oldest (last by-time-asc))
(oldest-dat (hash-table-ref serversdat oldest))
(host (list-ref oldest-dat 0))
(all-valid (filter (lambda (x)
(equal? host (list-ref (hash-table-ref serversdat x) 0)))
by-time-asc))
|
| ︙ | | |
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
|
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
|
+
+
+
-
+
|
((best) (let* ((best-five (best-five))
(len (length best-five)))
(list-ref best-five (random len))))
(else
(debug:print 0 *default-log-port* "ERROR: invalid command "mode)
#f)))
(begin
(server:run areapath)
(thread-sleep! 3)
#f)))
#f))))
;; kind start up of server, wait before allowing another server for a given
;; area to be launched
;;
(define (server:kind-run areapath)
;; look for $MT_RUN_AREA_HOME/logs/server-start-last
|
| ︙ | | |