121f5d5b0c
Decided it's too scary to make v6 unlocked files have 1 copy by default, but that should be available to those who need it. This is consistent with git-annex not dropping unused content without --force, etc. * Added annex.thin setting, which makes unlocked files in v6 repositories be hard linked to their content, instead of a copy. This saves disk space but means any modification of an unlocked file will lose the local (and possibly only) copy of the old version. * Enable annex.thin by default on upgrade from direct mode to v6, since direct mode made the same tradeoff. * fix: Adjusts unlocked files as configured by annex.thin.
118 lines
3.3 KiB
Haskell
118 lines
3.3 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010,2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Lock where
|
|
|
|
import Common.Annex
|
|
import Command
|
|
import qualified Annex.Queue
|
|
import qualified Annex
|
|
import Annex.Version
|
|
import Annex.Content
|
|
import Annex.Link
|
|
import Annex.InodeSentinal
|
|
import Annex.Perms
|
|
import Annex.ReplaceFile
|
|
import Utility.InodeCache
|
|
import qualified Database.Keys
|
|
import Annex.Ingest
|
|
import Logs.Location
|
|
|
|
cmd :: Command
|
|
cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
|
|
command "lock" SectionCommon
|
|
"undo unlock command"
|
|
paramPaths (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek ps = ifM versionSupportsUnlockedPointers
|
|
( withFilesInGit (whenAnnexed startNew) ps
|
|
, do
|
|
withFilesOldUnlocked startOld ps
|
|
withFilesOldUnlockedToBeCommitted startOld ps
|
|
)
|
|
|
|
startNew :: FilePath -> Key -> CommandStart
|
|
startNew file key = ifM (isJust <$> isAnnexLink file)
|
|
( stop
|
|
, do
|
|
showStart "lock" 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
|
|
|
|
performNew :: FilePath -> Key -> Bool -> CommandPerform
|
|
performNew file key filemodified = do
|
|
lockdown =<< calcRepo (gitAnnexLocation key)
|
|
addLink file key
|
|
=<< withTSDelta (liftIO . genInodeCache file)
|
|
next $ cleanupNew file key
|
|
where
|
|
lockdown obj = do
|
|
ifM (catchBoolIO $ sameInodeCache obj =<< Database.Keys.getInodeCaches key)
|
|
( breakhardlink obj
|
|
, repopulate obj
|
|
)
|
|
whenM (liftIO $ doesFileExist obj) $
|
|
freezeContent obj
|
|
|
|
-- It's ok if the file is hard linked to obj, but if some other
|
|
-- associated file is, we need to break that link to lock down obj.
|
|
breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (getFileStatus obj)) $ do
|
|
mfc <- withTSDelta (liftIO . genInodeCache file)
|
|
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
|
|
modifyContent obj $ replaceFile obj $ \tmp -> do
|
|
unlessM (checkedCopyFile key obj tmp) $
|
|
error "unable to lock file"
|
|
Database.Keys.storeInodeCaches key [obj]
|
|
|
|
-- Try to repopulate obj from an unmodified associated file.
|
|
repopulate obj
|
|
| filemodified = modifyContent obj $ do
|
|
fs <- Database.Keys.getAssociatedFiles key
|
|
mfile <- firstM (isUnmodified key) fs
|
|
liftIO $ nukeFile obj
|
|
case mfile of
|
|
Just unmodified ->
|
|
unlessM (checkedCopyFile key unmodified obj)
|
|
lostcontent
|
|
Nothing -> lostcontent
|
|
| otherwise = modifyContent obj $
|
|
liftIO $ renameFile file obj
|
|
lostcontent = logStatus key InfoMissing
|
|
|
|
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
|
|
|
|
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)"
|