git-annex/Command/Get.hs
Joey Hess e5fd8b67b7 get, move, copy: Now refuse to do anything when the requested file transfer is already in progress by another process.
Note this is per-remote, so trying to get the same file from multiple
remotes can still let duplicate downloads run. (And uploading the same file
to multiple remotes is not duplicate at all of course.)

get, move, and copy are the only git-annex subcommands that transfer
files, but there's still git-annex-shell recvkey and sendkey to deal with too.

I considered modifying retrieveKeyFile or getViaTmp, but they are called
by other code that does not involve expensive file transfers (migrate)
or that does file transfers that should not be checked by this (fsck --from).
2012-07-01 17:15:11 -04:00

71 lines
2 KiB
Haskell

{- git-annex command
-
- Copyright 2010 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 qualified Command.Move
import Logs.Transfer
def :: [Command]
def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
"make content of annexed files available"]
seek :: [CommandSeek]
seek = [withField Command.Move.fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = stopUnless (not <$> inAnnex key) $
autoCopies file key (<) $ \_numcopies ->
case from of
Nothing -> go $ perform key file
Just src ->
-- get --from = copy --from
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src False key file
where
go a = do
showStart "get" file
next a
perform :: Key -> FilePath -> CommandPerform
perform key file = stopUnless (getViaTmp key $ getKeyFile key file) $
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 -> FilePath -> FilePath -> Annex Bool
getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
where
dispatch [] = do
showNote "not available"
Remote.showLocations key []
return False
dispatch remotes = trycopy remotes remotes
trycopy full [] = do
Remote.showTriedRemotes full
Remote.showLocations key []
return False
trycopy full (r:rs) =
ifM (probablyPresent r)
( docopy r (trycopy full rs)
, trycopy full rs
)
-- 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 = download r key file $ do
showAction $ "from " ++ Remote.name r
ifM (Remote.retrieveKeyFile r key dest)
( return True , continue)