Overview
Comment: | consolidated tmp dir name functions to common:make-tmpdir-name. Adjusted server start delays and debug messages |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
900e9ce98b701c6e44a48e71fc1d9f53 |
User & Date: | mmgraham on 2023-10-19 14:58:49 |
Other Links: | branch diff | manifest | tags |
Context
2023-10-19
| ||
15:39 | covered case where megatest.sh does not exist check-in: 4f1a1fc90c user: mmgraham tags: v1.80 | |
14:58 | consolidated tmp dir name functions to common:make-tmpdir-name. Adjusted server start delays and debug messages check-in: 900e9ce98b user: mmgraham tags: v1.80 | |
2023-10-17
| ||
19:50 | Made the /tmp db location consistent with previous versions, made -kill-servers remove no-sync.db, adjusted debug messages check-in: ccef2ac967 user: mmgraham tags: v1.80 | |
Changes
Modified common.scm from [b817fc7f9a] to [c00500b3f7].
︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | + + + + + + + + | ;;====================================================================== (declare (unit common)) (declare (uses commonmod)) (declare (uses rmtmod)) (declare (uses debugprint)) (declare (uses mtargs)) (use srfi-1 data-structures posix regex-case (prefix base64 base64:) format dot-locking csv-xml z3 udp ;; sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack matchable regex posix (srfi 18) extras ;; tcp (prefix nanomsg nmsg:) (prefix sqlite3 sqlite3:) pkts (prefix dbi dbi:) ) (use posix-extras pathname-expand files) (import commonmod debugprint rmtmod (prefix mtargs args:)) (include "common_records.scm") (define (common:make-tmpdir-name areapath tmpadj) (let* ((area (pathname-file areapath)) (dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb"))) (unless (directory-exists? dname) (create-directory dname #t)) dname)) (define (remove-files filespec) (let ((files (glob filespec))) (for-each delete-file files))) (define (stop-the-train) (thread-start! (make-thread (lambda () |
︙ | |||
245 246 247 248 249 250 251 | 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | - + | ;;====================================================================== (define *common:this-exe-fullpath* (common:get-this-exe-fullpath)) (define *common:this-exe-dir* (pathname-directory *common:this-exe-fullpath*)) (define *common:this-exe-name* (pathname-strip-directory *common:this-exe-fullpath*)) (define (common:get-sync-lock-filepath) |
︙ | |||
1531 1532 1533 1534 1535 1536 1537 | 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 | - + | ;;====================================================================== ;; lazy-safe get file mod time. on any error (file not existing etc.) return 0 ;; (define (common:lazy-modification-time fpath) (handle-exceptions exn (begin |
︙ | |||
2278 2279 2280 2281 2282 2283 2284 | 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 | - + | ;; returns: ok/not dbspace required-space ;; (define (common:check-db-dir-space) (let* ((required (string->number ;; default is 1GB (or actually a billion bytes) This is the number of 1 kB blocks. (or (configf:lookup *configdat* "setup" "dbdir-space-required") "1000000"))) |
︙ |
Modified dashboard-tests.scm from [d3d14d0eb8] to [63a55f86f7].
︙ | |||
461 462 463 464 465 466 467 | 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 | - + | dlog)) ;;====================================================================== ;; ;;====================================================================== (define (dashboard-tests:examine-test run-id test-id) ;; run-id run-key origtest) |
︙ |
Modified dashboard.scm from [b1dc6c475c] to [92015a98e3].
︙ | |||
400 401 402 403 404 405 406 | 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 | - - + + | (define (dboard:tabdat-make-data) (let ((dat (make-dboard:tabdat))) (dboard:setup-tabdat dat) (dboard:setup-num-rows dat) dat)) (define (dboard:setup-tabdat tabdat) |
︙ | |||
926 927 928 929 930 931 932 | 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 | - + - + | (if (null? all-test-ids) (hash-table-delete! (dboard:tabdat-allruns-by-id tabdat) run-id) (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id run-struct)) (if (or (null? tal) (> elapsed-time 2)) ;; stop loading data after 5 seconds, on the next call more data *should* be loaded since get-tests-for-run uses last update (begin (when (> elapsed-time 2) |
︙ |
Modified db.scm from [6d82fac5fa] to [b1837f1312].
︙ | |||
131 132 133 134 135 136 137 | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | - + | (debug:print-error 0 *default-log-port* " query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) (print-call-chain (current-error-port)) default))) (apply sqlite3:first-result db stmt params))) (define (db:setup do-sync) (assert *toppath* "FATAL: db:setup called before launch:setup has been run.") |
︙ | |||
458 459 460 461 462 463 464 | 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 | - + | (max (get-mtime fname) (get-mtime wal-file) (get-mtime shm-file)))) ;; (define (db:all-db-sync dbstruct) ;; (let* ((dbdat (db:open-db dbstruct #f db:initialize-main-db)) ;; (data-synced 0) ;; count of changed records |
︙ | |||
547 548 549 550 551 552 553 | 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 | - + | ;; 'closeall - close all opened dbs ;; 'schema - attempt to apply schema changes ;; run-ids: '(1 2 3 ...) or #f (for all) ;; (define (db:multi-db-sync dbstruct . options) (let* (;; (dbdat (db:open-db dbstruct #f dbfile:db-init-proc)) (data-synced 0) ;; count of changed records |
︙ | |||
1245 1246 1247 1248 1249 1250 1251 | 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 | - + | ;;====================================================================== ;; no-sync.db - small bits of data to be shared between servers ;;====================================================================== (define (db:get-dbsync-path) (case (rmt:transport-mode) |
︙ | |||
1571 1572 1573 1574 1575 1576 1577 | 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 | - + | res)) ;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using cachedb db) ??? ;; ;; NOTE: This DOESN'T (necessarily) get the real run ids, but the number of the <number>.db!! (define (db:get-changed-run-ids since-time) |
︙ | |||
4305 4306 4307 4308 4309 4310 4311 | 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 | - + | (debug:print 0 *default-log-port* "could not get lock for " from-db " from no-sync-db") #f )))) ;; sync for filesystem local db writes ;; (define (db:run-lock-and-sync no-sync-db) |
︙ | |||
4361 4362 4363 4364 4365 4366 4367 | 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 | - + | (thread-sleep! 0.05) ;; delay for startup (let ((legacy-sync (common:run-sync?)) (sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300)) (debug-mode (debug:debug-mode 1)) (last-time (current-seconds)) ;; last time through the sync loop (no-sync-db (db:open-no-sync-db)) (sync-duration 0) ;; run time of the sync in milliseconds |
︙ | |||
4469 4470 4471 4472 4473 4474 4475 | 4469 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 | - + | ;; (for-each (lambda (subdb) (let* (;;(dbstruct (db:setup)) (mtdb (dbr:subdb-mtdb subdb)) (mtpath (db:dbdat-get-path mtdb)) |
︙ |
Modified dbmod.scm from [1d31a00395] to [9f0ce614a3].
︙ | |||
196 197 198 199 200 201 202 | 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 | - + | (tmpadj "") ;; add to tmp path (syncdir 'todisk)) ;; todisk is used when caching in /tmp and writing data back to MTRAH (let* ((dbstruct (or dbstruct-in (make-dbr:dbstruct areapath: areapath))) (dbfname (or dbfname-in (dbmod:run-id->dbfname run-id))) (dbpath (dbmod:get-dbdir dbstruct)) ;; directory where all the .db files are kept (dbfullname (conc dbpath"/"dbfname)) ;; (dbmod:run-id->full-dbfname dbstruct run-id)) (dbexists (file-exists? dbfullname)) |
︙ |
Modified megatest.scm from [db5cb1955c] to [af8974dd23].
︙ | |||
1091 1092 1093 1094 1095 1096 1097 | 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 | + - + + | sfiles ) ) ) dbfiles ) ;; remove this db, because otherwise metadata contains records for old servers, and this causes a problem with db:no-sync-get-lock-with-id. (if (file-exists? (conc *toppath* "/.mtdb/no-sync.db")) |
︙ | |||
2132 2133 2134 2135 2136 2137 2138 | 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 | - + - + | (begin (debug:print-info 1 *default-log-port* "Missing required argument -source <archive path>") (exit 1))) (if (common:file-exists? (conc *toppath* "/megatest.db")) (begin (debug:print-info 1 *default-log-port* "File " (conc *toppath* "/megatest.db") " already exists. Please remove it before trying to replicate db") (exit 1))) |
︙ |
Modified rmt.scm from [64f3d622e8] to [564930aec3].
︙ | |||
165 166 167 168 169 170 171 | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | - + | (cons 'none 0)) (loop (car tal)(cdr tal) newmax-cmd currmax))))))) (mutex-unlock! *db-stats-mutex*) res)) (define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) (let* ((qry-is-write (not (member cmd api:read-only-queries))) |
︙ |
Modified tasks.scm from [4adbc308eb] to [93c938d59a].
︙ | |||
82 83 84 85 86 87 88 | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | - + | (debug:print 5 *default-log-port* " exn=" (condition->list exn)) (thread-sleep! 1) (tasks:open-db numretries (- numretries 1))) (begin (print-call-chain (current-error-port)) (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (debug:print 5 *default-log-port* " exn=" (condition->list exn)))) |
︙ |
Modified tcp-transportmod.scm from [1391b0d841] to [04adce729b].
︙ | |||
169 170 171 172 173 174 175 | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 | - + - + - + - + - + + + - + | (case ping-res ((running) (debug:print-info 2 *default-log-port* "Setting conn = " conn " in hash table") (hash-table-set! (tt-conns ttdat) dbfname conn) ;;; is this ok to save before validating that the connection is good? conn) ((starting) (thread-sleep! 0.5) |
︙ | |||
793 794 795 796 797 798 799 | 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 | - + | " -server - ";; (or target-host "-") " -m testsuite:"testsuite " -db "dbfname ;; (dbmod:run-id->dbfname run-id) " " profile-mode (conc " >> " logfile " 2>&1 &")))) ;; we want the remote server to start in *toppath* so push there ;; (push-directory areapath) ;; use cd in the command line instead |
︙ |