blob: 44b92545c84abcebaa6f4ababf60b9328e3d45ce (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{- 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!"
|
