@@ -7,11 +7,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 format md5 message-digest)
+(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format md5 message-digest srfi-18)
 (import (prefix sqlite3 sqlite3:))
 
 (declare (unit archive))
 (declare (uses db))
 (declare (uses common))
@@ -99,11 +99,11 @@
 ;; 1. create the bup dir if not exists
 ;; 2. start the du of each directory
 ;; 3. gen index
 ;; 4. save
 ;;
-(define (archive:run-bup archive-command run-id run-name tests)
+(define (archive:run-bup archive-command run-id run-name tests rp-mutex bup-mutex)
   ;; move the getting of archive space down into the below block so that a single run can 
   ;; allocate as needed should a disk fill up
   ;;
   (let* ((min-space    (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
 	 (archive-info (archive:allocate-new-archive-block *toppath* (common:get-testsuite-name) min-space))
@@ -136,11 +136,15 @@
 	      (toplevel/children (and (db:test-get-is-toplevel test-dat)
 				      (> (rmt:test-toplevel-num-items run-id test-name) 0)))
 	      (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path)))
 	      ;; note the trailing slash to get the dir inspite of it being a link
 	      (test-path         (conc linktree "/" test-partial-path))
-	      (test-physical-path (if (file-exists? test-path) (read-symbolic-link test-path #t) #f))
+	      (mutex-lock! rp-mutex)
+	      (test-physical-path (if (file-exists? test-path) 
+				      (common:real-path test-path)
+				      #f))
+	      (mutex-unlock! rp-mutex)
 	      (partial-path-index (if test-physical-path (substring-index test-partial-path test-physical-path) #f))
 	      (test-base         (if (and partial-path-index 
 					  test-physical-path )
 				     (substring test-physical-path
 						0
@@ -182,15 +186,20 @@
 	     (create-directory archive-dir #t))
 	 (if (not (file-exists? (conc archive-dir "/HEAD")))
 	     (begin
 	       ;; replace this with jobrunner stuff enventually
 	       (debug:print-info 0 "Init bup in " archive-dir)
-	       (run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)))
+	       ;; (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 "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 "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)
@@ -198,11 +207,11 @@
 		  (runs:remove-test-directory test-dat 'archive-remove))))
 	  (hash-table-ref test-groups disk-group))))
      (hash-table-keys disk-groups))
     #t))
 
-(define (archive:bup-restore archive-command run-id run-name tests)  ;; move the getting of archive space down into the below block so that a single run can 
+(define (archive:bup-restore archive-command run-id run-name tests rp-mutex bup-mutex)  ;; move the getting of archive space down into the below block so that a single run can 
   ;; allocate as needed should a disk fill up
   ;;
   (let* ((bup-exe      (or (configf:lookup *configdat* "archive" "bup") "bup"))
 	 (linktree     (configf:lookup *configdat* "setup" "linktree")))
 
@@ -223,15 +232,16 @@
 				      (> (rmt:test-toplevel-num-items run-id test-name) 0)))
 	      (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path)))
 	      ;; note the trailing slash to get the dir inspite of it being a link
 	      (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
+	      (mutex-lock! rp-mutex)
 	      (prev-test-physical-path (if (file-exists? test-path)
 					   ;; (read-symbolic-link test-path #t)
 					   (common:real-path test-path)
 					   #f))
-
+	      (mutex-unlock! rp-mutex)
 	      (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)
 					   (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info
@@ -271,10 +281,12 @@
 						 (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)
+		 ;; (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 "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id))))
      (filter vector? tests))))