From 4f60234690d08b617771147e3f0ebedd53c41c3d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 22 Dec 2015 15:23:27 -0400 Subject: [PATCH] finish v6 support for assistant Seems to basically work now! --- Annex/Ingest.hs | 102 ++++++++++++++++++--------------- Assistant/Threads/Committer.hs | 67 +++++++++++----------- Assistant/Types/Changes.hs | 13 +++-- Command/Add.hs | 4 +- 4 files changed, 99 insertions(+), 87 deletions(-) diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 0fd32a042f..707f71eff3 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -8,6 +8,7 @@ {-# LANGUAGE CPP #-} module Annex.Ingest ( + LockedDown(..), lockDown, ingest, finishIngestDirect, @@ -33,7 +34,6 @@ import Annex.ReplaceFile import Utility.Tmp import Utility.CopyFile import Annex.InodeSentinal -import Annex.Version #ifdef WITH_CLIBS #ifndef __ANDROID__ import Utility.Touch @@ -42,46 +42,42 @@ import Utility.Touch import Control.Exception (IOException) +data LockedDown = LockedDown + { lockingFile :: Bool + , keySource :: KeySource + } + deriving (Show) + {- The file that's being ingested is locked down before a key is generated, - to prevent it from being modified in between. This lock down is not - perfect at best (and pretty weak at worst). For example, it does not - guard against files that are already opened for write by another process. - - So a KeySource is returned. Its inodeCache can be used to detect any - - changes that might be made to the file after it was locked down. + - So, the InodeCache can be used to detect any changes that might be made + - to the file after it was locked down. - - When possible, the file is hard linked to a temp directory. This guards - against some changes, like deletion or overwrite of the file, and - allows lsof checks to be done more efficiently when adding a lot of files. - + - If the file is to be locked, lockingfile is True. Then the write + - bit is removed from the file as part of lock down to guard against + - further writes. + - - Lockdown can fail if a file gets deleted, and Nothing will be returned. -} -lockDown :: FilePath -> Annex (Maybe KeySource) -lockDown = either +lockDown :: Bool -> FilePath -> Annex (Maybe LockedDown) +lockDown lockingfile file = either (\e -> warning (show e) >> return Nothing) (return . Just) - <=< lockDown' + =<< lockDown' lockingfile file -lockDown' :: FilePath -> Annex (Either IOException KeySource) -lockDown' file = ifM crippledFileSystem +lockDown' :: Bool -> FilePath -> Annex (Either IOException LockedDown) +lockDown' lockingfile file = ifM crippledFileSystem ( withTSDelta $ liftIO . tryIO . nohardlink , tryIO $ do tmp <- fromRepo gitAnnexTmpMiscDir createAnnexDirectory tmp - go tmp - ) - where - {- In indirect mode, the write bit is removed from the file as part - - of lock down to guard against further writes, and because objects - - in the annex have their write bit disabled anyway. - - - - Freezing the content early also lets us fail early when - - someone else owns the file. - - - - This is not done in direct mode, because files there need to - - remain writable at all times. - -} - go tmp = do - unlessM isDirect $ + when lockingfile $ freezeContent file withTSDelta $ \delta -> liftIO $ do (tmpfile, h) <- openTempFile tmp $ @@ -89,9 +85,11 @@ lockDown' file = ifM crippledFileSystem hClose h nukeFile tmpfile withhardlink delta tmpfile `catchIO` const (nohardlink delta) + ) + where nohardlink delta = do cache <- genInodeCache file delta - return KeySource + return $ LockedDown lockingfile $ KeySource { keyFilename = file , contentLocation = file , inodeCache = cache @@ -99,7 +97,7 @@ lockDown' file = ifM crippledFileSystem withhardlink delta tmpfile = do createLink file tmpfile cache <- genInodeCache tmpfile delta - return KeySource + return $ LockedDown lockingfile $ KeySource { keyFilename = file , contentLocation = tmpfile , inodeCache = cache @@ -107,12 +105,13 @@ lockDown' file = ifM crippledFileSystem {- Ingests a locked down file into the annex. - - - In direct mode, leaves the file alone, and just updates bookkeeping - - information. + - The file may be added to the git repository as a locked or an unlocked + - file. When unlocked, the work tree file is left alone. When locked, + - the work tree file is deleted, in preparation for adding the symlink. -} -ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache) +ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache) ingest Nothing = return (Nothing, Nothing) -ingest (Just source) = withTSDelta $ \delta -> do +ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do backend <- chooseBackend $ keyFilename source k <- genKey source backend let src = contentLocation source @@ -123,43 +122,56 @@ ingest (Just source) = withTSDelta $ \delta -> do (Just newc, Just c) | compareStrong c newc -> go k mcache ms _ -> failure "changed while it was being added" where - go k mcache ms = ifM isDirect - ( godirect k mcache ms - , goindirect k mcache ms - ) + go (Just (key, _)) mcache (Just s) + | lockingfile = golocked key mcache s + | otherwise = ifM isDirect + ( godirect key mcache s + , gounlocked key mcache s + ) + go _ _ _ = failure "failed to generate a key" - goindirect (Just (key, _)) mcache ms = do + golocked key mcache s = do catchNonAsync (moveAnnex key $ contentLocation source) (restoreFile (keyFilename source) key) - maybe noop (genMetaData key (keyFilename source)) ms liftIO $ nukeFile $ keyFilename source - return (Just key, mcache) - goindirect _ _ _ = failure "failed to generate a key" + success key mcache s - godirect (Just (key, _)) (Just cache) ms = do + gounlocked key (Just cache) s = do + r <- linkAnnex key (keyFilename source) (Just cache) + case r of + LinkAnnexFailed -> failure "failed to link to annex" + _ -> success key (Just cache) s + gounlocked _ _ _ = failure "failed statting file" + + godirect key (Just cache) s = do addInodeCache key cache - maybe noop (genMetaData key (keyFilename source)) ms finishIngestDirect key source - return (Just key, Just cache) - godirect _ _ _ = failure "failed to generate a key" + success key (Just cache) s + godirect _ _ _ = failure "failed statting file" + + success k mcache s = do + genMetaData k (keyFilename source) s + return (Just k, mcache) failure msg = do warning $ keyFilename source ++ " " ++ msg - when (contentLocation source /= keyFilename source) $ - liftIO $ nukeFile $ contentLocation source + cleanCruft source return (Nothing, Nothing) finishIngestDirect :: Key -> KeySource -> Annex () finishIngestDirect key source = do void $ addAssociatedFile key $ keyFilename source - when (contentLocation source /= keyFilename source) $ - liftIO $ nukeFile $ contentLocation source + cleanCruft source {- Copy to any other locations using the same key. -} otherfs <- filter (/= keyFilename source) <$> associatedFiles key forM_ otherfs $ addContentWhenNotPresent key (keyFilename source) +cleanCruft :: KeySource -> Annex () +cleanCruft source = when (contentLocation source /= keyFilename source) $ + liftIO $ nukeFile $ contentLocation source + {- On error, put the file back so it doesn't seem to have vanished. - This can be called before or after the symlink is in place. -} restoreFile :: FilePath -> Key -> SomeException -> Annex a diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 5e8df56c82..3e00011f5a 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -266,10 +266,12 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do let (pending, inprocess) = partition isPendingAddChange incomplete direct <- liftAnnex isDirect unlocked <- liftAnnex versionSupportsUnlockedPointers + let lockingfiles = not (unlocked || direct) (pending', cleanup) <- if unlocked || direct then return (pending, noop) else findnew pending - (postponed, toadd) <- partitionEithers <$> safeToAdd havelsof delayadd pending' inprocess + (postponed, toadd) <- partitionEithers + <$> safeToAdd lockingfiles havelsof delayadd pending' inprocess cleanup unless (null postponed) $ @@ -278,9 +280,9 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do returnWhen (null toadd) $ do added <- addaction toadd $ catMaybes <$> - if unlocked || direct + if not lockingfiles then addunlocked direct toadd - else forM toadd add + else forM toadd (add lockingfiles) if DirWatcher.eventsCoalesce || null added || unlocked || direct then return $ added ++ otherchanges else do @@ -307,16 +309,17 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do | c = return otherchanges | otherwise = a - add :: Change -> Assistant (Maybe Change) - add change@(InProcessAddChange { keySource = ks }) = + add :: Bool -> Change -> Assistant (Maybe Change) + add lockingfile change@(InProcessAddChange { lockedDown = ld }) = catchDefaultIO Nothing <~> doadd where + ks = keySource ld doadd = sanitycheck ks $ do (mkey, mcache) <- liftAnnex $ do showStart "add" $ keyFilename ks - ingest $ Just ks + ingest $ Just $ LockedDown lockingfile ks maybe (failedingest change) (done change mcache $ keyFilename ks) mkey - add _ = return Nothing + add _ _ = return Nothing {- Avoid overhead of re-injesting a renamed unlocked file, by - examining the other Changes to see if a removed file has the @@ -329,29 +332,22 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do m <- liftAnnex $ removedKeysMap isdirect ct cs delta <- liftAnnex getTSDelta if M.null m - then forM toadd add + then forM toadd (add False) else forM toadd $ \c -> do mcache <- liftIO $ genInodeCache (changeFile c) delta case mcache of - Nothing -> add c + Nothing -> add False c Just cache -> case M.lookup (inodeCacheToKey ct cache) m of - Nothing -> add c - Just k -> if isdirect - then fastadddirect c k - else fastaddunlocked c k + Nothing -> add False c + Just k -> fastadd isdirect c k - fastadddirect :: Change -> Key -> Assistant (Maybe Change) - fastadddirect change key = do - let source = keySource change - liftAnnex $ 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) + fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change) + fastadd isdirect change key = do + let source = keySource $ lockedDown change + liftAnnex $ if isdirect + then finishIngestDirect key source + else Database.Keys.addAssociatedFile key (keyFilename source) done change Nothing (keyFilename source) key removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) @@ -419,16 +415,16 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do - - Check by running lsof on the repository. -} -safeToAdd :: Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change] -safeToAdd _ _ [] [] = return [] -safeToAdd havelsof delayadd pending inprocess = do +safeToAdd :: Bool -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change] +safeToAdd _ _ _ [] [] = return [] +safeToAdd lockingfiles havelsof delayadd pending inprocess = do maybe noop (liftIO . threadDelaySeconds) delayadd liftAnnex $ do - keysources <- forM pending $ lockDown . changeFile - let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending keysources) + lockeddown <- forM pending $ lockDown lockingfiles . changeFile + let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending lockeddown) openfiles <- if havelsof then S.fromList . map fst3 . filter openwrite <$> - findopenfiles (map keySource inprocess') + findopenfiles (map (keySource . lockedDown) inprocess') else pure S.empty let checked = map (check openfiles) inprocess' @@ -441,17 +437,18 @@ safeToAdd havelsof delayadd pending inprocess = do allRight $ rights checked else return checked where - check openfiles change@(InProcessAddChange { keySource = ks }) - | S.member (contentLocation ks) openfiles = Left change + check openfiles change@(InProcessAddChange { lockedDown = ld }) + | S.member (contentLocation (keySource ld)) openfiles = Left change check _ change = Right change - mkinprocess (c, Just ks) = Just InProcessAddChange + mkinprocess (c, Just ld) = Just InProcessAddChange { changeTime = changeTime c - , keySource = ks + , lockedDown = ld } mkinprocess (_, Nothing) = Nothing - canceladd (InProcessAddChange { keySource = ks }) = do + canceladd (InProcessAddChange { lockedDown = ld }) = do + let ks = keySource ld warning $ keyFilename ks ++ " still has writers, not adding" -- remove the hard link diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs index 1d8b517754..8c2d02cab1 100644 --- a/Assistant/Types/Changes.hs +++ b/Assistant/Types/Changes.hs @@ -10,6 +10,7 @@ module Assistant.Types.Changes where import Types.KeySource import Types.Key import Utility.TList +import Annex.Ingest import Control.Concurrent.STM import Data.Time.Clock @@ -38,7 +39,7 @@ data Change } | InProcessAddChange { changeTime ::UTCTime - , keySource :: KeySource + , lockedDown :: LockedDown } deriving (Show) @@ -53,7 +54,7 @@ changeInfoKey _ = Nothing changeFile :: Change -> FilePath changeFile (Change _ f _) = f changeFile (PendingAddChange _ f) = f -changeFile (InProcessAddChange _ ks) = keyFilename ks +changeFile (InProcessAddChange _ ld) = keyFilename $ keySource ld isPendingAddChange :: Change -> Bool isPendingAddChange (PendingAddChange {}) = True @@ -64,14 +65,14 @@ isInProcessAddChange (InProcessAddChange {}) = True isInProcessAddChange _ = False retryChange :: Change -> Change -retryChange (InProcessAddChange time ks) = - PendingAddChange time (keyFilename ks) +retryChange c@(InProcessAddChange time _) = + PendingAddChange time $ changeFile c retryChange c = c finishedChange :: Change -> Key -> Change -finishedChange c@(InProcessAddChange { keySource = ks }) k = Change +finishedChange c@(InProcessAddChange {}) k = Change { changeTime = changeTime c - , _changeFile = keyFilename ks + , _changeFile = changeFile c , changeInfo = AddKeyChange k } finishedChange c _ = c diff --git a/Command/Add.hs b/Command/Add.hs index b1b830cbcf..8a7db0a912 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -113,7 +113,9 @@ start file = ifAnnexed file addpresent add next $ next $ cleanup file key Nothing =<< inAnnex key perform :: FilePath -> CommandPerform -perform file = lockDown file >>= ingest >>= go +perform file = do + lockingfile <- not <$> isDirect + lockDown lockingfile file >>= ingest >>= go where go (Just key, cache) = next $ cleanup file key cache True go (Nothing, _) = stop