@@ -19,10 +19,11 @@
 (declare (uses items))
 (declare (uses runconfig))
 (declare (uses tests))
 (declare (uses server))
 (declare (uses mt))
+(declare (uses archive))
 ;; (declare (uses filedb))
 
 (include "common_records.scm")
 (include "key_records.scm")
 (include "db_records.scm")
@@ -1414,11 +1415,11 @@
 ;;    'remove-runs
 ;;    'set-state-status
 ;;
 ;; NB// should pass in keys?
 ;;
-(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(remove-data-only #f))
+(define (runs:operate-on action target runnamepatt testpatt #!key (state #f)(status #f)(new-state-status #f)(remove-data-only #f)(options '()))
   (common:clear-caches) ;; clear all caches
   (let* ((db           #f)
 	 (tdbdat       (tasks:open-db))
 	 (keys         (rmt:get-keys))
 	 (rundat       (mt:get-runs-by-patt keys runnamepatt target))
@@ -1448,11 +1449,12 @@
 		(run-state (db:get-value-by-header run header "state"))
 		(run-name  (db:get-value-by-header run header "runname"))
 		(tests     (if (not (equal? run-state "locked"))
 			       (proc-get-tests run-id)
 			       '()))
-		(lasttpath "/does/not/exist/I/hope"))
+		(lasttpath "/does/not/exist/I/hope")
+		(worker-thread #f))
 	   (debug:print-info 4 "runs:operate-on run=" run ", header=" header)
 	   (if (not (null? tests))
 	       (begin
 		 (case action
 		   ((remove-runs)
@@ -1468,12 +1470,21 @@
 		   ((print-run)
 		    (debug:print 1 "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
 		    action)
 		   ((run-wait)
 		    (debug:print 1 "Waiting for run " runkey ", run=" runnamepatt " to complete"))
+		   ((archive)
+		    (debug:print 1 "Archiving data for run: " runkey " " (db:get-value-by-header run header "runname"))
+		    (set! worker-thread (make-thread (lambda ()
+						       (archive:run-bup (args:get-arg "-archive") run-name tests))
+						     "archive-bup-thread"))
+		    (thread-start! worker-thread))
 		   (else
 		    (debug:print-info 0 "action not recognised " action)))
+		 
+		 ;; actions that operate on one test at a time can be handled below
+		 ;;
 		 (let ((sorted-tests     (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr 
 									 (db:test-get-rundir a)) ;; )  ;; (filedb:get-path *fdb* (db:test-get-rundir a)))
 									(dirb ;; (rmt:sdb-qry 'getstr 
 									 (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b))))
 								    (if (and (string? dira)(string? dirb))
@@ -1549,11 +1560,17 @@
 				(debug:print-info 2 "still waiting, " (length tests) " tests still running")
 				(thread-sleep! 10)
 				(let ((new-tests (proc-get-tests run-id)))
 				  (if (null? new-tests)
 				      (debug:print-info 1 "Run completed according to zero tests matching provided criteria.")
-				      (loop (car new-tests)(cdr new-tests))))))))
+				      (loop (car new-tests)(cdr new-tests)))))
+			       ((archive)
+				(if (not toplevel-with-children)
+				    (begin
+				      (debug:print-info 0 "Estimating disk space usage for " test-fulln)
+				      (debug:print-info 0 "   " (common:get-disk-space-used run-dir)))))
+			       )))
 		       )))))
 	   ;; remove the run if zero tests remain
 	   (if (eq? action 'remove-runs)
 	       (let ((remtests (mt:get-tests-for-run (db:get-value-by-header run header "id") #f '("DELETED") '("n/a") not-in: #t)))
 		 (if (null? remtests) ;; no more tests remaining