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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
{- git-annex command
-
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Move where
import Common.Annex
import Command
import qualified Command.Drop
import qualified Annex
import Annex.Content
import qualified Remote
import Annex.UUID
import Logs.Presence
import Logs.Transfer
def :: [Command]
def = [withOptions moveOptions $ command "move" paramPaths seek
SectionCommon "move content of files to/from another repository"]
moveOptions :: [Option]
moveOptions = fromToOptions ++ keyOptions
seek :: CommandSeek
seek ps = do
to <- getOptionField toOption Remote.byNameWithUUID
from <- getOptionField fromOption Remote.byNameWithUUID
withKeyOptions
(startKey to from True)
(withFilesInGit $ whenAnnexed $ start to from True)
ps
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
start to from move file (key, _) = start' to from move (Just file) key
startKey :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
startKey to from move = start' to from move Nothing
start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
start' to from move afile key = do
noAuto
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just dest) -> toStart dest move afile key
(Just src, Nothing) -> fromStart src move afile key
_ -> error "only one of --from or --to can be specified"
where
noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
"--auto is not supported for move"
showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
showMoveAction move = showStart' (if move then "move" else "copy")
{- Moves (or copies) the content of an annexed file to a remote.
-
- If the remote already has the content, it is still removed from
- the current repository.
-
- Note that unlike drop, this does not honor numcopies.
- A file's content can be moved even if there are insufficient copies to
- allow it to be dropped.
-}
toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
toStart dest move afile key = do
u <- getUUID
ishere <- inAnnex key
if not ishere || u == Remote.uuid dest
then stop -- not here, so nothing to do
else do
showMoveAction move key afile
next $ toPerform dest move key afile
toPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform
toPerform dest move key afile = moveLock move key $ do
-- Checking the remote is expensive, so not done in the start step.
-- In fast mode, location tracking is assumed to be correct,
-- and an explicit check is not done, when copying. When moving,
-- it has to be done, to avoid inaverdent data loss.
fast <- Annex.getState Annex.fast
let fastcheck = fast && not move && not (Remote.hasKeyCheap dest)
isthere <- if fastcheck
then Right <$> expectedpresent
else Remote.hasKey dest key
case isthere of
Left err -> do
showNote err
stop
Right False -> do
showAction $ "to " ++ Remote.name dest
ok <- upload (Remote.uuid dest) key afile noRetry $
Remote.storeKey dest key afile
if ok
then do
Remote.logStatus dest key InfoPresent
finish
else do
when fastcheck $
warning "This could have failed because --fast is enabled."
stop
Right True -> do
unlessM expectedpresent $
Remote.logStatus dest key InfoPresent
finish
where
finish
| move = do
removeAnnex key
next $ Command.Drop.cleanupLocal key
| otherwise = next $ return True
expectedpresent = do
remotes <- Remote.keyPossibilities key
return $ dest `elem` remotes
{- Moves (or copies) the content of an annexed file from a remote
- to the current repository.
-
- If the current repository already has the content, it is still removed
- from the remote.
-}
fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
fromStart src move afile key
| move = go
| otherwise = stopUnless (not <$> inAnnex key) go
where
go = stopUnless (fromOk src key) $ do
showMoveAction move key afile
next $ fromPerform src move key afile
fromOk :: Remote -> Key -> Annex Bool
fromOk src key = go =<< Annex.getState Annex.force
where
go True = either (const $ return True) return =<< haskey
go False
| Remote.hasKeyCheap src =
either (const expensive) return =<< haskey
| otherwise = expensive
haskey = Remote.hasKey src key
expensive = do
u <- getUUID
remotes <- Remote.keyPossibilities key
return $ u /= Remote.uuid src && elem src remotes
fromPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform
fromPerform src move key afile = moveLock move key $
ifM (inAnnex key)
( handle move True
, handle move =<< go
)
where
go = download (Remote.uuid src) key afile noRetry $ \p -> do
showAction $ "from " ++ Remote.name src
getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p
handle _ False = stop -- failed
handle False True = next $ return True -- copy complete
handle True True = do -- finish moving
ok <- Remote.removeKey src key
next $ Command.Drop.cleanupRemote key src ok
{- Locks a key in order for it to be moved.
- No lock is needed when a key is being copied. -}
moveLock :: Bool -> Key -> Annex a -> Annex a
moveLock True key a = lockContent key a
moveLock False _ a = a
|
