diff options
| -rw-r--r-- | Annex/Ingest.hs | 32 | ||||
| -rw-r--r-- | Assistant/Threads/Committer.hs | 30 | ||||
| -rw-r--r-- | Command/Add.hs | 6 | ||||
| -rw-r--r-- | Command/Smudge.hs | 6 |
4 files changed, 47 insertions, 27 deletions
diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 73f8a39ca..70ea105bb 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -9,6 +9,7 @@ module Annex.Ingest ( LockedDown(..), + LockDownConfig(..), lockDown, ingest, finishIngestDirect, @@ -48,11 +49,17 @@ import Utility.Touch import Control.Exception (IOException) data LockedDown = LockedDown - { lockingFile :: Bool + { lockDownConfig :: LockDownConfig , keySource :: KeySource } deriving (Show) +data LockDownConfig = LockDownConfig + { lockingFile :: Bool -- ^ write bit removed during lock down + , hardlinkFileTmp :: Bool -- ^ hard link to temp directory + } + 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 @@ -64,24 +71,21 @@ data LockedDown = LockedDown - 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 lockingfile is True, the file is going to be added in locked mode. - - So, its write bit is removed as part of the lock down. - - - Lockdown can fail if a file gets deleted, and Nothing will be returned. -} -lockDown :: Bool -> FilePath -> Annex (Maybe LockedDown) -lockDown lockingfile file = either +lockDown :: LockDownConfig -> FilePath -> Annex (Maybe LockedDown) +lockDown cfg file = either (\e -> warning (show e) >> return Nothing) (return . Just) - =<< lockDown' lockingfile file + =<< lockDown' cfg file -lockDown' :: Bool -> FilePath -> Annex (Either IOException LockedDown) -lockDown' lockingfile file = ifM crippledFileSystem +lockDown' :: LockDownConfig -> FilePath -> Annex (Either IOException LockedDown) +lockDown' cfg file = ifM (pure (not (hardlinkFileTmp cfg)) <||> crippledFileSystem) ( withTSDelta $ liftIO . tryIO . nohardlink , tryIO $ do tmp <- fromRepo gitAnnexTmpMiscDir createAnnexDirectory tmp - when lockingfile $ + when (lockingFile cfg) $ freezeContent file withTSDelta $ \delta -> liftIO $ do (tmpfile, h) <- openTempFile tmp $ @@ -93,7 +97,7 @@ lockDown' lockingfile file = ifM crippledFileSystem where nohardlink delta = do cache <- genInodeCache file delta - return $ LockedDown lockingfile $ KeySource + return $ LockedDown cfg $ KeySource { keyFilename = file , contentLocation = file , inodeCache = cache @@ -101,7 +105,7 @@ lockDown' lockingfile file = ifM crippledFileSystem withhardlink delta tmpfile = do createLink file tmpfile cache <- genInodeCache tmpfile delta - return $ LockedDown lockingfile $ KeySource + return $ LockedDown cfg $ KeySource { keyFilename = file , contentLocation = tmpfile , inodeCache = cache @@ -115,7 +119,7 @@ lockDown' lockingfile file = ifM crippledFileSystem -} ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache) ingest Nothing = return (Nothing, Nothing) -ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do +ingest (Just (LockedDown cfg source)) = withTSDelta $ \delta -> do backend <- chooseBackend $ keyFilename source k <- genKey source backend let src = contentLocation source @@ -127,7 +131,7 @@ ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do _ -> failure "changed while it was being added" where go (Just (key, _)) mcache (Just s) - | lockingfile = golocked key mcache s + | lockingFile cfg = golocked key mcache s | otherwise = ifM isDirect ( godirect key mcache s , gounlocked key mcache s diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 34303f52a..be4a0a255 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -268,11 +268,15 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do direct <- liftAnnex isDirect unlocked <- liftAnnex versionSupportsUnlockedPointers let lockingfiles = not (unlocked || direct) + let lockdownconfig = LockDownConfig + { lockingFile = lockingfiles + , hardlinkFileTmp = True + } (pending', cleanup) <- if unlocked || direct then return (pending, noop) else findnew pending (postponed, toadd) <- partitionEithers - <$> safeToAdd lockingfiles havelsof delayadd pending' inprocess + <$> safeToAdd lockdownconfig havelsof delayadd pending' inprocess cleanup unless (null postponed) $ @@ -283,7 +287,7 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do catMaybes <$> if not lockingfiles then addunlocked direct toadd - else forM toadd (add lockingfiles) + else forM toadd (add lockdownconfig) if DirWatcher.eventsCoalesce || null added || unlocked || direct then return $ added ++ otherchanges else do @@ -310,15 +314,15 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do | c = return otherchanges | otherwise = a - add :: Bool -> Change -> Assistant (Maybe Change) - add lockingfile change@(InProcessAddChange { lockedDown = ld }) = + add :: LockDownConfig -> Change -> Assistant (Maybe Change) + add lockdownconfig 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 $ LockedDown lockingfile ks + ingest $ Just $ LockedDown lockdownconfig ks maybe (failedingest change) (done change mcache $ keyFilename ks) mkey add _ _ = return Nothing @@ -332,15 +336,19 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do ct <- liftAnnex compareInodeCachesWith m <- liftAnnex $ removedKeysMap isdirect ct cs delta <- liftAnnex getTSDelta + let cfg = LockDownConfig + { lockingFile = False + , hardlinkFileTmp = True + } if M.null m - then forM toadd (add False) + then forM toadd (add cfg) else forM toadd $ \c -> do mcache <- liftIO $ genInodeCache (changeFile c) delta case mcache of - Nothing -> add False c + Nothing -> add cfg c Just cache -> case M.lookup (inodeCacheToKey ct cache) m of - Nothing -> add False c + Nothing -> add cfg c Just k -> fastadd isdirect c k fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change) @@ -416,12 +424,12 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do - - Check by running lsof on the repository. -} -safeToAdd :: Bool -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change] +safeToAdd :: LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change] safeToAdd _ _ _ [] [] = return [] -safeToAdd lockingfiles havelsof delayadd pending inprocess = do +safeToAdd lockdownconfig havelsof delayadd pending inprocess = do maybe noop (liftIO . threadDelaySeconds) delayadd liftAnnex $ do - lockeddown <- forM pending $ lockDown lockingfiles . changeFile + lockeddown <- forM pending $ lockDown lockdownconfig . changeFile let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending lockeddown) openfiles <- if havelsof then S.fromList . map fst3 . filter openwrite <$> diff --git a/Command/Add.hs b/Command/Add.hs index 8a7db0a91..b88dc52f7 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -115,7 +115,11 @@ start file = ifAnnexed file addpresent add perform :: FilePath -> CommandPerform perform file = do lockingfile <- not <$> isDirect - lockDown lockingfile file >>= ingest >>= go + let cfg = LockDownConfig + { lockingFile = lockingfile + , hardlinkFileTmp = True + } + lockDown cfg file >>= ingest >>= go where go (Just key, cache) = next $ cleanup file key cache True go (Nothing, _) = stop diff --git a/Command/Smudge.hs b/Command/Smudge.hs index 8b7d848d2..1ca3de2c3 100644 --- a/Command/Smudge.hs +++ b/Command/Smudge.hs @@ -72,7 +72,7 @@ clean file = do then liftIO $ B.hPut stdout b else ifM (shouldAnnex file) ( liftIO . emitPointer - =<< go =<< ingest =<< lockDown False file + =<< go =<< ingest =<< lockDown cfg file , liftIO $ B.hPut stdout b ) stop @@ -81,6 +81,10 @@ clean file = do logStatus k InfoPresent return k go _ = error "could not add file to the annex" + cfg = LockDownConfig + { lockingFile = False + , hardlinkFileTmp = False + } shouldAnnex :: FilePath -> Annex Bool shouldAnnex file = do |