@@ -8,11 +8,11 @@
 ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 ;;  PURPOSE.
 
 ;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')
 
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18))
+(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils)
 (import (prefix sqlite3 sqlite3:))
 
 (declare (unit runs))
 (declare (uses db))
 (declare (uses common))
@@ -516,11 +516,16 @@
 						(db:get-value-by-header run header (vector-ref k 0))) keys) "/"))
 	     (dirs-to-remove (make-hash-table)))
 	 (let* ((run-id    (db:get-value-by-header run header "id"))
 		(run-state (db:get-value-by-header run header "state"))
 		(tests     (if (not (equal? run-state "locked"))
-			       (rdb:get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt states statuses not-in: #f)
+			       (rdb:get-tests-for-run db (db:get-value-by-header run header "id")
+						      testpatt itempatt states statuses
+						      not-in:  #f
+						      sort-by: (case action
+								 ((remove-runs) 'rundir)
+								 (else          'event_time)))
 			       '()))
 		(lasttpath "/does/not/exist/I/hope"))
 
 	   (if (not (null? tests))
 	       (begin
@@ -534,55 +539,38 @@
 		 (for-each
 		  (lambda (test)
 		    (let* ((item-path (db:test-get-item-path test))
 			   (test-name (db:test-get-testname test))
 			   (run-dir   (db:test-get-rundir test)))
-		      (debug:print 1 "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " item-path)
+		      (debug:print 1 "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " item-path " action: " action)
 		      (case action
 			((remove-runs)
 			 (rdb:delete-test-records db (db:test-get-id test))
-			 (if (> (string-length run-dir) 5) ;; bad heuristic but should prevent /tmp /home etc.
-			     (let ((fullpath run-dir)) ;; "/" (db:test-get-item-path test))))
-			       (set! lasttpath fullpath)
-			       (hash-table-set! dirs-to-remove fullpath #t)
-			       ;; The following was the safe delete code but it was not being exectuted.
-			       ;; (let* ((dirs-count (+ 1 (length keys)(length (string-split item-path "/"))))
-			       ;;        (dir-to-rem (get-dir-up-n fullpath dirs-count))
-			       ;;        (remainingd (string-substitute (regexp (conc "^" dir-to-rem "/")) "" fullpath))
-			       ;;        (cmd (conc "cd " dir-to-rem "; rmdir -p " remainingd )))
-			       ;;   (if (file-exists? fullpath)
-			       ;;       (begin
-			       ;;         (debug:print 1 cmd)
-			       ;;         (system cmd)))
-			       ;;   ))
-			       )))
+			 (debug:print 1 "INFO: Attempting to remove dir " run-dir)
+			 (if (and (> (string-length run-dir) 5)
+				  (file-exists? run-dir)) ;; bad heuristic but should prevent /tmp /home etc.
+			     (let* ((realpath (resolve-pathname run-dir)))
+			       (debug:print 1 "INFO: Real path of is " realpath)
+			       (if (file-exists? realpath)
+				   (if (> (system (conc "rm -rf " realpath)) 0)
+				       (debug:print 0 "ERROR: There was a problem removing " realpath " with rm -f"))
+				   (debug:print 0 "WARNING: test run dir " realpath " appears to not exist"))
+			       (if (file-exists? run-dir) ;; the link
+				   (if (symbolic-link? run-dir)
+				       (delete-file run-dir)
+				       (if (directory? run-dir)
+					   (if (> (directory-fold (lambda (f x)(+ 1 x)) 0 run-dir) 0)
+					       (debug:print 0 "WARNING: refusing to remove " run-dir " as it is not empty")
+					       (delete-directory run-dir)) ;; it should be empty by here BUG BUG, add error catch
+					   (debug:print 0 "ERROR: refusing to remove " run-dir " as it is neither a symlink nor a directory")
+					   ))))
+			     (debug:print 0 "WARNING: directory already removed " run-dir)))
 			((set-state-status)
-			 (debug:print 4 "INFO: new state " (car state-status) ", new status " (cadr state-status))
+			 (debug:print 2 "INFO: new state " (car state-status) ", new status " (cadr state-status))
 			 (db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f)))))
 		  tests)))
-
-	   ;; look though the dirs-to-remove for candidates for removal. Do this after deleting the records
-	   ;; for each test in case we get killed. That should minimize the detritus left on disk
-	   ;; process the dirs from longest string length to shortest
-	   (if (eq? action 'remove-runs)
-	       (for-each 
-		(lambda (dir-to-remove)
-		  (if (file-exists? dir-to-remove)
-		      (let ((dir-in-db '()))
-			(sqlite3:for-each-row
-			 (lambda (dir)
-			   (set! dir-in-db (cons dir dir-in-db)))
-			 db "SELECT rundir FROM tests WHERE rundir LIKE ?;" 
-			 (conc "%" dir-to-remove "%")) ;; yes, I'm going to bail if there is anything like this dir in the db
-			(if (null? dir-in-db)
-			    (begin
-			      (debug:print 2 "Removing directory with zero db references: " dir-to-remove)
-			      (system (conc "rm -rf " dir-to-remove))
-			      (hash-table-delete! dirs-to-remove dir-to-remove))
-			    (debug:print 2 "Skipping removal of " dir-to-remove " for now as it still has references in the database")))))
-		(sort (hash-table-keys dirs-to-remove) (lambda (a b)(> (string-length a)(string-length b))))))
-
+	   
 	   ;; remove the run if zero tests remain
 	   (if (eq? action 'remove-runs)
 	       (let ((remtests (rdb:get-tests-for-run db (db:get-value-by-header run header "id") #f #f '() '())))
 		 (if (null? remtests) ;; no more tests remaining
 		     (let* ((dparts  (string-split lasttpath "/"))