Megatest

	      (test-path         (conc linktree "/" test-partial-path))
	      ;; if the old path was not deleted then prev-test-physical-path will end up pointing to a real directory
	      (prev-test-physical-path (if (file-exists? test-path) (read-symbolic-link test-path #t) #f))

	      (new-test-physical-path  (conc best-disk "/" test-partial-path))
	      (archive-block-id        (db:test-get-archived test-dat))
	      (archive-block-info      (rmt:test-get-archive-block-info archive-block-id))
	      (archive-path            (if (vector? archive-block-info)
	      (archive-path            (vector-ref archive-block-info 2)) ;; look in db.scm for test-get-archive-block-info for the vector record info
					   (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info
					   #f)) ;; no archive found?
	      (archive-internal-path   (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path)))
	 
	 ;; some sanity checks 
	 (if (and prev-test-physical-path
		  (file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in?
	     (debug:print 0 "ERROR: the old directory " prev-test-physical-path ", still exists! This should not be."))

	 (if archive-path ;; no point in proceeding if there is no actual archive
	     (begin
	 ;; CREATE WORK AREA
	 ;; test-src-path == #f     ==> don't copy in data from tests directory
	 ;; itemdat       == string ==> use directly
	 (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2))
	       ;; CREATE WORK AREA
	       ;; test-src-path == #f     ==> don't copy in data from tests directory
	       ;; itemdat       == string ==> use directly
	       (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2))

	 ;; 1. Get the block id from the test info
	 ;; 2. Get the block data given the block id
	 ;; 3. Construct the paths etc. for the following command:
	 ;; 
	 ;; bup -d /tmp/matt/adisk1/2015_q1/fullrun_e1a40/ restore -C /tmp/seeme fullrun-30/latest/ubuntu/nfs/none/w02.1.20.54_b/
	       ;; 1. Get the block id from the test info
	       ;; 2. Get the block data given the block id
	       ;; 3. Construct the paths etc. for the following command:
	       ;; 
	       ;; bup -d /tmp/matt/adisk1/2015_q1/fullrun_e1a40/ restore -C /tmp/seeme fullrun-30/latest/ubuntu/nfs/none/w02.1.20.54_b/

	 ;; DO BUP RESTORE
	 (let* ((new-test-dat        (rmt:get-test-info-by-id run-id test-id))
		(new-test-path       (db:test-get-rundir new-test-dat))
		;; 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 "Restoring archived data to " new-test-physical-path "; params: " bup-restore-params)
	   (run-n-wait bup-exe params: bup-restore-params print-cmd: #f))))
     tests)))
	       ;; DO BUP RESTORE
	       (let* ((new-test-dat        (rmt:get-test-info-by-id run-id test-id))
		      (new-test-path       (if (vector? new-test-dat )
					       (db:test-get-rundir new-test-dat)
					       (begin
						 (debug:print 0 "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 "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)))
	     (debug:print 0 "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id))))
     (filter vector? tests))))
	 

		    (debug:print 1 "Modifying state and staus for tests for run: " runkey " " (db:get-value-by-header run header "runname")))
		   ((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"))
		    (debug:print 1 "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname"))
		    (set! worker-thread (make-thread (lambda ()
						       (case (string->symbol (args:get-arg "-archive"))
							 ((save save-remove keep-html)(archive:run-bup (args:get-arg "-archive") run-id run-name tests))
							 ((restore)(archive:bup-restore (args:get-arg "-archive") run-id run-name tests))
							 (else (debug:print 0 "ERROR: unrecognised sub command to -archive. Run \"megatest\" to see help"))))
						     "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     (filter 
					  vector?
		 (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))
									(> (string-length dira)(string-length dirb))
									#f)))))
					  (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))
									 (> (string-length dira)(string-length dirb))
									 #f))))))
		       (toplevel-retries (make-hash-table)) ;; try three times to loop through and remove top level tests
		       (test-retry-time  (make-hash-table))
		       (allow-run-time   10)) ;; seconds to allow for killing tests before just brutally killing 'em
		   (let loop ((test (car sorted-tests))
			      (tal  (cdr sorted-tests)))
		     (let* ((test-id       (db:test-get-id test))
			    (new-test-dat  (rmt:get-test-info-by-id run-id test-id)))