hook up syncing toggles

Although I observe that these toggles don't always prevent syncing.
When a transfer scan is active, it will still queue items from the disabled
remote.

Also, transfers from a disabled remote show up as from "unknown", which is
not ideal.
This commit is contained in:
Joey Hess 2012-10-12 12:45:16 -04:00
parent 06831e7754
commit 3f06c883f2
4 changed files with 51 additions and 33 deletions

View file

@ -8,6 +8,7 @@
module Assistant.WebApp.Utility where
import Assistant.Common
import Assistant.WebApp
import Assistant.WebApp.Types
import Assistant.DaemonStatus
import Assistant.ThreadedMonad
@ -15,9 +16,12 @@ import Assistant.TransferQueue
import Assistant.TransferSlots
import Assistant.Sync
import qualified Remote
import qualified Types.Remote as Remote
import qualified Remote.List as Remote
import qualified Assistant.Threads.Transferrer as Transferrer
import Logs.Transfer
import Locations.UserConfig
import qualified Config
import Yesod
import qualified Data.Map as M
@ -25,9 +29,14 @@ import Control.Concurrent
import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)
import System.Posix.Process (getProcessGroupIDOf)
changeSyncable :: Remote -> Bool -> Handler ()
changeSyncable r True = syncRemote r
changeSyncable r False = do
{- Use Nothing to change global sync setting. -}
changeSyncable :: (Maybe Remote) -> Bool -> Handler ()
changeSyncable Nothing _ = noop -- TODO
changeSyncable (Just r) True = do
changeSyncFlag r True
syncRemote r
changeSyncable (Just r) False = do
changeSyncFlag r False
webapp <- getYesod
let dstatus = daemonStatus webapp
let st = fromJust $ threadState webapp
@ -41,6 +50,16 @@ changeSyncable r False = do
where
tofrom t = transferUUID t == Remote.uuid r
changeSyncFlag :: Remote -> Bool -> Handler ()
changeSyncFlag r enabled = runAnnex undefined $ do
Config.setConfig key value
void $ Remote.remoteListRefresh
where
key = Config.remoteConfig (Remote.repo r) "sync"
value
| enabled = "true"
| otherwise = "false"
{- Start syncing remote, using a background thread. -}
syncRemote :: Remote -> Handler ()
syncRemote remote = do