Overview
| Comment: | partial completion of remove-runs changes, and increase on min-inodes default from 0 to 1000000 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
87b708cb94564b18e2dfff80355054e4 |
| User & Date: | mmgraham on 2020-06-04 10:36:09 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-06-04
| ||
| 16:57 | enhanced -remove-runs to check for the existence of the target and run name in paths to delete, and to delete all run paths on each disk. check-in: 6bb9465eb1 user: mmgraham tags: v1.65 | |
| 10:36 | partial completion of remove-runs changes, and increase on min-inodes default from 0 to 1000000 check-in: 87b708cb94 user: mmgraham tags: v1.65 | |
|
2020-06-01
| ||
| 13:34 | merged fork check-in: fb18c65fe3 user: pjhatwal tags: v1.65, v1.6549 | |
Changes
Modified common.scm from [e0587bf118] to [9a1d758071].
| ︙ | ︙ | |||
2163 2164 2165 2166 2167 2168 2169 | (begin (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace ", exiting now.") (exit 1))))) ;; paths is list of lists ((name path) ... ) ;; (define (common:get-disk-with-most-free-space disks minsize) | | > > | > | 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 |
(begin
(debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace ", exiting now.")
(exit 1)))))
;; paths is list of lists ((name path) ... )
;;
(define (common:get-disk-with-most-free-space disks minsize)
(let* ((best #f)
(bestsize 0)
(default-min-inodes-string "1000000")
(default-min-inodes (string->number default-min-inodes-string))
(min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") default-min-inodes-string)) default-min-inodes)))
(for-each
(lambda (disk-num)
(let* ((dirpath (cadr (assoc disk-num disks)))
(freespc (cond
((not (directory? dirpath))
(if (common:low-noise-print 300 "disks not a dir " disk-num)
(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
|
| ︙ | ︙ | |||
2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 |
(if (common:low-noise-print 300 "disks not a proper path " disk-num)
(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
-1)
(else
(get-free-inodes dirpath))))
;;(free-inodes (get-free-inodes dirpath))
)
(if (and (> freespc bestsize)(> free-inodes min-inodes ))
(begin
(set! best (cons disk-num dirpath))
(set! bestsize freespc)))
;;(print "Processing: " disk-num " bestsize: " bestsize " best: " best " freespc: " freespc " min-inodes: " min-inodes " free-inodes: " free-inodes)
))
(map car disks))
| > | 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 |
(if (common:low-noise-print 300 "disks not a proper path " disk-num)
(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
-1)
(else
(get-free-inodes dirpath))))
;;(free-inodes (get-free-inodes dirpath))
)
(debug:print 2 *default-log-port* "INFO: disk " disk-num " path " dirpath " free space " freespc " free inodes " free-inodes)
(if (and (> freespc bestsize)(> free-inodes min-inodes ))
(begin
(set! best (cons disk-num dirpath))
(set! bestsize freespc)))
;;(print "Processing: " disk-num " bestsize: " bestsize " best: " best " freespc: " freespc " min-inodes: " min-inodes " free-inodes: " free-inodes)
))
(map car disks))
|
| ︙ | ︙ |
Modified runs.scm from [2d71b3332e] to [b5a23771e7].
| ︙ | ︙ | |||
2334 2335 2336 2337 2338 2339 2340 |
(mt:test-set-state-status-by-id run-id (db:test-get-id test) "KILLREQ" "n/a" #f)
(thread-sleep! 1)))
;; NOTE: This is suboptimal as the testdata will be used later and the state/status may have changed ...
(if (null? tal)
(loop new-test-dat tal)
(loop (car tal)(append tal (list new-test-dat)))))
(begin
| > > | < | < < | > > | 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 |
(mt:test-set-state-status-by-id run-id (db:test-get-id test) "KILLREQ" "n/a" #f)
(thread-sleep! 1)))
;; NOTE: This is suboptimal as the testdata will be used later and the state/status may have changed ...
(if (null? tal)
(loop new-test-dat tal)
(loop (car tal)(append tal (list new-test-dat)))))
(begin
(if (and (not (string= (db:test-get-rundir new-test-dat) "/tmp/badname")) (file-exists? (db:test-get-rundir new-test-dat)))
(begin
(set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal
(set! lastrealpath (resolve-pathname lasttpath))
(runs:remove-test-directory new-test-dat mode) ;; 'remove-all)
)
)
(if (not (null? tal))
(loop (car tal)(cdr tal)))))))
(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
((kill-runs)
;; RUNNING -> KILLREQ
;; LAUNCHED,RUNNING,REMOTEHOSTSTART -> NOT STARTED
|
| ︙ | ︙ | |||
2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 |
(common:join-backgrounded-threads))))
;; remove the run if zero tests remain
(if (eq? action 'remove-runs)
(let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
(remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
(if (null? remtests) ;; no more tests remaining
;; Remove the last dir from the path.
;; And same for the link-resolved path
(let* ((dparts (string-split lasttpath "/"))
(linkspath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))
(real-dparts (string-split lastrealpath "/"))
(realpath (conc "/" (string-intersperse (take real-dparts (- (length real-dparts) 1)) "/")))
)
| > | 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 |
(common:join-backgrounded-threads))))
;; remove the run if zero tests remain
(if (eq? action 'remove-runs)
(let* ((run-id (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
(remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
(if (null? remtests) ;; no more tests remaining
;; Remove the last dir from the path.
;; And same for the link-resolved path
(let* ((dparts (string-split lasttpath "/"))
(linkspath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))
(real-dparts (string-split lastrealpath "/"))
(realpath (conc "/" (string-intersperse (take real-dparts (- (length real-dparts) 1)) "/")))
)
|
| ︙ | ︙ |