diff options
| -rw-r--r-- | Assistant/DaemonStatus.hs | 23 | ||||
| -rw-r--r-- | Assistant/MakeRemote.hs | 1 | ||||
| -rw-r--r-- | Assistant/Sync.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/MountWatcher.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/Pusher.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/TransferScanner.hs | 10 | ||||
| -rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 4 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 4 | ||||
| -rw-r--r-- | Command/Assistant.hs | 2 | ||||
| -rw-r--r-- | Command/WebApp.hs | 2 | ||||
| -rw-r--r-- | Git/Config.hs | 5 | ||||
| -rw-r--r-- | Types/StandardGroups.hs | 2 | ||||
| -rw-r--r-- | doc/design/assistant/blog/day_105__lazy_Sunday.mdwn | 43 | ||||
| -rw-r--r-- | doc/design/assistant/webapp.mdwn | 8 | ||||
| -rw-r--r-- | doc/preferred_content.mdwn | 8 |
15 files changed, 85 insertions, 33 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 8146f977e..60b560b90 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -41,8 +41,8 @@ data DaemonStatus = DaemonStatus -- Messages to display to the user. , alertMap :: AlertMap , lastAlertId :: AlertId - -- Ordered list of remotes to talk to. - , knownRemotes :: [Remote] + -- Ordered list of remotes to sync with. + , syncRemotes :: [Remote] -- Pairing request that is in progress. , pairingInProgress :: Maybe PairingInProgress -- Broadcasts notifications about all changes to the DaemonStatus @@ -89,21 +89,20 @@ modifyDaemonStatus dstatus a = do return b {- Syncable remotes ordered by cost. -} -calcKnownRemotes :: Annex [Remote] -calcKnownRemotes = do +calcSyncRemotes :: Annex [Remote] +calcSyncRemotes = do rs <- filterM (repoSyncable . Remote.repo) =<< concat . Remote.byCost <$> Remote.enabledRemoteList alive <- snd <$> trustPartition DeadTrusted (map Remote.uuid rs) let good r = Remote.uuid r `elem` alive return $ filter good rs -{- Updates the cached ordered list of remotes from the list in Annex - - state. -} -updateKnownRemotes :: DaemonStatusHandle -> Annex () -updateKnownRemotes dstatus = do - remotes <- calcKnownRemotes +{- Updates the sycRemotes list from the list of all remotes in Annex state. -} +updateSyncRemotes :: DaemonStatusHandle -> Annex () +updateSyncRemotes dstatus = do + remotes <- calcSyncRemotes liftIO $ modifyDaemonStatus_ dstatus $ - \s -> s { knownRemotes = remotes } + \s -> s { syncRemotes = remotes } {- Load any previous daemon status file, and store it in a MVar for this - process to use as its DaemonStatus. Also gets current transfer status. -} @@ -113,12 +112,12 @@ startDaemonStatus = do status <- liftIO $ flip catchDefaultIO (readDaemonStatusFile file) =<< newDaemonStatus transfers <- M.fromList <$> getTransfers - remotes <- calcKnownRemotes + remotes <- calcSyncRemotes liftIO $ atomically $ newTMVar status { scanComplete = False , sanityCheckRunning = False , currentTransfers = transfers - , knownRemotes = remotes + , syncRemotes = remotes } {- Don't just dump out the structure, because it will change over time, diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index eec383272..8aa7cb2e8 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -93,6 +93,7 @@ makeRemote basename location a = do g <- gitRepo if not (any samelocation $ Git.remotes g) then do + let name = uniqueRemoteName basename 0 g a name return name diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 59aa6205c..6c167e2ea 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -156,5 +156,5 @@ manualPull st currentbranch remotes = do {- Start syncing a newly added remote, using a background thread. -} syncNewRemote :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> Remote -> IO () syncNewRemote st dstatus scanremotes remote = do - runThreadState st $ updateKnownRemotes dstatus + runThreadState st $ updateSyncRemotes dstatus void $ forkIO $ reconnectRemotes "SyncRemote" st dstatus scanremotes [remote] diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs index 79fcce08c..462f5843c 100644 --- a/Assistant/Threads/MountWatcher.hs +++ b/Assistant/Threads/MountWatcher.hs @@ -174,7 +174,7 @@ remotesUnder st dstatus dir = runThreadState st $ do let (waschanged, rs') = unzip pairs when (any id waschanged) $ do Annex.changeState $ \s -> s { Annex.remotes = rs' } - updateKnownRemotes dstatus + updateSyncRemotes dstatus return $ map snd $ filter fst pairs where checkremote repotop r = case Remote.localpath r of diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index dee563d74..4f3a2dd09 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -52,7 +52,7 @@ pushThread st dstatus commitchan pushmap = thread $ runEvery (Seconds 2) $ do now <- getCurrentTime if shouldPush now commits then do - remotes <- filter pushable . knownRemotes + remotes <- filter pushable . syncRemotes <$> getDaemonStatus dstatus unless (null remotes) $ void $ alertWhile dstatus (pushAlert remotes) $ diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 56ba63ff1..bc5837529 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -61,7 +61,7 @@ transferScannerThread st dstatus scanremotes transferqueue = thread $ do - lost. -} startupScan = addScanRemotes scanremotes True - =<< knownRemotes <$> getDaemonStatus dstatus + =<< syncRemotes <$> getDaemonStatus dstatus {- This is a cheap scan for failed transfers involving a remote. -} failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO () @@ -87,7 +87,7 @@ failedTransferScan st dstatus transferqueue r = do transferqueue dstatus (associatedFile info) t r {- This is a expensive scan through the full git work tree, finding - - files to download from or upload to any of the remotes. + - files to download from or upload to any known remote. - - The scan is blocked when the transfer queue gets too large. -} expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> [Remote] -> IO () @@ -114,7 +114,11 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do queueTransferWhenSmall transferqueue dstatus (Just f) t r findtransfers f (key, _) = do locs <- loggedLocations key - let use a = return $ catMaybes $ map (a key locs) rs + {- Queue transfers from any known remote. The known + - remotes may have changed since this scan began. -} + let use a = do + syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus + return $ catMaybes $ map (a key locs) syncrs ifM (inAnnex key) ( filterM (wantSend (Just f) . Remote.uuid . fst) =<< use (check Upload False) diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index 16d247860..a54128cb6 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -67,8 +67,8 @@ onAdd st dstatus _ file _ = case parseTransferFile file of [ "transfer starting:" , show t ] - r <- headMaybe . filter (sameuuid t) . knownRemotes - <$> getDaemonStatus dstatus + r <- headMaybe . filter (sameuuid t) + <$> runThreadState st Remote.remoteList updateTransferInfo dstatus t info { transferRemote = r } sameuuid t r = Remote.uuid r == transferUUID t diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 9b081d32e..125b6d164 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -71,7 +71,7 @@ queueTransfersMatching matching schedule q dstatus k f direction where go = do rs <- sufficientremotes - =<< knownRemotes <$> liftIO (getDaemonStatus dstatus) + =<< syncRemotes <$> liftIO (getDaemonStatus dstatus) let matchingrs = filter (matching . Remote.uuid) rs if null matchingrs then defer @@ -104,8 +104,8 @@ queueTransfersMatching matching schedule q dstatus k f direction - any others in the list to try again later. -} queueDeferredDownloads :: Schedule -> TransferQueue -> DaemonStatusHandle -> Annex () queueDeferredDownloads schedule q dstatus = do - rs <- knownRemotes <$> liftIO (getDaemonStatus dstatus) l <- liftIO $ atomically $ swapTVar (deferreddownloads q) [] + rs <- syncRemotes <$> liftIO (getDaemonStatus dstatus) left <- filterM (queue rs) l unless (null left) $ liftIO $ atomically $ modifyTVar' (deferreddownloads q) $ diff --git a/Command/Assistant.hs b/Command/Assistant.hs index 53f7e4baf..b039e2731 100644 --- a/Command/Assistant.hs +++ b/Command/Assistant.hs @@ -54,7 +54,7 @@ autoStart = do let nothing = error $ "Nothing listed in " ++ autostartfile ifM (doesFileExist autostartfile) ( do - dirs <- lines <$> readFile autostartfile + dirs <- nub . lines <$> readFile autostartfile program <- readProgramFile when (null dirs) nothing forM_ dirs $ \d -> do diff --git a/Command/WebApp.hs b/Command/WebApp.hs index 205e36341..f87ea983a 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -75,7 +75,7 @@ startNoRepo = do autoStart :: FilePath -> IO () autoStart autostartfile = do - dirs <- lines <$> readFile autostartfile + dirs <- nub . lines <$> readFile autostartfile edirs <- filterM doesDirectoryExist dirs case edirs of [] -> firstRun -- what else can I do? Nothing works.. diff --git a/Git/Config.hs b/Git/Config.hs index 00d1ddba2..500c8aa0f 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -37,7 +37,10 @@ read repo@(Repo { config = c }) {- Reads config even if it was read before. -} reRead :: Repo -> IO Repo -reRead = read' +reRead r = read' $ r + { config = M.empty + , fullconfig = M.empty + } {- Cannot use pipeRead because it relies on the config having been already - read. Instead, chdir to the repo and run git config. diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 32e2cb3af..1739c2059 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -32,6 +32,6 @@ descStandardGroup BackupGroup = "backup: collects all files" {- See doc/preferred_content.mdwn for explanations of these expressions. -} preferredContent :: StandardGroup -> String preferredContent ClientGroup = "exclude=*/archive/*" -preferredContent TransferGroup = "not inallgroup=client and " ++ preferredContent ClientGroup +preferredContent TransferGroup = "not (inallgroup=client and copies=client:2) and " ++ preferredContent ClientGroup preferredContent ArchiveGroup = "not copies=archive:1" preferredContent BackupGroup = "" -- all content is preferred diff --git a/doc/design/assistant/blog/day_105__lazy_Sunday.mdwn b/doc/design/assistant/blog/day_105__lazy_Sunday.mdwn new file mode 100644 index 000000000..eb25ddace --- /dev/null +++ b/doc/design/assistant/blog/day_105__lazy_Sunday.mdwn @@ -0,0 +1,43 @@ +Did a fair amount of testing and bug fixing today. + +There is still some buggy behavior around pausing syncing to a remote, +where transfers still happen to it, but I fixed the worst bug there. + +Noticed that if a non-bare repo is set up on a removable drive, +its file tree will not normally be updated as syncs come in -- because the +assistant is not running on that repo, and so incoming syncs are not +merged into the local master branch. For now I made it always use bare +repos on removable drives, but I may want to revisit this. + +The repository edit form now has a field for the name of the repo, +so the ugly names that the assistant comes up with for ssh remotes +can be edited as you like. `git remote rename` is a very nice thing. + +Changed the preferred content expression for transfer repos to this: +"not (inallgroup=client **and copies=client:2)**". This way, when there's +just one client, files on it will be synced to transfer repos, even +though those repos have no other clients to transfer them to. Presumably, +if a transfer repo is set up, more clients are coming soon, so this avoids +a wait. Particularly useful with removable drives, as the drive will start +being filled as soon as it's added, and can then be brought to a client +elsewhere. The "2" does mean that, once another client is found, +the data on the transfer repo will be dropped, and so if it's brought +to yet another new client, it won't have data for it right away. +I can't see way to generalize this workaround to more than 2 clients; +the transfer repo has to start dropping apparently unwanted content at +some point. Still, this will avoid a potentially very confusing behavior +when getting started. + +---- + +I need to get that dropping of non-preferred content to happen still. +Yesterday, I did some analysis of all the events that can cause previously +preferred content to no longer be preferred, so I know all the places +I have to deal with this. + +The one that's giving me some trouble is checking in the transfer scan. If it +checks for content to drop at the same time as content to transfer, it could +end up doing a lot of transfers before dropping anything. It'd be nicer to +first drop as much as it can, before getting more data, so that transfer +remotes stay as small as possible. But the scan is expensive, and it'd also +be nice not to need two passes. diff --git a/doc/design/assistant/webapp.mdwn b/doc/design/assistant/webapp.mdwn index f3d959a33..fc110a8f2 100644 --- a/doc/design/assistant/webapp.mdwn +++ b/doc/design/assistant/webapp.mdwn @@ -8,11 +8,6 @@ The webapp is a web server that displays a shiny interface. This is quite likely because of how the div containing transfers is refereshed. If instead javascript was used to update the progress bar etc for transfers with json data, the buttons would work better. -* Disabling syncing to a remote doesn't stop any running transfer scan, - which can still queue uploads or downloads to the remote. -* Transfers from a remote with syncing disabled show as from "unknown". - (Note that it's probably not practical to prevent a remote with syncing - disabled from initiating transfers, so this can happen.) ## interface @@ -33,8 +28,9 @@ The webapp is a web server that displays a shiny interface. See: [[todo/wishlist:_an_"assistant"_for_web-browsing_--_tracking_the_sources_of_the_downloads]] * Display the `inotify max_user_watches` exceeded message. **done** * Display something sane when kqueue runs out of file descriptors. -* allow renaming git remotes and/or setting git-annex repo descriptions * allow removing git remotes +* allow disabling syncing to here, which should temporarily disable all + local syncing. ## first start **done** diff --git a/doc/preferred_content.mdwn b/doc/preferred_content.mdwn index c130a07e6..d74986503 100644 --- a/doc/preferred_content.mdwn +++ b/doc/preferred_content.mdwn @@ -61,7 +61,13 @@ USB drive used in a sneakernet. The preferred content expression for these causes them to get and retain data until all clients have a copy. -`not inallgroup=client and exclude=*/archive/*` +`not (inallgroup=client and copies=client:2) and exclude=*/archive/*` + +The "copies=client:2" part of the above handles the case where +there is only one client repository. It makes a transfer repository +speculatively prefer content in this case, even though it as of yet +has nowhere to transfer it to. Presumably, another client repository +will be added later. ### archive |