git-annex/Command/Get.hs
Joey Hess 2fb3722ce9 Do verification of checksums of annex objects downloaded from remotes.
* When annex objects are received into git repositories, their checksums are
  verified then too.
* To get the old, faster, behavior of not verifying checksums, set
  annex.verify=false, or remote.<name>.annex-verify=false.
* setkey, rekey: These commands also now verify that the provided file
  matches the key, unless annex.verify=false.
* reinject: Already verified content; this can now be disabled by
  setting annex.verify=false.

recvkey and reinject already did verification, so removed now duplicate
code from them. fsck still does its own verification, which is ok since it
does not use getViaTmp, so verification doesn't happen twice when using fsck
--from.
2015-10-01 15:56:39 -04:00

109 lines
3.2 KiB
Haskell

{- git-annex command
-
- Copyright 2010, 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Get where
import Common.Annex
import Command
import qualified Remote
import Annex.Content
import Annex.Transfer
import Annex.NumCopies
import Annex.Wanted
import qualified Command.Move
cmd :: Command
cmd = withGlobalOptions (jobsOption : 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
}
optParser :: CmdParamsDesc -> Parser GetOptions
optParser desc = GetOptions
<$> cmdParams desc
<*> optional parseFromOption
<*> parseAutoOption
<*> optional (parseKeyOptions True)
seek :: GetOptions -> CommandSeek
seek o = do
from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
withKeyOptions (keyOptions o) (autoMode o)
(startKeys from)
(withFilesInGit $ whenAnnexed $ start o from)
(getFiles o)
start :: GetOptions -> Maybe Remote -> FilePath -> Key -> CommandStart
start o from file key = start' expensivecheck from key (Just file)
where
expensivecheck
| autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) (Just file)
| otherwise = return True
startKeys :: Maybe Remote -> Key -> CommandStart
startKeys from key = start' (return True) from key Nothing
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $
stopUnless expensivecheck $
case from of
Nothing -> go $ perform key afile
Just src ->
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src False key afile
where
go a = do
showStart' "get" key afile
next a
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 $ trycopy remotes remotes
trycopy full [] _ = do
Remote.showTriedRemotes full
showlocs
return False
trycopy full (r:rs) witness =
ifM (probablyPresent r)
( docopy r witness <||> trycopy full rs witness
, trycopy full rs witness
)
showlocs = Remote.showLocations False key []
"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 = getViaTmp (RemoteVerify r) key $ \dest ->
download (Remote.uuid r) key afile noRetry noObserver
(\p -> do
showAction $ "from " ++ Remote.name r
Remote.retrieveKeyFile r key afile dest p
) witness