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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Move where
import Control.Monad.State (liftIO)
import Command
import qualified Command.Drop
import qualified Annex
import LocationLog
import Types
import Content
import qualified GitRepo as Git
import qualified Remotes
import UUID
import Messages
import Utility
command :: [Command]
command = [Command "move" paramPath seek
"move content of files to/from another repository"]
seek :: [CommandSeek]
seek = [withFilesInGit $ start True]
{- Move (or copy) a file either --to or --from a repository.
-
- This only operates on the cached file content; it does not involve
- moving data in the key-value backend. -}
start :: Bool -> CommandStartString
start move file = do
fromName <- Annex.flagGet "fromrepository"
toName <- Annex.flagGet "torepository"
case (fromName, toName) of
("", "") -> error "specify either --from or --to"
("", _) -> toStart move file
(_ , "") -> fromStart move file
(_ , _) -> error "only one of --from or --to can be specified"
showAction :: Bool -> FilePath -> Annex ()
showAction True file = showStart "move" file
showAction False file = showStart "copy" file
remoteHasKey :: Git.Repo -> Key -> Bool -> Annex ()
remoteHasKey remote key present = do
g <- Annex.gitRepo
remoteuuid <- getUUID remote
logfile <- liftIO $ logChange g key remoteuuid status
Annex.queue "add" ["--"] logfile
where
status = if present then ValuePresent else ValueMissing
{- Moves (or copies) the content of an annexed file to another repository,
- and updates locationlog information on both.
-
- When moving, if the destination already has the content, it is
- still removed from the current repository.
-
- Note that unlike drop, this does not honor annex.numcopies.
- A file's content can be moved even if there are insufficient copies to
- allow it to be dropped.
-}
toStart :: Bool -> CommandStartString
toStart move file = isAnnexed file $ \(key, _) -> do
ishere <- inAnnex key
if not ishere
then return Nothing -- not here, so nothing to do
else do
showAction move file
return $ Just $ toPerform move key
toPerform :: Bool -> Key -> CommandPerform
toPerform move key = do
Remotes.readConfigs
-- checking the remote is expensive, so not done in the start step
remote <- Remotes.commandLineRemote
isthere <- Remotes.inAnnex remote key
case isthere of
Left err -> do
showNote $ show err
return Nothing
Right False -> do
showNote $ "to " ++ Git.repoDescribe remote ++ "..."
ok <- Remotes.copyToRemote remote key
if ok
then return $ Just $ toCleanup move remote key
else return Nothing -- failed
Right True -> return $ Just $ toCleanup move remote key
toCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup
toCleanup move remote key = do
remoteHasKey remote key True
if move
then Command.Drop.cleanup key
else return True
{- Moves (or copies) the content of an annexed file from another repository
- to the current repository and updates locationlog information on both.
-
- If the current repository already has the content, it is still removed
- from the other repository when moving.
-}
fromStart :: Bool -> CommandStartString
fromStart move file = isAnnexed file $ \(key, _) -> do
remote <- Remotes.commandLineRemote
(trusted, untrusted, _) <- Remotes.keyPossibilities key
if null $ filter (\r -> Remotes.same r remote) (trusted ++ untrusted)
then return Nothing
else do
showAction move file
return $ Just $ fromPerform move key
fromPerform :: Bool -> Key -> CommandPerform
fromPerform move key = do
remote <- Remotes.commandLineRemote
ishere <- inAnnex key
if ishere
then return $ Just $ fromCleanup move remote key
else do
showNote $ "from " ++ Git.repoDescribe remote ++ "..."
ok <- getViaTmp key $ Remotes.copyFromRemote remote key
if ok
then return $ Just $ fromCleanup move remote key
else return Nothing -- fail
fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup
fromCleanup True remote key = do
ok <- Remotes.onRemote remote (boolSystem, False) "dropkey"
["--quiet", "--force",
"--backend=" ++ backendName key,
keyName key]
-- better safe than sorry: assume the remote dropped the key
-- even if it seemed to fail; the failure could have occurred
-- after it really dropped it
remoteHasKey remote key False
return ok
fromCleanup False _ _ = return True
|