From 35f4b77d7c9a0d413a5dabcd8ce15ad6388d582f Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 26 Oct 2013 16:54:49 -0400
Subject: moved code out of webapp

No code changes, aside from some changes to lifting in code that turned out
to be able to run in Assistant rather than Handler.
---
 Assistant/Sync.hs | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)

(limited to 'Assistant/Sync.hs')

diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 43f0309fe..6a66802d5 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -23,9 +23,17 @@ import qualified Git.Command
 import qualified Git.Ref
 import qualified Remote
 import qualified Types.Remote as Remote
+import qualified Remote.List as Remote
 import qualified Annex.Branch
 import Annex.UUID
 import Annex.TaggedPush
+import qualified Config
+import Git.Config
+import Assistant.NamedThread
+import Assistant.Threads.Watcher (watchThread, WatcherControl(..))
+import Assistant.TransferSlots
+import Assistant.TransferQueue
+import Logs.Transfer
 
 import Data.Time.Clock
 import qualified Data.Map as M
@@ -233,3 +241,36 @@ syncRemote remote = do
 		reconnectRemotes False [remote]
 		addScanRemotes True [remote]
 	void $ liftIO $ forkIO $ thread
+
+{- Use Nothing to change autocommit setting; or a remote to change
+ - its sync setting. -}
+changeSyncable :: Maybe Remote -> Bool -> Assistant ()
+changeSyncable Nothing enable = do
+	liftAnnex $ Config.setConfig key (boolConfig enable)
+	liftIO . maybe noop (`throwTo` signal)
+		=<< namedThreadId watchThread
+  where
+	key = Config.annexConfig "autocommit"
+	signal
+		| enable = ResumeWatcher
+		| otherwise = PauseWatcher
+changeSyncable (Just r) True = do
+	liftAnnex $ changeSyncFlag r True
+	syncRemote r
+changeSyncable (Just r) False = do
+	liftAnnex $ changeSyncFlag r False
+	updateSyncRemotes
+	{- Stop all transfers to or from this remote.
+	 - XXX Can't stop any ongoing scan, or git syncs. -}
+	void $ dequeueTransfers tofrom
+	mapM_ (cancelTransfer False) =<<
+		filter tofrom . M.keys . currentTransfers <$> getDaemonStatus
+  where
+	tofrom t = transferUUID t == Remote.uuid r
+
+changeSyncFlag :: Remote -> Bool -> Annex ()
+changeSyncFlag r enabled = do
+	Config.setConfig key (boolConfig enabled)
+	void Remote.remoteListRefresh
+  where
+	key = Config.remoteConfig (Remote.repo r) "sync"
-- 
cgit v1.2.3