git-annex/Command/Get.hs

123 lines
3.9 KiB
Haskell
Raw Normal View History

{- 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
2015-04-30 18:02:56 +00:00
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)
2015-07-09 20:05:45 +00:00
data GetOptions = GetOptions
{ getFiles :: CmdParams
, getFrom :: Maybe (DeferredParse Remote)
, autoMode :: Bool
, keyOptions :: Maybe KeyOptions
2016-07-05 12:56:23 +00:00
, batchOption :: BatchMode
2015-07-09 20:05:45 +00:00
}
2013-07-03 17:55:50 +00:00
2015-07-09 20:05:45 +00:00
optParser :: CmdParamsDesc -> Parser GetOptions
optParser desc = GetOptions
<$> cmdParams desc
<*> optional (mkParseRemoteOption <$> parseFromOption)
2015-07-09 20:05:45 +00:00
<*> parseAutoOption
<*> optional (parseIncompleteOption <|> parseKeyOptions <|> parseFailedTransfersOption)
<*> parseBatchOption True
2015-07-09 20:05:45 +00:00
seek :: GetOptions -> CommandSeek
seek o = startConcurrency transferStages $ do
2015-07-09 20:05:45 +00:00
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
let seeker = AnnexedFileSeeker
{ startAction = const $ start o from
, checkContentPresent = Just False
, usesLocationLog = True
}
2016-07-05 12:56:23 +00:00
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 "get"
2010-11-11 22:54:52 +00:00
start :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
start o from si file key = start' expensivecheck from key afile ai si
2013-07-03 17:55:50 +00:00
where
afile = AssociatedFile (Just file)
2019-06-06 16:53:24 +00:00
ai = mkActionItem (key, afile)
expensivecheck
| autoMode o = numCopiesCheck file key (<)
<||> wantGet False (Just key) afile
| otherwise = return True
2013-07-03 17:55:50 +00:00
startKeys :: Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys from (si, key, ai) = checkFailedTransferDirection ai Download $
start' (return True) from key (AssociatedFile Nothing) ai si
2013-07-03 17:55:50 +00:00
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
start' expensivecheck from key afile ai si =
stopUnless expensivecheck $
case from of
2013-07-03 17:55:50 +00:00
Nothing -> go $ perform key afile
2012-06-12 15:32:06 +00:00
Just src ->
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src Command.Move.RemoveNever key afile
2012-11-12 05:05:04 +00:00
where
go = starting "get" (OnlyActionOn key ai) si
2013-07-03 17:55:50 +00:00
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 (Remote.IncludeIgnored False) key
getKey' :: Key -> AssociatedFile -> [Remote] -> Annex Bool
getKey' key afile = dispatch
2012-11-12 05:05:04 +00:00
where
dispatch [] = do
showNote (UnquotedString "not available")
showlocs []
2012-11-12 05:05:04 +00:00
return False
dispatch remotes = notifyTransfer Download afile $ \witness -> do
ok <- pickRemote remotes $ \r -> ifM (probablyPresent r)
( docopy r witness
, return False
2012-11-12 05:05:04 +00:00
)
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."
2012-11-12 05:05:04 +00:00
-- 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 $ UnquotedString $ "from " ++ Remote.name r
logStatusAfter key $
download r key afile stdRetry witness