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
|
{- git-annex command
-
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.Get where
import Command
import qualified Remote
import Annex.Transfer
import Annex.NumCopies
import Annex.Wanted
import qualified Command.Move
import Logs.Location
cmd :: Command
cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $
command "get" SectionCommon
"make content of annexed files available"
paramPaths (seek <$$> optParser)
data GetOptions = GetOptions
{ getFiles :: CmdParams
, getFrom :: Maybe (DeferredParse Remote)
, autoMode :: Bool
, keyOptions :: Maybe KeyOptions
, batchOption :: BatchMode
}
optParser :: CmdParamsDesc -> Parser GetOptions
optParser desc = GetOptions
<$> cmdParams desc
<*> optional (parseRemoteOption <$> parseFromOption)
<*> parseAutoOption
<*> optional (parseIncompleteOption <|> parseKeyOptions <|> parseFailedTransfersOption)
<*> parseBatchOption True
seek :: GetOptions -> CommandSeek
seek o = startConcurrency transferStages $ do
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
let seeker = AnnexedFileSeeker
{ startAction = start o from
, checkContentPresent = Just False
, usesLocationLog = True
}
case batchOption o of
NoBatch -> withKeyOptions (keyOptions o) (autoMode o) seeker
(commandAction . startKeys from)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (getFiles o)
Batch fmt -> batchOnly (keyOptions o) (getFiles o) $
batchAnnexed fmt seeker (startKeys from)
where
ww = WarnUnmatchLsFiles
start :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
start o from si file key = start' expensivecheck from key afile ai si
where
afile = AssociatedFile (Just file)
ai = mkActionItem (key, afile)
expensivecheck
| autoMode o = numCopiesCheck file key (<)
<||> wantGet False (Just key) afile
| otherwise = return True
startKeys :: Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys from (si, key, ai) = checkFailedTransferDirection ai Download $
start' (return True) from key (AssociatedFile Nothing) ai si
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
start' expensivecheck from key afile ai si =
stopUnless expensivecheck $
case from of
Nothing -> go $ perform key afile
Just src ->
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src Command.Move.RemoveNever key afile
where
go = starting "get" (OnlyActionOn key ai) si
perform :: Key -> AssociatedFile -> CommandPerform
perform key afile = stopUnless (getKey key afile) $
next $ return True -- no cleanup needed
{- Try to find a copy of the file in one of the remotes,
- and copy it to here. -}
getKey :: Key -> AssociatedFile -> Annex Bool
getKey key afile = getKey' key afile =<< Remote.keyPossibilities key
getKey' :: Key -> AssociatedFile -> [Remote] -> Annex Bool
getKey' key afile = dispatch
where
dispatch [] = do
showNote "not available"
showlocs []
return False
dispatch remotes = notifyTransfer Download afile $ \witness -> do
ok <- pickRemote remotes $ \r -> ifM (probablyPresent r)
( docopy r witness
, return False
)
if ok
then return ok
else do
Remote.showTriedRemotes remotes
showlocs (map Remote.uuid remotes)
return False
showlocs exclude = Remote.showLocations False key exclude
"No other repository is known to contain the file."
-- This check is to avoid an ugly message if a remote is a
-- drive that is not mounted.
probablyPresent r
| Remote.hasKeyCheap r =
either (const False) id <$> Remote.hasKey r key
| otherwise = return True
docopy r witness = do
showAction $ "from " ++ Remote.name r
logStatusAfter key $
download r key afile stdRetry witness
|