Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v2.001 |
Files: | files | file ages | folders |
SHA1: |
58cfc286d81fa5c26a05397b1f9113a0 |
User & Date: | matt on 2021-12-21 12:46:16 |
Other Links: | branch diff | manifest | tags |
Context
2021-12-21
| ||
17:47 | all-rmt unit tests pass check-in: 9f85a4b1dd user: matt tags: v2.001 | |
12:46 | wip check-in: 58cfc286d8 user: matt tags: v2.001 | |
2021-12-20
| ||
18:48 | wip check-in: a9fa8512c8 user: matt tags: v2.001 | |
Changes
Modified apimod.scm from [f6411932bc] to [f47a08f057].
︙ | |||
37 38 39 40 41 42 43 44 45 46 47 48 49 50 | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | + | (import scheme chicken.base chicken.process-context.posix chicken.string chicken.time chicken.condition chicken.process chicken.pathname chicken.random chicken.file ;; (prefix sqlite3 sqlite3:) typed-records srfi-18 srfi-69 |
︙ | |||
164 165 166 167 168 169 170 | 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | + + + + + + + + - - + + - - - | ;; TASKS tasks-add tasks-set-state-given-param-key )) (define (api:run-server-process apath dbname) (let* ((cleandbname (pathname-strip-directory dbname)) ;; (string-translate dbname "./" "--")) (logd (conc apath "/logs")) (logf (conc logd "/server-launch-";;(current-process-id) (seconds->year-work-week/day-time-fname (current-seconds)) "-"cleandbname".log")) (logf2 (conc logd "/server-" (seconds->year-work-week/day-time-fname (current-seconds)) "-"cleandbname"-")) |
︙ | |||
342 343 344 345 346 347 348 | 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 | - + | ((get-runs-cnt-by-patt) (apply db:get-runs-cnt-by-patt dbstruct params)) ((get-all-run-ids) (db:get-all-run-ids dbstruct)) ((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct params)) ((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct params)) ((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct params)) ((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct params)) ((get-main-run-stats) (apply db:get-main-run-stats dbstruct params)) |
︙ |
Modified build-assist/ck5-eggs.list from [50ec309d57] to [6d7e206485].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | + | csm address-info ansi-escape-sequences apropos base64 crypt csv-abnf directory-utils dot-locking filepath fmt format http-client itemsmod json linenoise |
︙ |
Modified commonmod.scm from [66ca132e41] to [787a13f0a3].
︙ | |||
312 313 314 315 316 317 318 319 320 321 322 323 324 325 | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | + | common:hms-string->seconds seconds->hr-min-sec seconds->time-string seconds->work-week/day-time seconds->work-week/day seconds->year-work-week/day seconds->year-work-week/day-time seconds->year-work-week/day-time-fname seconds->year-week/day-time seconds->quarter common:date-time->seconds common:find-start-mark-and-mark-delta common:expand-cron-slash common:cron-expand common:cron-event |
︙ | |||
3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 | 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 | + + + + | (define (seconds->work-week/day sec) (time->string (seconds->local-time sec) "ww%V.%u")) (define (seconds->year-work-week/day sec) (time->string (seconds->local-time sec) "%yww%V.%w")) (define (seconds->year-work-week/day-time-fname sec) (time->string (seconds->local-time sec) "%yww%V.%w.%H%M%S")) (define (seconds->year-work-week/day-time sec) (time->string (seconds->local-time sec) "%Yww%V.%w %H:%M")) (define (seconds->year-week/day-time sec) (time->string |
︙ |
Modified configfmod.scm from [0f89b247bb] to [b4853bf0ef].
︙ | |||
84 85 86 87 88 89 90 91 92 93 94 95 96 97 | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | + | keysmod (prefix base64 base64:) (prefix dbi dbi:) (prefix sqlite3 sqlite3:) (srfi 18) directory-utils dot-locking format matchable md5 message-digest regex regex-case sparse-vectors |
︙ | |||
110 111 112 113 114 115 116 117 118 119 120 121 122 123 | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | + + + + + | ;;====================================================================== ;; parameters ;;====================================================================== ;; while targets are Megatest specific they are a useful concept (define mytarget (make-parameter #f)) ;; locking is optional, many environments don't care (e.g. running on one machine) ;; NOTE: the locker must follow the same syntax as with-dot-lock* ;; (define my-with-lock (make-parameter with-dot-lock*)) ;;====================================================================== ;; move debug stuff to separate module then put these back where they belong ;;====================================================================== ;;====================================================================== ;; lookup routines - replicated from configf ;;====================================================================== |
︙ | |||
1184 1185 1186 1187 1188 1189 1190 | 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 | - - - - - - - - - - - - - + + + + + + + + + + + + + + + + - - - - - - - + + + + + + + - - + | ;;====================================================================== ;; DO THE LOCKING AROUND THE CALL ;;====================================================================== ;; (define (configf:write-alist cdat fname) ;; (if (not (common:faux-lock fname)) |
Modified debugprint.scm from [9a1ffc1e9a] to [2f3aa7f0ad].
︙ | |||
102 103 104 105 106 107 108 | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | - - + + + + | (not (null? (lset-intersection! eq? vb n)))) ((and (number? vb) (list? n)) (member vb n)) (else #f)))) (define (debug:handle-remote-logging params) |
︙ |
Modified megatest.scm from [89bdcd6c8f] to [c1c08ee586].
︙ | |||
435 436 437 438 439 440 441 442 443 444 445 446 447 448 | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 | + | overwritten by values set in config files. -server -|hostname : start the server (reduces contention on megatest.db), use - to automatically figure out hostname -adjutant C,M : start the server/adjutant with allocated cores C and Mem M (Gig), use 0,0 to auto use full machine -transport http|rpc : use http or rpc for transport (default is http) -log logfile : send stdout and stderr to logfile -autolog logfilebase : appends pid and host to logfilebase for logfile -list-servers : list the servers -kill-servers : kill all servers -repl : start a repl (useful for extending megatest) -load file.scm : load and run file.scm -mark-incompletes : find and mark incomplete tests -ping run-id|host:port : ping server, exit with 0 if found -debug N|N,M,O... : enable debug 0-N or N and M and O ... |
︙ | |||
628 629 630 631 632 633 634 635 636 637 638 639 640 641 | 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 | + | "-var" "-dumpmode" "-run-id" "-ping" "-refdb2dat" "-o" "-log" "-autolog" "-sync-log" "-since" "-fields" "-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state "-sort" "-target-db" "-source-db" |
︙ | |||
782 783 784 785 786 787 788 | 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 | - + + + + - - - - + + + + + | ;; (list? n)) ;; (member *verbosity* n)))) ;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not ;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation ;; where (launch:setup) returns #f? ;; |
︙ |
Modified rmtmod.scm from [53bb074bb9] to [4d23f52ced].
︙ | |||
263 264 265 266 267 268 269 270 271 272 273 274 275 276 | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 | + + + + + | ;; (define (rmt:general-open-connection remdat apath dbname #!key (num-tries 5)) (assert (not (equal? dbname ".db/main.db")) "ERROR: general-open-connection should never be called with main as the db") (let* ((mdbname (db:run-id->dbname #f)) (fullname (db:dbname->path apath dbname)) (conns (remotedat-conns remdat)) (mconn (rmt:get-conn remdat apath mdbname))) (if (and mconn (not (debug:print-logger))) (begin (debug:print-info 0 *default-log-port* "Turning on logging to main, look in logs dir for main log.") (debug:print-logger rmt:log-to-main))) (cond ((or (not mconn) ;; no channel open to main? (< (conndat-expires mconn)(+ (current-seconds) 2))) ;; restablish connection if less than 2 seconds on the lease (rmt:open-main-connection remdat apath) (rmt:general-open-connection remdat apath mdbname)) ((not (rmt:get-conn remdat apath dbname)) ;; no channel open to dbname? (let* ((res (rmt:send-receive-real remdat apath mdbname 'get-server `(,apath ,dbname)))) |
︙ | |||
308 309 310 311 312 313 314 | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 | - + - - - - | expires: (+ (current-seconds) 60)))) (else (debug:print-info 0 *default-log-port* "return data from starting server did not match host port servkey pid ipaddr apath dbname " res))) res) (begin (debug:print-info 0 *default-log-port* "Unexpected result: " res) res))))))) |
︙ | |||
363 364 365 366 367 368 369 | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 | - - + + + + | (key #f) (host (conndat-ipaddr conn)) (port (conndat-port conn)) (payload `((cmd . ,cmd) (key . ,(conndat-srvkey conn)) (params . ,params))) (res (send-receive-nn soc ;; (open-send-receive-nn (conc host":"port) |
︙ | |||
792 793 794 795 796 797 798 | 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 | - + | (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime)) ) ;; ) (define (rmt:get-main-run-stats run-id) (rmt:send-receive 'get-main-run-stats #f (list run-id))) (define (rmt:log-to-main . params) |
︙ | |||
1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 | 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 | + - + | ;;====================================================================== ;; S E R V E R ;; ====================================================================== (define (http-get-function fnkey) (hash-table-ref/default *http-functions* fnkey (lambda () "nothing here yet"))) ;; Main entry point to start a server. was start-server (define (rmt:run hostn) ;; ;; Configurations for server ;; (tcp-buffer-size 2048) ;; (max-connections 2048) |
︙ |
Added tests/simplerun/Makefile version [38acf6b450].
|
Modified tests/simplerun/megatest.config from [373cc8c0cf] to [3e9fa2e5ac].
︙ | |||
34 35 36 37 38 39 40 | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | - + | # Valid values for state and status for steps, NB// It is not recommended you use this [validvalues] state start end completed # Job tools are more advanced ways to control how your jobs are launched [jobtools] useshell yes |
︙ |
Modified tests/unittests/server.scm from [68d25c84e5] to [7bdfa0e7f2].
︙ | |||
62 63 64 65 66 67 68 | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | - + + - - + + - | (test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db"))) (test #f #t (conndat? (rmt:get-conn *remotedat* *toppath* ".db/main.db"))) (test #f ".db/2.db" (list-ref (rmt:send-receive-real *remotedat* *toppath* ".db/main.db" 'get-server `(,apath ,dbname)) 6)) (thread-sleep! 2) (test #f #t (rmt:general-open-connection *remotedat* *toppath* ".db/2.db")) |