Overview
Comment: | Made it delete .servinfo files only if older than server timeout. Disabled some unnecessary messages. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.8031 |
Files: | files | file ages | folders |
SHA1: |
f184bcc6613b3aff4566a5a5c3452ba7 |
User & Date: | mmgraham on 2024-03-13 18:06:02 |
Other Links: | branch diff | manifest | tags |
Context
2024-03-14
| ||
17:53 | corrected a debug:print syntax, corrected the match for servinfo content check-in: 3a97630ba6 user: mmgraham tags: v1.8031 | |
2024-03-13
| ||
18:06 | Made it delete .servinfo files only if older than server timeout. Disabled some unnecessary messages. check-in: f184bcc661 user: mmgraham tags: v1.8031 | |
2024-03-12
| ||
17:10 | removed wait for portlogger db journal file. Changed db lock expire time from 5 to 30 seconds. Added assert when no port can be found check-in: 637dd941e9 user: mmgraham tags: v1.8031 | |
Changes
Modified launch.scm from [fdf36ac7c4] to [98ad71ee6e].
︙ | ︙ | |||
932 933 934 935 936 937 938 | runname (common:file-exists? fulldir)) (let ((tmpfile (conc fulldir "/.megatest.cfg." (current-seconds))) (targfile (conc fulldir "/.megatest.cfg-" megatest-version "-" megatest-fossil-hash)) (rconfig (conc fulldir "/.runconfig." megatest-version "-" megatest-fossil-hash))) (if (common:file-exists? rconfig) ;; only cache megatest.config AFTER runconfigs has been cached (begin | | | 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 | runname (common:file-exists? fulldir)) (let ((tmpfile (conc fulldir "/.megatest.cfg." (current-seconds))) (targfile (conc fulldir "/.megatest.cfg-" megatest-version "-" megatest-fossil-hash)) (rconfig (conc fulldir "/.runconfig." megatest-version "-" megatest-fossil-hash))) (if (common:file-exists? rconfig) ;; only cache megatest.config AFTER runconfigs has been cached (begin (debug:print-info 2 *default-log-port* "Caching megatest.config in " tmpfile) (if (not (common:in-running-test?)) (configf:write-alist *configdat* tmpfile)) (system (conc "ln -sf " tmpfile " " targfile)))) ))) (debug:print-info 1 *default-log-port* "No linktree yet, no caching configs."))))) |
︙ | ︙ |
Modified runs.scm from [9aec93c445] to [dbe1379c23].
︙ | ︙ | |||
2916 2917 2918 2919 2920 2921 2922 | (lambda (key) (let* ((idx (cadr key)) (fld (car key)) (val (configf:lookup test-conf "test_meta" fld))) ;; (debug:print 5 *default-log-port* "idx: " idx " fld: " fld " val: " val) (if (and val (not (equal? (vector-ref currrecord idx) val))) (begin | | | 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 | (lambda (key) (let* ((idx (cadr key)) (fld (car key)) (val (configf:lookup test-conf "test_meta" fld))) ;; (debug:print 5 *default-log-port* "idx: " idx " fld: " fld " val: " val) (if (and val (not (equal? (vector-ref currrecord idx) val))) (begin (debug:print 2 *default-log-port* "Updating " test-name " " fld " to " val) (rmt:testmeta-update-field test-name fld val))))) '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)("jobgroup" 10))))) ;; find tests with matching tags, tagpatt is a string "tagpatt1,tagpatt2%, ..." ;; (define (runs:get-tests-matching-tags tagpatt) (let* ((tagdata (rmt:get-tests-tags)) |
︙ | ︙ |
Modified tcp-transportmod.scm from [e363d8155d] to [f39a70ad97].
︙ | ︙ | |||
714 715 716 717 718 719 720 | (goodfiles '())) ;; filter the files here by looking in processes table (if we are not main.db) ;; and or look at the time stamp on the servinfo file, a running server will ;; touch the file every minute (again, this will only apply for main.db) (for-each (lambda (fname) (let* ((age (- (current-seconds)(file-modification-time fname)))) | | | < < | < < | 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 | (goodfiles '())) ;; filter the files here by looking in processes table (if we are not main.db) ;; and or look at the time stamp on the servinfo file, a running server will ;; touch the file every minute (again, this will only apply for main.db) (for-each (lambda (fname) (let* ((age (- (current-seconds)(file-modification-time fname)))) (if (> age (tt-server-timeout-param)) ;; can't trust it if over server timeout old. (begin (debug:print 0 *default-log-port* "WARNING: removing stale servinfo file "fname", it is "age" seconds old") (handle-exceptions exn (debug:print 0 *default-log-port* "WARNING: error attempting to remove stale servinfo file "fname) (delete-file fname))) ;; (set! goodfiles (cons fname goodfiles))))) sfiles) goodfiles)) ;; given a path to a server info file return: host port startseconds server-id pid dbfname logf ;; example of what it's looking for in the file: ;; SERVER STARTED: 10.38.175.67:50216 AT 1616502350.0 server-id: 4907e90fc55c7a09694e3f658c639cf4 ;; (define (tt:server-get-info logf) (let ((server-rx (regexp "^SERVER STARTED: (\\S+):(\\d+) AT ([\\d\\.]+) server-id: (\\S+) pid: (\\d+) dbfname: (\\S+)")) ;; SERVER STARTED: host:port AT timesecs server id (bad-dat (list #f #f #f #f #f #f logf))) (let ((fdat (handle-exceptions exn (begin ;; BUG, TODO: add err checking, for now blanket ignore the errors? (debug:print-info 0 *default-log-port* "Unable to get server info from "logf ", exn="(condition->list exn)) '()) ;; no idea what went wrong, call it a bad server, return empty list (with-input-from-file logf read-lines)))) (if (null? fdat) ;; bad data, return bad-dat bad-dat (let loop ((inl (car fdat)) (tail (cdr fdat)) (lnum 0)) (let ((mlst (string-match server-rx inl))) (if (not mlst) (if (> lnum 500) ;; give up if more than 500 lines of server log read bad-dat (if (null? tail) bad-dat (loop (car tail)(cdr tail)(+ lnum 1)))) (match mlst ;; have a not null list |
︙ | ︙ |
Modified tests.scm from [776a2ca8e7] to [f8f8a65eee].
︙ | ︙ | |||
1636 1637 1638 1639 1640 1641 1642 | (if (and tcfg cache-file) (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data (if tcfg (hash-table-set! *testconfigs* test-full-name tcfg)) (if (and testexists cache-file (file-write-access? cache-path) allow-write-cache) (let ((tpath (conc cache-path "/.testconfig"))) | | | 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 | (if (and tcfg cache-file) (hash-table-set! tcfg "have fulldata" #t)) ;; mark this as fully read data (if tcfg (hash-table-set! *testconfigs* test-full-name tcfg)) (if (and testexists cache-file (file-write-access? cache-path) allow-write-cache) (let ((tpath (conc cache-path "/.testconfig"))) (debug:print-info 2 *default-log-port* "Caching testconfig for " test-name " in " tpath) (if (and tcfg (not (common:in-running-test?))) (configf:write-alist tcfg tpath)))) tcfg)))))) ;; sort tests by priority and waiton ;; Move test specific stuff to a test unit FIXME one of these days (define (tests:sort-by-priority-and-waiton test-records) |
︙ | ︙ |