dirKeys,
withObjectLoc,
staleKeysPrune,
+ isUnmodified,
) where
import System.IO.Unsafe (unsafeInterleaveIO)
remove file = cleanObjectLoc key $ do
secureErase file
liftIO $ nukeFile file
- mapM_ (void . tryIO . resetPointerFile key)
+ mapM_ (void . tryIO . resetpointer)
=<< Database.Keys.getAssociatedFiles key
Database.Keys.removeInodeCaches key
Direct.removeInodeCache key
+ resetpointer file = ifM (isUnmodified key file)
+ ( do
+ secureErase file
+ liftIO $ nukeFile file
+ liftIO $ writeFile file (formatPointer key)
+ -- Can't delete the pointer file.
+ -- If it was a hard link to the annex object,
+ -- that object might have been frozen as part of the
+ -- removal process, so thaw it.
+ , void $ tryIO $ thawContent file
+ )
removedirect fs = do
cache <- Direct.recordedInodeCache key
Direct.removeInodeCache key
secureErase f
replaceFile f $ makeAnnexLink l
-{- To safely reset a pointer file, it has to be the unmodified content of
- - the key. The expensive way to tell is to do a verification of its content.
+{- Check if a file contains the unmodified content of the key.
+ -
+ - The expensive way to tell is to do a verification of its content.
- The cheaper way is to see if the InodeCache for the key matches the
- file. -}
-resetPointerFile :: Key -> FilePath -> Annex ()
-resetPointerFile key f = go =<< geti
+isUnmodified :: Key -> FilePath -> Annex Bool
+isUnmodified key f = go =<< geti
where
- go Nothing = noop
- go (Just fc) = ifM (cheapcheck fc <||> expensivecheck fc)
- ( do
- secureErase f
- liftIO $ nukeFile f
- liftIO $ writeFile f (formatPointer key)
- -- Can't delete the pointer file.
- -- If it was a hard link to the annex object,
- -- that object might have been frozen as part of the
- -- removal process, so thaw it.
- , thawContent f
- )
+ go Nothing = return False
+ go (Just fc) = cheapcheck fc <||> expensivecheck fc
cheapcheck fc = anyM (compareInodeCaches fc)
=<< Database.Keys.getInodeCaches key
expensivecheck fc = ifM (verifyKeyContent AlwaysVerify Types.Remote.UnVerified key f)
{- git-annex command
-
- - Copyright 2010 Joey Hess <id@joeyh.name>
+ - Copyright 2010,2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
import Command
import qualified Annex.Queue
import qualified Annex
+import Annex.Version
+import Annex.Content
+import Annex.Link
+import Annex.InodeSentinal
+import Utility.InodeCache
+import qualified Database.Keys
+import qualified Command.Add
cmd :: Command
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek
-seek ps = do
- withFilesUnlocked start ps
- withFilesUnlockedToBeCommitted start ps
+seek ps = ifM versionSupportsUnlockedPointers
+ ( withFilesInGit (whenAnnexed startNew) ps
+ , do
+ withFilesUnlocked startOld ps
+ withFilesUnlockedToBeCommitted startOld ps
+ )
-start :: FilePath -> CommandStart
-start file = do
+startNew :: FilePath -> Key -> CommandStart
+startNew file key = do
showStart "lock" file
- unlessM (Annex.getState Annex.force) $
- error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
- next $ perform file
+ go =<< isPointerFile file
+ where
+ go (Just key')
+ | key' == key = cont False
+ | otherwise = errorModified
+ go Nothing =
+ ifM (isUnmodified key file)
+ ( cont False
+ , ifM (Annex.getState Annex.force)
+ ( cont True
+ , errorModified
+ )
+ )
+ cont = next . performNew file key
-perform :: FilePath -> CommandPerform
-perform file = do
+performNew :: FilePath -> Key -> Bool -> CommandPerform
+performNew file key filemodified = do
+ -- If other files use this same key, and are unlocked,
+ -- the annex object file might be hard linked to those files.
+ -- It's also possible that the annex object file was
+ -- modified while the file was unlocked.
+ --
+ -- So, in order to lock the file's content, we need to break all
+ -- hard links to the annex object file, and if it's modified,
+ -- replace it with a copy of the content of one of the associated
+ -- files.
+ --
+ -- When the file being locked is unmodified, the annex object file
+ -- can just be linked to it. (Which might already be the case, but
+ -- do it again to be sure.)
+ --
+ -- When the file being locked is modified, find another associated
+ -- file that is unmodified, and copy it to the annex object file.
+ -- If there are no unmodified associated files, the content of
+ -- the key is lost.
+ --
+ -- If the filesystem doesn't support hard links, none of this
+ -- is a concern.
+ obj <- calcRepo (gitAnnexLocation key)
+
+ freezeContent obj
+ Command.Add.addLink file key
+ =<< withTSDelta (liftIO . genInodeCache file)
+ next $ cleanupNew file key
+
+cleanupNew :: FilePath -> Key -> CommandCleanup
+cleanupNew file key = do
+ Database.Keys.removeAssociatedFile key file
+ return True
+
+startOld :: FilePath -> CommandStart
+startOld file = do
+ showStart "lock" file
+ unlessM (Annex.getState Annex.force)
+ errorModified
+ next $ performOld file
+
+performOld :: FilePath -> CommandPerform
+performOld file = do
Annex.Queue.addCommand "checkout" [Param "--"] [file]
- next $ return True -- no cleanup needed
+ next $ return True
+
+errorModified :: a
+errorModified = error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
projects / git-annex.git / commitdiff