Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.70-nohomehost |
Files: | files | file ages | folders |
SHA1: |
9972980bfa732cbeb41695954189f65b |
User & Date: | matt on 2022-11-20 21:27:15 |
Other Links: | branch diff | manifest | tags |
Context
2022-11-21
| ||
07:14 | Makefile fixed check-in: 4c8c2cf803 user: matt tags: v1.70-nohomehost | |
2022-11-20
| ||
21:27 | wip check-in: 9972980bfa user: matt tags: v1.70-nohomehost | |
19:44 | Pulled in latest changes from v1.70 check-in: e966c3ef7e user: matt tags: v1.70-nohomehost | |
Changes
Modified api.scm from [4f8dbc344f] to [e629c948c8].
︙ | ︙ | |||
427 428 429 430 431 432 433 | ;; (list? res) ;; (number? res) ;; (boolean? res)) ;; res ;; (list "ERROR, not string, list, number or boolean" 1 cmd params res))))) (db:obj->string res transport: 'http))) (begin | | | 427 428 429 430 431 432 433 434 435 436 | ;; (list? res) ;; (number? res) ;; (boolean? res)) ;; res ;; (list "ERROR, not string, list, number or boolean" 1 cmd params res))))) (db:obj->string res transport: 'http))) (begin (debug:print 0 *default-log-port* "Server refused to process request. Server id mismatch. recived " key " expected: " *server-id* ".\nOther arguments recived: cmd=" cmd " params = " params) (db:obj->string (conc "Server refused to process request server-id mismatch: " key ", " *server-id*) transport: 'http))))) |
Modified http-transport.scm from [3205da4502] to [e2df20210d].
︙ | ︙ | |||
432 433 434 435 436 437 438 | (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 () | > > | | | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 | (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) (print "started: "(seconds->year-week/day-time (current-seconds)))))) (set! *on-exit-procs* (cons (lambda () (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) |
︙ | ︙ | |||
533 534 535 536 537 538 539 | (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*) | | | 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 | (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))) (debug:print 0 *default-log-port* "SERVER STARTED: " iface ":" port " AT " (current-seconds) " server-id: " *server-id*) (flush-output *default-log-port*))) ;; Transfer *db-last-access* to last-access to use in checking that we are still alive (mutex-lock! *heartbeat-mutex*) (set! last-access *db-last-access*) (mutex-unlock! *heartbeat-mutex*) |
︙ | ︙ |
Modified server.scm from [237780917f] to [dc052c2093].
︙ | ︙ | |||
97 98 99 100 101 102 103 104 105 106 107 108 109 110 | (define (server:mk-signature) (message-digest-string (md5-primitive) (with-output-to-string (lambda () (write (list (current-directory) (current-process-id) (argv))))))) ;; 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) | > > > > > > > > > > > > | 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 | #f) (match-let (((host port start-time server-id) servr)) (if (and host port) (conc host ":" port) #f)))) | < < < < < < | 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)))) ;; if server-start-last exists, and wasn't old enough, wait <idle time> + 1, then call this function recursively until it is old enough. ;; if it is old enough, overwrite it and wait 0.25 seconds. ;; if it then has the wrong server key, wait <idle time> + 1 and call this function recursively. ;; #;(define (server:wait-for-server-start-last-flag areapath) (let* ((start-flag (conc areapath "/logs/server-start-last")) |
︙ | ︙ | |||
437 438 439 440 441 442 443 | ;; 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)) | | > > | | | > | 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)) (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 | ((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))) | > > > | | 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)))) ;; 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 |
︙ | ︙ |