git-annex/Command/Get.hs
Joey Hess b6ba0bd556 sync --content: New option that makes the content of annexed files be transferred.
Similar to the assistant, this honors any configured preferred content
expressions.

I am not entirely happpy with the implementation. It would be nicer if
the seek function returned a list of actions which included the individual
file gets and copies and drops, rather than the current list of calls to
syncContent. This would allow getting rid of the somewhat reundant display
of "sync file [ok|failed]" after the get/put display.

But, do that, withFilesInGit would need to somehow be able to construct
such a mixed action list. And it would be less efficient than the current
implementation, which is able to reuse several values between eg get and
drop.

Note that currently this does not try to satisfy numcopies when
getting/putting files (numcopies are of course checked when dropping
files!) This makes it like the assistant, and unlike get --auto
and copy --auto, which do duplicate files when numcopies is not yet
satisfied. I don't know if this is the right decision; it only seemed to
make sense to have this parallel the assistant as far as possible to start
with, since I know the assistant works.

This commit was sponsored by Øyvind Andersen Holm.
2014-01-19 17:49:54 -04:00

94 lines
2.8 KiB
Haskell

{- git-annex command
-
- Copyright 2010, 2013 Joey Hess <joey@kitenet.net>
-
- 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 Logs.Transfer
import Annex.Wanted
import GitAnnex.Options
import qualified Command.Move
import Types.Key
def :: [Command]
def = [withOptions getOptions $ command "get" paramPaths seek
SectionCommon "make content of annexed files available"]
getOptions :: [Option]
getOptions = fromOption : keyOptions
seek :: [CommandSeek]
seek =
[ withField fromOption Remote.byNameWithUUID $ \from ->
withKeyOptions (startKeys from) $
withFilesInGit $ whenAnnexed $ start from
]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = start' expensivecheck from key (Just file)
where
expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))
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" (fromMaybe (key2file key) afile)
next a
perform :: Key -> AssociatedFile -> CommandPerform
perform key afile = stopUnless (getViaTmp key $ getKeyFile 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. -}
getKeyFile :: Key -> AssociatedFile -> FilePath -> Annex Bool
getKeyFile key afile dest = getKeyFile' key afile dest
=<< Remote.keyPossibilities key
getKeyFile' :: Key -> AssociatedFile -> FilePath -> [Remote] -> Annex Bool
getKeyFile' key afile dest = dispatch
where
dispatch [] = do
showNote "not available"
showlocs
return False
dispatch remotes = trycopy remotes remotes
trycopy full [] = do
Remote.showTriedRemotes full
showlocs
return False
trycopy full (r:rs) =
ifM (probablyPresent r)
( docopy r (trycopy full rs)
, trycopy full rs
)
showlocs = Remote.showLocations 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 continue = do
ok <- download (Remote.uuid r) key afile noRetry $ \p -> do
showAction $ "from " ++ Remote.name r
Remote.retrieveKeyFile r key afile dest p
if ok then return ok else continue