Overview
Comment: | Merged earlier change |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
143fb8134ee1266091c30ba2422bf49d |
User & Date: | mrwellan on 2023-01-10 13:50:43 |
Other Links: | branch diff | manifest | tags |
Context
2023-01-11
| ||
07:14 | Merged fork check-in: 43e394881f user: mrwellan tags: v1.80 | |
2023-01-10
| ||
13:50 | Merged earlier change check-in: 143fb8134e user: mrwellan tags: v1.80 | |
2023-01-06
| ||
09:23 | Synced mtargs with opensrc. Reduced noise in server output check-in: 7f6ea52b90 user: mrwellan tags: v1.80 | |
2022-12-30
| ||
16:22 | Changed version to 1.8004 check-in: e506ed709e user: mmgraham tags: v1.80, v1.8004 | |
Changes
Modified db.scm from [3cf6da4c07] to [de020dc99f].
︙ | |||
411 412 413 414 415 416 417 | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 | - + - - - - + + + + + + + + + + + + + - + | (let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db)) (data-synced 0) ;; count of changed records (tmp-area (common:get-db-tmp-area)) (dbfiles (glob (conc tmp-area"/.megatest/*.db"))) (sync-durations (make-hash-table)) (no-sync-db (db:open-no-sync-db))) (for-each |
︙ | |||
479 480 481 482 483 484 485 | 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | - - + + + + | (servers (server:choose-server *toppath* 'all-valid)) ;; (server:get-list *toppath*)) (src-area (if old2new *toppath* tmp-area)) (dest-area (if old2new tmp-area *toppath*)) (dbfiles (if old2new (glob (conc *toppath* "/.megatest/*.db")) (glob (conc tmp-area "/.megatest/*.db")))) (keys (db:get-keys dbstruct)) (sync-durations (make-hash-table))) |
︙ | |||
520 521 522 523 524 525 526 527 528 529 530 531 532 533 | 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 | + | (debug:print-info 0 *default-log-port* "Sync - I do not see file " destfile) 0))) (changed ( < (- time2 time1) 6.0)) ;; dest db not updated within last 6 seconds (do-cp (cond ((not (file-exists? destfile)) ;; shouldn't happen, but this might recover (debug:print-info 2 *default-log-port* "File " destfile " not found. Copying "srcfile" to "destfile) ;; TODO: Need to fix this for WAL mod. Can't just copy. (system (conc "/bin/mkdir -p " dest-directory)) (system (conc "/bin/cp " srcfile " " destfile)) #t) (changed ;; (and changed ;; (> (- (current-seconds) time1) 3)) ;; if file is changed and three seconds have passed. #t) ((and changed *time-to-exit*) ;; last sync |
︙ | |||
557 558 559 560 561 562 563 564 565 566 567 568 569 570 | 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 | + | ) (hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time))) (debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date") ) ) ) dbfiles ) ) data-synced ) ) |
︙ | |||
2303 2304 2305 2306 2307 2308 2309 | 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 | - - + + | (db:with-db dbstruct run-id #f (lambda (dbdat db) (sqlite3:for-each-row (lambda (run-id testname item-path state status) ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment (set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-"))) db |
︙ |
Modified dbfile.scm from [789cb4b125] to [fc2ee87f83].
︙ | |||
334 335 336 337 338 339 340 | 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 | - + - + | (delay-time (* (- 51 tries-left) 1.1)) (write-access (file-write-access? fname)) (dir-access (file-write-access? (pathname-directory fname))) (retry (lambda () (thread-sleep! delay-time) (if (> tries-left 0) (dbfile:cautious-open-database fname init-proc |
︙ |
Modified http-transport.scm from [d351abf6cf] to [e5186c35f3].
︙ | |||
151 152 153 154 155 156 157 | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 | - + | (config-use-proxy (equal? (configf:lookup *configdat* "client" "use-http_proxy") "yes"))) (if (not config-use-proxy) (determine-proxy (constantly #f))) (debug:print-info 0 *default-log-port* "http-transport:try-start-server time=" (seconds->time-string (current-seconds)) " ipaddrsstr=" ipaddrstr " portnum=" portnum " config-hostname=" config-hostname) (handle-exceptions exn (begin |
︙ | |||
446 447 448 449 450 451 452 | 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 | - - - - - - + - + - + - - - - - + - - - - + + | (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") |
︙ | |||
574 575 576 577 578 579 580 | 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 | - + - + - + | (handle-exceptions exn (debug:print 0 *default-log-port* "ERROR: Failed to change timestamp on info file " servinfofile ". Are you out of space on that disk? exn=" exn) (if (and ;; (< (- (current-seconds) server-start-time) 600) ;; run for ten minutes for experiment, 3600 thereafter (not *server-overloaded*) (file-exists? servinfofile)) (change-file-times servinfofile curr-time curr-time))) |
︙ |
Modified megatest-version.scm from [c1e20d2fad] to [1632a50df8].
︙ | |||
16 17 18 19 20 21 22 | 16 17 18 19 20 21 22 23 | - + | ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. ;; (declare (unit megatest-version)) |
Modified megatest.scm from [81aaa85fa0] to [79d9696058].
︙ | |||
652 653 654 655 656 657 658 | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 | - - - - - - - - - - - - - | (original-exit exit-code))))) ;; for some switches always print the command to stderr ;; (if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-kill-runs" "-kill-rerun") (debug:print 0 *default-log-port* (string-intersperse (argv) " "))) |
︙ | |||
2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 | 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 | + + + + | (if (args:get-arg "-cleanup-db") (begin (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") (exit 1))) (if (not (server:choose-server *toppath* 'home?)) (begin (debug:print 0 *default-log-port* "Servers are not running on this host or no servers alive. Cannot run cleanup-db") (exit 1))) (let ((dbstructs (db:setup #f))) (common:cleanup-db dbstructs)) (set! *didsomething* #t))) (if (args:get-arg "-mark-incompletes") (begin (if (not (launch:setup)) |
︙ |
Modified portlogger.scm from [36a4964f50] to [8344cdf37f].
︙ | |||
62 63 64 65 66 67 68 | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | - + | (avail (tasks:wait-on-journal fname 10))) ;; wait up to about 10 seconds for the journal to go away (handle-exceptions exn (begin ;; (release-dot-lock fname) (debug:print-error 0 *default-log-port* "portlogger:open-run-close failed. " proc " " params) (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) |
︙ |
Modified server.scm from [df559aacc0] to [1caa4a85a3].
︙ | |||
401 402 403 404 405 406 407 | 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 | - + | (thread-sleep! ( + 1 idletime)) (server:wait-for-server-start-last-flag areapath))))))) ;; oldest server alive determines host then choose random of youngest ;; five servers on that host ;; (define (server:get-servers-info areapath) |
︙ | |||
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 478 479 480 481 482 483 484 485 | 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 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 | + + + + + + + + + + + + + + + + + | ((and havehome wearehome (< (length thisservrs) 20)) #t) ;; we are home and less than 20 servers, ok to start another ((and havehome (not wearehome)) #f) ;; we are not the home host ((and havehome wearehome (>= (length thisservrs) 20)) #f) ;; have enough running (else (debug:print 0 *default-log-port* "WARNING: Unrecognised scenario, servrs="servrs", thishostip="thishostip", thisservrs="thisservrs) #t)))) (define server-last-start 0) ;; oldest server alive determines host then choose random of youngest ;; five servers on that host ;; ;; mode: ;; best - get best server (random of newest five) ;; home - get home host based on oldest server ;; info - print info (define (server:choose-server areapath #!optional (mode 'best)) ;; age is current-starttime ;; 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 ;; first we clean up old server files (server:clean-up-old areapath) (let* ((since-last (- (current-seconds) server-last-start)) (server-start-delay 10)) (if ( < (- (current-seconds) server-last-start) 10 ) (begin (debug:print 2 *default-log-port* "server:choose-server: seconds since last server start: " (- (current-seconds) server-last-start)) (debug:print 2 *default-log-port* "server:choose-server: last server start less than " server-start-delay " seconds ago. Sleeping " server-start-delay " seconds") (thread-sleep! server-start-delay) ) (debug:print 2 *default-log-port* "server:choose-server: seconds since last server start: " (- (current-seconds) server-last-start)) ) ) (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)))) '()))) (debug:print 2 *default-log-port* "server:choose-server: serversdat: " serversdat) (debug:print 2 *default-log-port* "server:choose-server: servkeys: " servkeys) (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)) |
︙ | |||
512 513 514 515 516 517 518 | 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 | + - + | (hash-table-ref serversdat (list-ref best-ten (random len))))) ((count)(length all-valid)) (else (debug:print 0 *default-log-port* "ERROR: invalid command "mode) #f))) (begin (server:run areapath) (set! server-last-start (current-seconds)) |
︙ | |||
585 586 587 588 589 590 591 | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 | + - + | (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* ( (servers (server:choose-server areapath 'all-valid)) |
︙ |