git-annex/Command/Unlock.hs

{- git-annex command
 -
 - Copyright 2010 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Command.Unlock where

import Control.Monad.State (liftIO)
import System.Directory hiding (copyFile)

import Command
import qualified Annex
import Types
import Messages
import Locations
import Content
import Utility.Conditional
import Utility.CopyFile
import Utility.Path
import Utility.FileMode

command :: [Command]
command =
	[ repoCommand "unlock" paramPaths seek "unlock files for modification"
	, repoCommand "edit" paramPaths seek "same as unlock"
	]

seek :: [CommandSeek]
seek = [withFilesInGit start]

{- The unlock subcommand replaces the symlink with a copy of the file's
 - content. -}
start :: FilePath -> CommandStart
start file = isAnnexed file $ \(key, _) -> do
	showStart "unlock" file
	next $ perform file key

perform :: FilePath -> Key -> CommandPerform
perform dest key = do
	unlessM (inAnnex key) $ error "content not present"
	
	checkDiskSpace key

	g <- Annex.gitRepo
	let src = gitAnnexLocation g key
	let tmpdest = gitAnnexTmpLocation g key
	liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
	showAction "copying"
	ok <- liftIO $ copyFile src tmpdest
        if ok
                then do
			liftIO $ do
				removeFile dest
				renameFile tmpdest dest
				allowWrite dest
			next $ return True
                else error "copy failed!"