summaryrefslogtreecommitdiff
path: root/Command/Add.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Command/Add.hs')
-rw-r--r--Command/Add.hs88
1 files changed, 49 insertions, 39 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index 245ca2bd6..9f1beb28a 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -23,10 +23,11 @@ import Annex.Perms
import Annex.Link
import qualified Annex
import qualified Annex.Queue
+#ifdef WITH_CLIBS
#ifndef __ANDROID__
import Utility.Touch
#endif
-import Utility.FileMode
+#endif
import Config
import Utility.InodeCache
import Annex.FileMatcher
@@ -77,7 +78,7 @@ start file = ifAnnexed file addpresent add
-- is present but not yet added to git
showStart "add" file
liftIO $ removeFile file
- next $ next $ cleanup file key =<< inAnnex key
+ next $ next $ cleanup file key Nothing =<< inAnnex key
{- The file that's being added is locked down before a key is generated,
- to prevent it from being modified in between. This lock down is not
@@ -86,11 +87,6 @@ start file = ifAnnexed file addpresent add
- 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.
-
- - 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. This is not done in direct mode,
- - because files there need to remain writable at all times.
- -
- 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.
@@ -98,24 +94,36 @@ start file = ifAnnexed file addpresent add
- Lockdown can fail if a file gets deleted, and Nothing will be returned.
-}
lockDown :: FilePath -> Annex (Maybe KeySource)
-lockDown file = ifM (crippledFileSystem)
+lockDown file = ifM crippledFileSystem
( liftIO $ catchMaybeIO nohardlink
, do
tmp <- fromRepo gitAnnexTmpDir
createAnnexDirectory tmp
- unlessM (isDirect) $ liftIO $
- void $ tryIO $ preventWrite file
- liftIO $ catchMaybeIO $ do
+ eitherToMaybe <$> tryAnnexIO (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 $
+ freezeContent file
+ liftIO $ do
(tmpfile, h) <- openTempFile tmp $
relatedTemplate $ takeFileName file
hClose h
nukeFile tmpfile
withhardlink tmpfile `catchIO` const nohardlink
- )
- where
nohardlink = do
cache <- genInodeCache file
- return $ KeySource
+ return KeySource
{ keyFilename = file
, contentLocation = file
, inodeCache = cache
@@ -123,7 +131,7 @@ lockDown file = ifM (crippledFileSystem)
withhardlink tmpfile = do
createLink file tmpfile
cache <- genInodeCache tmpfile
- return $ KeySource
+ return KeySource
{ keyFilename = file
, contentLocation = tmpfile
, inodeCache = cache
@@ -134,8 +142,8 @@ lockDown file = ifM (crippledFileSystem)
- In direct mode, leaves the file alone, and just updates bookkeeping
- information.
-}
-ingest :: (Maybe KeySource) -> Annex (Maybe Key)
-ingest Nothing = return Nothing
+ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache)
+ingest Nothing = return (Nothing, Nothing)
ingest (Just source) = do
backend <- chooseBackend $ keyFilename source
k <- genKey source backend
@@ -147,24 +155,24 @@ ingest (Just source) = do
where
go k cache = ifM isDirect ( godirect k cache , goindirect k cache )
- goindirect (Just (key, _)) _ = do
+ goindirect (Just (key, _)) mcache = do
catchAnnex (moveAnnex key $ contentLocation source)
(undo (keyFilename source) key)
liftIO $ nukeFile $ keyFilename source
- return $ Just key
+ return $ (Just key, mcache)
goindirect Nothing _ = failure "failed to generate a key"
godirect (Just (key, _)) (Just cache) = do
addInodeCache key cache
finishIngestDirect key source
- return $ Just key
+ return $ (Just key, Just cache)
godirect _ _ = failure "failed to generate a key"
failure msg = do
warning $ keyFilename source ++ " " ++ msg
when (contentLocation source /= keyFilename source) $
liftIO $ nukeFile $ contentLocation source
- return Nothing
+ return (Nothing, Nothing)
finishIngestDirect :: Key -> KeySource -> Annex ()
finishIngestDirect key source = do
@@ -178,9 +186,10 @@ finishIngestDirect key source = do
addContentWhenNotPresent key (keyFilename source)
perform :: FilePath -> CommandPerform
-perform file =
- maybe stop (\key -> next $ cleanup file key True)
- =<< ingest =<< lockDown file
+perform file = lockDown file >>= ingest >>= go
+ where
+ go (Just key, cache) = next $ cleanup file key cache True
+ go (Nothing, _) = stop
{- 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. -}
@@ -199,18 +208,19 @@ undo file key e = do
liftIO $ moveFile src file
{- Creates the symlink to the annexed content, returns the link target. -}
-link :: FilePath -> Key -> Bool -> Annex String
-link file key hascontent = flip catchAnnex (undo file key) $ do
+link :: FilePath -> Key -> Maybe InodeCache -> Annex String
+link file key mcache = flip catchAnnex (undo file key) $ do
l <- inRepo $ gitAnnexLink file key
replaceFile file $ makeAnnexLink l
+#ifdef WITH_CLIBS
#ifndef __ANDROID__
- when hascontent $ do
- -- touch the symlink to have the same mtime as the
- -- file it points to
- liftIO $ do
- mtime <- modificationTime <$> getFileStatus file
- touch file (TimeSpec mtime) False
+ -- touch symlink to have same time as the original file,
+ -- as provided in the InodeCache
+ case mcache of
+ Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
+ Nothing -> noop
+#endif
#endif
return l
@@ -224,28 +234,28 @@ link file key hascontent = flip catchAnnex (undo file key) $ do
- Also, using git add allows it to skip gitignored files, unless forced
- to include them.
-}
-addLink :: FilePath -> Key -> Bool -> Annex ()
-addLink file key hascontent = ifM (coreSymlinks <$> Annex.getGitConfig)
+addLink :: FilePath -> Key -> Maybe InodeCache -> Annex ()
+addLink file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)
( do
- _ <- link file key hascontent
+ _ <- link file key mcache
params <- ifM (Annex.getState Annex.force)
( return [Param "-f"]
, return []
)
Annex.Queue.addCommand "add" (params++[Param "--"]) [file]
, do
- l <- link file key hascontent
+ l <- link file key mcache
addAnnexLink l file
)
-cleanup :: FilePath -> Key -> Bool -> CommandCleanup
-cleanup file key hascontent = do
+cleanup :: FilePath -> Key -> Maybe InodeCache -> Bool -> CommandCleanup
+cleanup file key mcache hascontent = do
when hascontent $
logStatus key InfoPresent
ifM (isDirect <&&> pure hascontent)
( do
l <- inRepo $ gitAnnexLink file key
stageSymlink file =<< hashSymlink l
- , addLink file key hascontent
+ , addLink file key mcache
)
return True