ensure that direct mode file is not modified while generating its key
This commit is contained in:
parent
c0ffa8f6f0
commit
92287f6905
1 changed files with 23 additions and 11 deletions
|
@ -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 =
|
||||||
|
|
Loading…
Reference in a new issue