Overview
Comment: | Most routines needed for no-homehost updated. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.70-nohomehost |
Files: | files | file ages | folders |
SHA1: |
ed25403d7781b635e0a1e652bb1f0953 |
User & Date: | matt on 2022-11-12 19:25:09 |
Other Links: | branch diff | manifest | tags |
Context
2022-11-13
| ||
04:53 | wip check-in: 87b6d8cf0e user: matt tags: v1.70-nohomehost | |
2022-11-12
| ||
19:25 | Most routines needed for no-homehost updated. check-in: ed25403d77 user: matt tags: v1.70-nohomehost | |
18:34 | server:choose-server now working. check-in: cc546c7dfe user: matt tags: v1.70-nohomehost | |
Changes
Modified server.scm from [b8fe843658] to [2c6bceea6f].
︙ | ︙ | |||
269 270 271 272 273 274 275 | (if (null? tal) (if (and limit (> (length new-res) limit)) new-res ;; (take new-res limit) <= need intelligent sorting before this will work new-res) (loop (string-chomp (car tal)) (cdr tal) new-res))))))))) | | | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 | (if (null? tal) (if (and limit (> (length new-res) limit)) new-res ;; (take new-res limit) <= need intelligent sorting before this will work new-res) (loop (string-chomp (car tal)) (cdr tal) new-res))))))))) #;(define (server:get-num-alive srvlst) (let ((num-alive 0)) (for-each (lambda (server) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "Unable to get server start-time and/or mod-time from " server ", exn=" exn)) |
︙ | ︙ | |||
324 325 326 327 328 329 330 | (lambda (a b) (< (list-ref a 3) (list-ref b 3)))))) (if (> (length slst) nums) (take slst nums) slst))) | | | | | | | | | | | | | | | | | | | | | 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 | (lambda (a b) (< (list-ref a 3) (list-ref b 3)))))) (if (> (length slst) nums) (take slst nums) slst))) ;; ;; switch from server:get-list to server:get-servers-info ;; ;; ;; (define (server:get-first-best areapath) ;; (let ((srvrs (server:get-best (server:get-list areapath)))) ;; (if (and srvrs ;; (not (null? srvrs))) ;; (car srvrs) ;; #f))) ;; ;; (define (server:get-rand-best areapath) ;; (let ((srvrs (server:get-best (server:get-list areapath)))) ;; (if (and (list? srvrs) ;; (not (null? srvrs))) ;; (let* ((len (length srvrs)) ;; (idx (random len))) ;; (list-ref srvrs idx)) ;; #f))) (define (server:record->id servr) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "Unable to get server id from " servr ", exn=" exn) #f) (match-let (((host port start-time server-id) servr)) (if server-id server-id #f)))) (define (server:record->url servr) (handle-exceptions exn (begin (debug:print-info 0 *default-log-port* "Unable to get server url from " servr ", exn=" exn) #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* |
︙ | ︙ | |||
446 447 448 449 450 451 452 | (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))) | | > > > > > > | | > > | | < | 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 475 476 477 | (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-five (lambda () (if (> (length all-valid) 5) (map (lambda (x) (hash-table-ref serversdat x)) (take all-valid 5)) all-valid)))) (case mode ((info) (print "oldest: "oldest-dat", selected host: "host", all-valid: "all-valid) (print "youngest: "(hash-table-ref serversdat (car all-valid)))) ((home) host) ((best-five)(best-five)) ((valid) (map (lambda (x)(hash-table-ref serverdat x)) all-valid)) ((best)(let* ((best-five (best-five)) (len (length best-five))) (list-ref best-five len))) (else (debug:print 0 *default-log-port* "ERROR: invalid command "mode) #f))) #f))) (define (server:get-homehost #!key (trynum 5)) ;; called often especially at start up. use mutex to eliminate collisions |
︙ | ︙ | |||
533 534 535 536 537 538 539 | (define (server:start-and-wait areapath #!key (timeout 60)) (let ((give-up-time (+ (current-seconds) timeout))) (let loop ((server-info (server:check-if-running areapath)) (try-num 0)) (if (or server-info (> (current-seconds) give-up-time)) ;; server-url will be #f if no server available. (server:record->url server-info) | | < < | | | | | < | < < | 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 | (define (server:start-and-wait areapath #!key (timeout 60)) (let ((give-up-time (+ (current-seconds) timeout))) (let loop ((server-info (server:check-if-running areapath)) (try-num 0)) (if (or server-info (> (current-seconds) give-up-time)) ;; server-url will be #f if no server available. (server:record->url server-info) (let ((num-ok (length (server:choose-server areapath 'all-valid)))) (if (and (> try-num 0) ;; first time through simply wait a little while then try again (< num-ok 1)) ;; if there are no decent candidates for servers then try starting a new one (server:kind-run areapath)) (thread-sleep! 5) (loop (server:check-if-running areapath) (+ try-num 1))))))) (define (server:get-num-servers #!key (numservers 2)) (let ((ns (string->number (or (configf:lookup *configdat* "server" "numservers") "notanumber")))) (or ns numservers))) ;; no longer care if multiple servers are started by accident. older servers will drop off in time. ;; (define (server:check-if-running areapath) ;; #!key (numservers "2")) (let* ((ns (server:get-num-servers)) ;; get the setting the for maximum number of servers allowed (servers (server:choose-server areapath 'best-five))) ;; (server:get-best (server:get-list areapath)))) (if (or (and servers (null? servers)) (not servers)) ;; (and (list? servers) ;; (< (length servers) (+ 1 (random ns))))) ;; somewhere between 1 and numservers #f (let loop ((hed (car servers)) (tal (cdr servers))) (let ((res (server:check-server hed))) (if res hed (if (null? tal) #f (loop (car tal)(cdr tal))))))))) ;; ping the given server ;; (define (server:check-server server-record) (let* ((server-url (server:record->url server-record)) (server-id (server:record->id server-record)) (res (server:ping server-url server-id))) (if res server-url #f))) (define (server:kill servr) (handle-exceptions exn |
︙ | ︙ |