From c150b05386e97ddaa1162a0943312223c94a225b Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 2 Apr 2013 16:17:06 -0400
Subject: avoid queuing transfers that are currently running

---
 Assistant/TransferQueue.hs | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

(limited to 'Assistant/TransferQueue.hs')

diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index 0afe3cb19..ac9ed3216 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -136,14 +136,18 @@ enqueue reason schedule t info
 		notifyTransfer
 	add modlist = do
 		q <- getAssistant transferQueue
-		liftIO $ atomically $ do
-			l <- readTVar (queuelist q)
-			if (t `notElem` map fst l)
-				then do	
-					void $ modifyTVar' (queuesize q) succ
-					void $ modifyTVar' (queuelist q) modlist
-					return True
-				else return False
+		dstatus <- getAssistant daemonStatusHandle
+		liftIO $ atomically $ ifM (checkRunningTransferSTM dstatus t)
+			( return False
+			, do
+				l <- readTVar (queuelist q)
+				if (t `notElem` map fst l)
+					then do	
+						void $ modifyTVar' (queuesize q) succ
+						void $ modifyTVar' (queuelist q) modlist
+						return True
+					else return False
+			)
 
 {- Adds a transfer to the queue. -}
 queueTransfer :: Reason -> Schedule -> AssociatedFile -> Transfer -> Remote -> Assistant ()
-- 
cgit v1.2.3