689d1fcc92
A few remain, as needed for upgrades, and for accessing objects from remotes that are direct mode repos that have not been converted yet.
103 lines
2.8 KiB
Haskell
103 lines
2.8 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010-2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Unlock where
|
|
|
|
import Command
|
|
import Annex.Content
|
|
import Annex.Perms
|
|
import Annex.CatFile
|
|
import Annex.Version
|
|
import Annex.Link
|
|
import Annex.ReplaceFile
|
|
import Utility.CopyFile
|
|
import Git.FilePath
|
|
import qualified Database.Keys
|
|
|
|
cmd :: Command
|
|
cmd = mkcmd "unlock" "unlock files for modification"
|
|
|
|
editcmd :: Command
|
|
editcmd = mkcmd "edit" "same as unlock"
|
|
|
|
mkcmd :: String -> String -> Command
|
|
mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $
|
|
command n SectionCommon d paramPaths (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems ps
|
|
|
|
{- Before v6, the unlock subcommand replaces the symlink with a copy of
|
|
- the file's content. In v6 and above, it converts the file from a symlink
|
|
- to a pointer. -}
|
|
start :: FilePath -> Key -> CommandStart
|
|
start file key = ifM (isJust <$> isAnnexLink file)
|
|
( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $
|
|
ifM versionSupportsUnlockedPointers
|
|
( performNew file key
|
|
, performOld file key
|
|
)
|
|
, stop
|
|
)
|
|
|
|
performNew :: FilePath -> Key -> CommandPerform
|
|
performNew dest key = do
|
|
destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus dest
|
|
replaceFile dest $ \tmp ->
|
|
ifM (inAnnex key)
|
|
( do
|
|
r <- linkFromAnnex key tmp destmode
|
|
case r of
|
|
LinkAnnexOk -> return ()
|
|
LinkAnnexNoop -> return ()
|
|
LinkAnnexFailed -> error "unlock failed"
|
|
, liftIO $ writePointerFile tmp key destmode
|
|
)
|
|
next $ cleanupNew dest key destmode
|
|
|
|
cleanupNew :: FilePath -> Key -> Maybe FileMode -> CommandCleanup
|
|
cleanupNew dest key destmode = do
|
|
stagePointerFile dest destmode =<< hashPointerFile key
|
|
Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest)
|
|
return True
|
|
|
|
performOld :: FilePath -> Key -> CommandPerform
|
|
performOld file key =
|
|
ifM (inAnnex key)
|
|
( ifM (isJust <$> catKeyFileHEAD file)
|
|
( performOld' file key
|
|
, do
|
|
warning "this has not yet been committed to git; cannot unlock it"
|
|
next $ return False
|
|
)
|
|
, do
|
|
warning "content not present; cannot unlock"
|
|
next $ return False
|
|
)
|
|
|
|
performOld' :: FilePath -> Key -> CommandPerform
|
|
performOld' dest key = ifM (checkDiskSpace Nothing key 0 True)
|
|
( do
|
|
src <- calcRepo $ gitAnnexLocation key
|
|
tmpdest <- fromRepo $ gitAnnexTmpObjectLocation key
|
|
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
|
|
showAction "copying"
|
|
ifM (liftIO $ copyFileExternal CopyAllMetaData src tmpdest)
|
|
( do
|
|
liftIO $ do
|
|
removeFile dest
|
|
moveFile tmpdest dest
|
|
thawContent dest
|
|
next $ return True
|
|
, do
|
|
warning "copy failed!"
|
|
next $ return False
|
|
)
|
|
, do
|
|
warning "not enough disk space to copy file"
|
|
next $ return False
|
|
)
|