Overview
| Comment: | wip |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65-try3 |
| Files: | files | file ages | folders |
| SHA1: |
3405d7b2dbfe7eb8f4bb9ce55fb4aa42 |
| User & Date: | matt on 2019-11-03 16:30:15 |
| Other Links: | branch diff | manifest | tags |
Context
|
2019-11-03
| ||
| 19:06 | wip check-in: cfaa83fc70 user: matt tags: v1.65-try3 | |
| 16:30 | wip check-in: 3405d7b2db user: matt tags: v1.65-try3 | |
| 16:19 | wip check-in: d22d4fa408 user: matt tags: v1.65-try3 | |
Changes
Modified http-transport-inc.scm from [66708e3ebe] to [7eec9fa817].
| ︙ | ︙ | |||
629 630 631 632 633 634 635 | "<body>" "Run area: " *toppath* "<h2>Server Stats</h2>" (http-transport:stats-table) "<hr>" (http-transport:runs linkpath) "<hr>" | | | 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 | "<body>" "Run area: " *toppath* "<h2>Server Stats</h2>" (http-transport:stats-table) "<hr>" (http-transport:runs linkpath) "<hr>" ;; (http-transport:run-stats) "</body>" ))) (define (http-transport:stats-table) (mutex-lock! *heartbeat-mutex*) (let ((res (conc "<table>" |
| ︙ | ︙ | |||
664 665 666 667 668 669 670 | (string-intersperse (let ((files (map pathname-strip-directory (glob (conc linkpath "/*"))))) (map (lambda (p) (conc "<a href=\"" p "\">" p "</a><br>")) files)) " "))) | | | 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 |
(string-intersperse
(let ((files (map pathname-strip-directory (glob (conc linkpath "/*")))))
(map (lambda (p)
(conc "<a href=\"" p "\">" p "</a><br>"))
files))
" ")))
#;(define (http-transport:run-stats)
(let ((stats (open-run-close db:get-running-stats #f)))
(conc "<table>"
(string-intersperse
(map (lambda (stat)
(conc "<tr><td>" (car stat) "</td><td>" (cadr stat) "</td></tr>"))
stats)
" ")
"</table>")))
|
Modified launch-inc.scm from [0b3c5dc7f0] to [6124deb6d5].
| ︙ | ︙ | |||
1689 1690 1691 1692 1693 1694 1695 | ;; 1. look at the process from pid ;; - is it owned by calling user ;; - it it's run directory correct for the test ;; - is there a controlling mtest (maybe stuck) ;; 2. if recovery is needed watch pid ;; - when it exits take the exit code and do the needful ;; | | | 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 | ;; 1. look at the process from pid ;; - is it owned by calling user ;; - it it's run directory correct for the test ;; - is there a controlling mtest (maybe stuck) ;; 2. if recovery is needed watch pid ;; - when it exits take the exit code and do the needful ;; (let* ((pid (rmt:test-get-top-process-pid run-id test-id)) (psres (with-input-from-pipe (conc "ps -F -u " (current-user-name) " | grep -E '" pid " ' | grep -v 'grep -E " pid "'") (lambda () (read-line)))) (rundir (if (string? psres) ;; real process owned by user (read-symbolic-link (conc "/proc/" pid "/cwd")) #f))) |
| ︙ | ︙ |
Modified process-inc.scm from [4ac258f1e9] to [1cd75def2c].
| ︙ | ︙ | |||
94 95 96 97 98 99 100 |
(let loop ((curr (read-line fh))
(result '()))
(if (not (eof-object? curr))
(loop (read-line fh)
(append result (list (proc curr))))
(begin
(close-input-port fh)
| | | 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 |
(let loop ((curr (read-line fh))
(result '()))
(if (not (eof-object? curr))
(loop (read-line fh)
(append result (list (proc curr))))
(begin
(close-input-port fh)
;;(close-input-port fhe)
(close-output-port fho)
result))))))
(define (process:cmd-run-proc-each-line-alt cmd proc)
(let* ((fh (open-input-pipe cmd))
(res (port-proc->list fh proc))
(status (close-input-pipe fh)))
|
| ︙ | ︙ |
Modified runconfig-inc.scm from [e28b5a956f] to [dce2f45afa].
| ︙ | ︙ | |||
151 152 153 154 155 156 157 | ;; first break all parts into individual target patterns (if (string-index hed " ") ;; this is a multi-target target (let ((newres (append (string-split hed " ") res))) (runconfig:expand-target newres)) (if (string-index hed ",") ;; this is a multi-target where one or more parts are comma separated |# | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 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 |
;; first break all parts into individual target patterns
(if (string-index hed " ") ;; this is a multi-target target
(let ((newres (append (string-split hed " ") res)))
(runconfig:expand-target newres))
(if (string-index hed ",") ;; this is a multi-target where one or more parts are comma separated
|#
;; cache the runconfigs in $MT_LINKTREE/$MT_TARGET/$MT_RUNNAME/.runconfig
;;
(define (full-runconfigs-read)
;; in the envprocessing branch the below code replaces the further below code
;; (if (eq? *configstatus* 'fulldata)
;; *runconfigdat*
;; (begin
;; (launch:setup)
;; *runconfigdat*)))
(let* ((rundir (if (and (getenv "MT_LINKTREE")(getenv "MT_TARGET")(getenv "MT_RUNNAME"))
(conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME"))
#f))
(cfgf (if rundir (conc rundir "/.runconfig." megatest-version "-" megatest-fossil-hash) #f)))
(if (and cfgf
(common:file-exists? cfgf)
(file-write-access? cfgf)
(common:use-cache?))
(configf:read-alist cfgf)
(let* ((keys (rmt:get-keys))
(target (common:args-get-target))
(key-vals (if target (keys:target->keyval keys target) #f))
(sections (if target (list "default" target) #f))
(data (begin
(setenv "MT_RUN_AREA_HOME" *toppath*)
(if key-vals
(for-each (lambda (kt)
(setenv (car kt) (cadr kt)))
key-vals))
;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections))))
(runconfig:read (conc *toppath* "/runconfigs.config") target #f))))
(if (and rundir ;; have all needed variabless
(directory-exists? rundir)
(file-write-access? rundir))
(begin
(if (not (common:in-running-test?))
(configf:write-alist data cfgf))
;; force re-read of megatest.config - this resolves circular references between megatest.config
(launch:setup force-reread: #t)
;; (launch:cache-config) ;; there are two independent config cache locations, turning this one off for now. MRW.
)) ;; we can safely cache megatest.config since we have a valid runconfig
data))))
|