From 0ac35d9b0ea997f9d6051d86889f4bb4df914498 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 21 Dec 2015 18:41:15 -0400 Subject: wip v6 support for assistant Files are not yet added to v6 repos in unlocked mode. --- Assistant/Threads/Committer.hs | 83 +++++++++++++++++++++++++----------------- Assistant/Threads/Watcher.hs | 62 ++++++++++++++++++++++--------- 2 files changed, 95 insertions(+), 50 deletions(-) (limited to 'Assistant/Threads') diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 745047d9d..891df8419 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -31,9 +31,11 @@ import Annex.Content import Annex.Link import Annex.CatFile import Annex.InodeSentinal +import Annex.Version import qualified Annex import Utility.InodeCache import Annex.Content.Direct +import qualified Database.Keys import qualified Command.Sync import qualified Git.Branch @@ -228,12 +230,11 @@ commitStaged msg = do return ok {- OSX needs a short delay after a file is added before locking it down, - - when using a non-direct mode repository, as pasting a file seems to - - try to set file permissions or otherwise access the file after closing - - it. -} + - as pasting a file seems to try to set file permissions or otherwise + - access the file after closing it. -} delayaddDefault :: Annex (Maybe Seconds) #ifdef darwin_HOST_OS -delayaddDefault = ifM isDirect +delayaddDefault = ifM (isDirect || versionSupportsUnlockedPointers) ( return Nothing , return $ Just $ Seconds 1 ) @@ -250,12 +251,11 @@ delayaddDefault = return Nothing - for write by some other process, and faster checking with git-ls-files - that the files are not already checked into git. - - - When a file is added, Inotify will notice the new symlink. So this waits - - for additional Changes to arrive, so that the symlink has hopefully been - - staged before returning, and will be committed immediately. - - - - OTOH, for kqueue, eventsCoalesce, so instead the symlink is directly - - created and staged. + - When a file is added in locked mode, Inotify will notice the new symlink. + - So this waits for additional Changes to arrive, so that the symlink has + - hopefully been staged before returning, and will be committed immediately. + - (OTOH, for kqueue, eventsCoalesce, so instead the symlink is directly + - created and staged.) - - Returns a list of all changes that are ready to be committed. - Any pending adds that are not ready yet are put back into the ChangeChan, @@ -265,7 +265,8 @@ handleAdds :: Bool -> Maybe Seconds -> [Change] -> Assistant [Change] handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do let (pending, inprocess) = partition isPendingAddChange incomplete direct <- liftAnnex isDirect - (pending', cleanup) <- if direct + unlocked <- liftAnnex versionSupportsUnlockedPointers + (pending', cleanup) <- if unlocked || direct then return (pending, noop) else findnew pending (postponed, toadd) <- partitionEithers <$> safeToAdd havelsof delayadd pending' inprocess @@ -276,10 +277,11 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do returnWhen (null toadd) $ do added <- addaction toadd $ - catMaybes <$> if direct - then adddirect toadd - else forM toadd add - if DirWatcher.eventsCoalesce || null added || direct + catMaybes <$> + if unlocked || direct + then addunlocked direct toadd + else forM toadd add + if DirWatcher.eventsCoalesce || null added || unlocked || direct then return $ added ++ otherchanges else do r <- handleAdds havelsof delayadd =<< getChanges @@ -316,15 +318,15 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do maybe (failedingest change) (done change mcache $ keyFilename ks) mkey add _ = return Nothing - {- In direct mode, avoid overhead of re-injesting a renamed - - file, by examining the other Changes to see if a removed - - file has the same InodeCache as the new file. If so, - - we can just update bookkeeping, and stage the file in git. + {- Avoid overhead of re-injesting a renamed unlocked file, by + - examining the other Changes to see if a removed file has the + - same InodeCache as the new file. If so, we can just update + - bookkeeping, and stage the file in git. -} - adddirect :: [Change] -> Assistant [Maybe Change] - adddirect toadd = do + addunlocked :: Bool -> [Change] -> Assistant [Maybe Change] + addunlocked isdirect toadd = do ct <- liftAnnex compareInodeCachesWith - m <- liftAnnex $ removedKeysMap ct cs + m <- liftAnnex $ removedKeysMap isdirect ct cs delta <- liftAnnex getTSDelta if M.null m then forM toadd add @@ -335,22 +337,33 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do Just cache -> case M.lookup (inodeCacheToKey ct cache) m of Nothing -> add c - Just k -> fastadd c k + Just k -> if isdirect + then fastadddirect c k + else fastaddunlocked c k - fastadd :: Change -> Key -> Assistant (Maybe Change) - fastadd change key = do + fastadddirect :: Change -> Key -> Assistant (Maybe Change) + fastadddirect change key = do let source = keySource change liftAnnex $ Command.Add.finishIngestDirect key source done change Nothing (keyFilename source) key + + fastaddunlocked :: Change -> Key -> Assistant (Maybe Change) + fastaddunlocked change key = do + let source = keySource change + liftAnnex $ do + Database.Keys.addAssociatedFile key (keyFilename source) + done change Nothing (keyFilename source) key - removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) - removedKeysMap ct l = do + removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) + removedKeysMap isdirect ct l = do mks <- forM (filter isRmChange l) $ \c -> catKeyFile $ changeFile c M.fromList . concat <$> mapM mkpairs (catMaybes mks) where mkpairs k = map (\c -> (inodeCacheToKey ct c, k)) <$> - recordedInodeCache k + if isdirect + then recordedInodeCache k + else Database.Keys.getInodeCaches k failedingest change = do refill [retryChange change] @@ -359,12 +372,16 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do done change mcache file key = liftAnnex $ do logStatus key InfoPresent - link <- ifM isDirect - ( calcRepo $ gitAnnexLink file key - , Command.Add.link file key mcache + ifM versionSupportsUnlockedPointers + ( stagePointerFile file =<< hashPointerFile key + , do + link <- ifM isDirect + ( calcRepo $ gitAnnexLink file key + , Command.Add.link file key mcache + ) + whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ + stageSymlink file =<< hashSymlink link ) - whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ - stageSymlink file =<< hashSymlink link showEndOk return $ Just $ finishedChange change key diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 37e0154b4..bb9659b7c 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -1,6 +1,6 @@ {- git-annex assistant tree watcher - - - Copyright 2012-2013 Joey Hess + - Copyright 2012-2015 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -36,10 +36,15 @@ import Annex.CheckIgnore import Annex.Link import Annex.FileMatcher import Types.FileMatcher +import Annex.Content import Annex.ReplaceFile +import Annex.Version +import Annex.InodeSentinal import Git.Types import Config import Utility.ThreadScheduler +import Logs.Location +import qualified Database.Keys #ifndef mingw32_HOST_OS import qualified Utility.Lsof as Lsof #endif @@ -88,10 +93,13 @@ runWatcher = do startup <- asIO1 startupScan matcher <- liftAnnex largeFilesMatcher direct <- liftAnnex isDirect + unlocked <- liftAnnex versionSupportsUnlockedPointers symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig - addhook <- hook $ if direct - then onAddDirect symlinkssupported matcher - else onAdd matcher + addhook <- hook $ if unlocked + then onAddUnlocked symlinkssupported matcher + else if direct + then onAddDirect symlinkssupported matcher + else onAdd matcher delhook <- hook onDel addsymlinkhook <- hook $ onAddSymlink direct deldirhook <- hook onDelDir @@ -216,15 +224,33 @@ onAdd matcher file filestatus shouldRestage :: DaemonStatus -> Bool shouldRestage ds = scanComplete ds || forceRestage ds +onAddUnlocked :: Bool -> FileMatcher Annex -> Handler +onAddUnlocked = onAddUnlocked' False contentchanged Database.Keys.addAssociatedFile samefilestatus + where + samefilestatus key file status = do + cache <- Database.Keys.getInodeCaches key + curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta file status + case (cache, curr) of + (_, Just c) -> elemInodeCaches c cache + ([], Nothing) -> return True + _ -> return False + contentchanged oldkey file = do + Database.Keys.removeAssociatedFile oldkey file + unlessM (inAnnex oldkey) $ + logStatus oldkey InfoMissing + {- In direct mode, add events are received for both new files, and - modified existing files. -} onAddDirect :: Bool -> FileMatcher Annex -> Handler -onAddDirect symlinkssupported matcher file fs = do +onAddDirect = onAddUnlocked' True changedDirect (\k f -> void $ addAssociatedFile k f) sameFileStatus + +onAddUnlocked' :: Bool -> (Key -> FilePath -> Annex ()) -> (Key -> FilePath -> Annex ()) -> (Key -> FilePath -> FileStatus -> Annex Bool) -> Bool -> FileMatcher Annex -> Handler +onAddUnlocked' isdirect contentchanged addassociatedfile samefilestatus symlinkssupported matcher file fs = do v <- liftAnnex $ catKeyFile file case (v, fs) of (Just key, Just filestatus) -> - ifM (liftAnnex $ sameFileStatus key file filestatus) + ifM (liftAnnex $ samefilestatus key file filestatus) {- It's possible to get an add event for - an existing file that is not - really modified, but it might have @@ -237,13 +263,13 @@ onAddDirect symlinkssupported matcher file fs = do , noChange ) , guardSymlinkStandin (Just key) $ do - debug ["changed direct", file] - liftAnnex $ changedDirect key file + debug ["changed", file] + liftAnnex $ contentchanged key file add matcher file ) _ -> unlessIgnored file $ guardSymlinkStandin Nothing $ do - debug ["add direct", file] + debug ["add", file] add matcher file where {- On a filesystem without symlinks, we'll get changes for regular @@ -259,9 +285,9 @@ onAddDirect symlinkssupported matcher file fs = do Just lt -> do case fileKey $ takeFileName lt of Nothing -> noop - Just key -> void $ liftAnnex $ - addAssociatedFile key file - onAddSymlink' linktarget mk True file fs + Just key -> liftAnnex $ + addassociatedfile key file + onAddSymlink' linktarget mk isdirect file fs {- A symlink might be an arbitrary symlink, which is just added. - Or, if it is a git-annex symlink, ensure it points to the content @@ -330,13 +356,15 @@ onDel file _ = do onDel' :: FilePath -> Annex () onDel' file = do - whenM isDirect $ do - mkey <- catKeyFile file - case mkey of - Nothing -> noop - Just key -> void $ removeAssociatedFile key file + ifM versionSupportsUnlockedPointers + ( withkey $ flip Database.Keys.removeAssociatedFile file + , whenM isDirect $ + withkey $ \key -> void $ removeAssociatedFile key file + ) Annex.Queue.addUpdateIndex =<< inRepo (Git.UpdateIndex.unstageFile file) + where + withkey a = maybe noop a =<< catKeyFile file {- A directory has been deleted, or moved, so tell git to remove anything - that was inside it from its cache. Since it could reappear at any time, -- cgit v1.2.3