117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(if (not archive-dir) ;; no archive disk found, this is fatal
(begin
(debug:print 0 *default-log-port* "FATAL: No archive disks found. Please add disks with at least " min-space " MB space to the [archive-disks] section of megatest.config")
(debug:print 0 *default-log-port* " use [archive] minspace to specify minimum available space")
(debug:print 0 *default-log-port* " disks: " (string-intersperse (map cadr (archive:get-archive-disks)) "\n "))
(exit 1))
(debug:print-info 0 #f "Using path " archive-dir " for archiving"))
;; from the test info bin the path to the test by stem
;;
(for-each
(lambda (test-dat)
(let* ((item-path (db:test-get-item-path test-dat))
(test-name (db:test-get-testname test-dat))
|
|
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(if (not archive-dir) ;; no archive disk found, this is fatal
(begin
(debug:print 0 *default-log-port* "FATAL: No archive disks found. Please add disks with at least " min-space " MB space to the [archive-disks] section of megatest.config")
(debug:print 0 *default-log-port* " use [archive] minspace to specify minimum available space")
(debug:print 0 *default-log-port* " disks: " (string-intersperse (map cadr (archive:get-archive-disks)) "\n "))
(exit 1))
(debug:print-info 0 *default-log-port* "Using path " archive-dir " for archiving"))
;; from the test info bin the path to the test by stem
;;
(for-each
(lambda (test-dat)
(let* ((item-path (db:test-get-item-path test-dat))
(test-name (db:test-get-testname test-dat))
|
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
test-paths))
(print-prefix #f)) ;; "Running: ")) ;; change to #f to turn off printing
(if (not (file-exists? archive-dir))
(create-directory archive-dir #t))
(if (not (file-exists? (conc archive-dir "/HEAD")))
(begin
;; replace this with jobrunner stuff enventually
(debug:print-info 0 #f "Init bup in " archive-dir)
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)
;; (mutex-unlock! bup-mutex)
))
(debug:print-info 0 #f "Indexing data to be archived")
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)
(debug:print-info 0 #f "Archiving data with bup")
(run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)
;; (mutex-unlock! bup-mutex)
(for-each
(lambda (test-dat)
(let ((test-id (db:test-get-id test-dat))
(run-id (db:test-get-run_id test-dat)))
(rmt:test-set-archive-block-id run-id test-id archive-id)
|
|
|
|
|
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
test-paths))
(print-prefix #f)) ;; "Running: ")) ;; change to #f to turn off printing
(if (not (file-exists? archive-dir))
(create-directory archive-dir #t))
(if (not (file-exists? (conc archive-dir "/HEAD")))
(begin
;; replace this with jobrunner stuff enventually
(debug:print-info 0 *default-log-port* "Init bup in " archive-dir)
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)
;; (mutex-unlock! bup-mutex)
))
(debug:print-info 0 *default-log-port* "Indexing data to be archived")
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)
(debug:print-info 0 *default-log-port* "Archiving data with bup")
(run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)
;; (mutex-unlock! bup-mutex)
(for-each
(lambda (test-dat)
(let ((test-id (db:test-get-id test-dat))
(run-id (db:test-get-run_id test-dat)))
(rmt:test-set-archive-block-id run-id test-id archive-id)
|
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
|
(new-test-path (if (vector? new-test-dat )
(db:test-get-rundir new-test-dat)
(begin
(debug:print 0 *default-log-port* "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id)
(exit 1))))
;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /..
(bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path)))
(debug:print-info 0 #f "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
;; (mutex-unlock! bup-mutex)
(mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
(debug:print 0 *default-log-port* "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id))))
(filter vector? tests))))
|
|
|
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
|
(new-test-path (if (vector? new-test-dat )
(db:test-get-rundir new-test-dat)
(begin
(debug:print 0 *default-log-port* "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id)
(exit 1))))
;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /..
(bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path)))
(debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
;; (mutex-lock! bup-mutex)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
;; (mutex-unlock! bup-mutex)
(mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
(debug:print 0 *default-log-port* "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id))))
(filter vector? tests))))
|