ensure that direct mode file is not modified while generating its key

This commit is contained in:
Joey Hess 2012-12-29 15:32:29 -04:00
parent c0ffa8f6f0
commit 92287f6905

View file

@ -73,24 +73,36 @@ lockDown file = do
ingest :: KeySource -> Annex (Maybe Key) ingest :: KeySource -> Annex (Maybe Key)
ingest source = do ingest source = do
backend <- chooseBackend $ keyFilename source backend <- chooseBackend $ keyFilename source
genKey source backend >>= go ifM isDirect
( do
mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus $ keyFilename source
k <- genKey source backend
godirect k (toCache =<< mstat)
, go =<< genKey source backend
)
where where
go Nothing = do
liftIO $ nukeFile $ contentLocation source
return Nothing
go (Just (key, _)) = do go (Just (key, _)) = do
ifM isDirect handle (undo (keyFilename source) key) $
moveAnnex key $ contentLocation source
liftIO $ nukeFile $ keyFilename source
return $ Just key
go Nothing = failure
godirect (Just (key, _)) (Just cache) =
ifM (compareCache (keyFilename source) $ Just cache)
( do ( do
updateCache key $ keyFilename source writeCache key cache
void $ addAssociatedFile key $ keyFilename source void $ addAssociatedFile key $ keyFilename source
liftIO $ allowWrite $ keyFilename source liftIO $ allowWrite $ keyFilename source
liftIO $ nukeFile $ contentLocation source liftIO $ nukeFile $ contentLocation source
, do return $ Just key
handle (undo (keyFilename source) key) $ , failure
moveAnnex key $ contentLocation source
liftIO $ nukeFile $ keyFilename source
) )
return $ Just key godirect _ _ = failure
failure = do
liftIO $ nukeFile $ contentLocation source
return Nothing
perform :: FilePath -> CommandPerform perform :: FilePath -> CommandPerform
perform file = perform file =