456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
|
;; 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))
(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))
(best-ten (lambda ()
(if (> (length all-valid) 10)
(take all-valid 10)
all-valid)))
(names->dats (lambda (names)
(map (lambda (x)
(hash-table-ref serversdat x))
names)))
(am-home? (lambda ()
(let* ((currhost (get-host-name))
(bestadrs (server:get-best-guess-address currhost)))
|
|
|
>
>
|
|
|
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
|
;; 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))
(servkeys (hash-table-keys serversdat))
(by-time-asc (if (not (null? servkeys)) ;; NOTE: Oldest is last
(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))
(best-ten (lambda ()
(if (> (length all-valid) 11)
(take (drop-right all-valid 1) 10) ;; remove the oldest from consideration so it can age out
(if (> (length all-valid) 8)
(drop-right all-valid 1)
all-valid))))
(names->dats (lambda (names)
(map (lambda (x)
(hash-table-ref serversdat x))
names)))
(am-home? (lambda ()
(let* ((currhost (get-host-name))
(bestadrs (server:get-best-guess-address currhost)))
|
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
|
;; Default is 60 seconds.
;;
(define (server:expiration-timeout)
(let ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (and (string? tmo)
(common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below
(* 3600 (string->number tmo))
60)))
(define (server:get-best-guess-address hostname)
(let ((res #f))
(for-each
(lambda (adr)
(if (not (eq? (u8vector-ref adr 0) 127))
(set! res adr)))
|
|
|
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
|
;; Default is 60 seconds.
;;
(define (server:expiration-timeout)
(let ((tmo (configf:lookup *configdat* "server" "timeout")))
(if (and (string? tmo)
(common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below
(* 3600 (string->number tmo))
600)))
(define (server:get-best-guess-address hostname)
(let ((res #f))
(for-each
(lambda (adr)
(if (not (eq? (u8vector-ref adr 0) 127))
(set! res adr)))
|