summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-08-03 12:37:12 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-08-03 12:37:12 -0400
commit508517de485e77196a8d8e33558f4185c50dea96 (patch)
tree319fc6e63da144e40dd124a07f4bb6c0ad25c5ee
parent019733f00d01301d71acc46245d2dc130934d951 (diff)
get, move, copy, mirror: Added --failed switch which retries failed copies/moves
Note that get --from foo --failed will get things that a previous get --from bar tried and failed to get, etc. I considered making --failed only retry transfers from the same remote, but it was easier, and seems more useful, to not have the same remote requirement. Noisy due to some refactoring into Types/
-rw-r--r--Annex/Content.hs1
-rw-r--r--Annex/Notification.hs2
-rw-r--r--Annex/Transfer.hs1
-rw-r--r--Assistant/Alert.hs2
-rw-r--r--Assistant/DaemonStatus.hs1
-rw-r--r--Assistant/DeleteRemote.hs2
-rw-r--r--Assistant/Sync.hs2
-rw-r--r--Assistant/Threads/Committer.hs2
-rw-r--r--Assistant/Threads/Cronner.hs2
-rw-r--r--Assistant/Threads/Glacier.hs1
-rw-r--r--Assistant/Threads/SanityChecker.hs2
-rw-r--r--Assistant/Threads/TransferPoller.hs1
-rw-r--r--Assistant/Threads/TransferScanner.hs1
-rw-r--r--Assistant/Threads/TransferWatcher.hs1
-rw-r--r--Assistant/Threads/Transferrer.hs2
-rw-r--r--Assistant/TransferQueue.hs1
-rw-r--r--Assistant/TransferSlots.hs1
-rw-r--r--Assistant/TransferrerPool.hs2
-rw-r--r--Assistant/Types/DaemonStatus.hs2
-rw-r--r--Assistant/Types/TransferQueue.hs2
-rw-r--r--CHANGELOG2
-rw-r--r--CmdLine/GitAnnex/Options.hs49
-rw-r--r--CmdLine/Seek.hs21
-rw-r--r--Command.hs13
-rw-r--r--Command/Drop.hs2
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Command/Get.hs6
-rw-r--r--Command/Info.hs1
-rw-r--r--Command/MetaData.hs2
-rw-r--r--Command/Mirror.hs7
-rw-r--r--Command/Move.hs8
-rw-r--r--Command/RecvKey.hs2
-rw-r--r--Command/TransferInfo.hs1
-rw-r--r--Command/Whereis.hs2
-rw-r--r--Logs/Transfer.hs33
-rw-r--r--Messages.hs32
-rw-r--r--Remote/External.hs2
-rw-r--r--Remote/External/Types.hs2
-rw-r--r--Remote/GCrypt.hs2
-rw-r--r--Remote/Helper/Ssh.hs2
-rw-r--r--Remote/Rsync.hs2
-rw-r--r--Types/ActionItem.hs54
-rw-r--r--Types/Transfer.hs47
-rw-r--r--doc/git-annex-copy.mdwn4
-rw-r--r--doc/git-annex-get.mdwn14
-rw-r--r--doc/git-annex-mirror.mdwn8
-rw-r--r--doc/git-annex-move.mdwn4
-rw-r--r--doc/todo/__34__copy_--failed__34__.mdwn2
-rw-r--r--doc/todo/__34__copy_--failed__34__/comment_1_ff81023df39f9faac5935f6417ad2b38._comment8
-rw-r--r--doc/todo/make_copy_--fast__faster/comment_4_3ac10a07c74e5debafc9ae574d26c955._comment11
50 files changed, 251 insertions, 125 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 36d9db7e9..b975c8e90 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -54,6 +54,7 @@ import qualified Data.Set as S
import Annex.Common
import Logs.Location
+import Types.Transfer
import Logs.Transfer
import qualified Git
import qualified Annex
diff --git a/Annex/Notification.hs b/Annex/Notification.hs
index 691b61dd5..4f492878b 100644
--- a/Annex/Notification.hs
+++ b/Annex/Notification.hs
@@ -10,7 +10,7 @@
module Annex.Notification (NotifyWitness, notifyTransfer, notifyDrop) where
import Annex.Common
-import Logs.Transfer
+import Types.Transfer
#ifdef WITH_DBUS_NOTIFICATIONS
import qualified Annex
import Types.DesktopNotify
diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index 78ef0e502..55a8d39f7 100644
--- a/Annex/Transfer.hs
+++ b/Annex/Transfer.hs
@@ -20,6 +20,7 @@ module Annex.Transfer (
import Annex.Common
import Logs.Transfer as X
+import Types.Transfer as X
import Annex.Notification as X
import Annex.Perms
import Utility.Metered
diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index 265828dbb..bc79a70a8 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -14,7 +14,7 @@ import Assistant.Types.Alert
import Assistant.Alert.Utility
import qualified Remote
import Utility.Tense
-import Logs.Transfer
+import Types.Transfer
import Types.Distribution
import Git.Types (RemoteName)
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 92aad0735..3b2c6f3cd 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -14,6 +14,7 @@ import Assistant.Alert.Utility
import Utility.Tmp
import Assistant.Types.NetMessager
import Utility.NotificationBroadcaster
+import Types.Transfer
import Logs.Transfer
import Logs.Trust
import Logs.TimeStamp
diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs
index 5b044fd18..c69011e79 100644
--- a/Assistant/DeleteRemote.hs
+++ b/Assistant/DeleteRemote.hs
@@ -12,7 +12,7 @@ module Assistant.DeleteRemote where
import Assistant.Common
import Assistant.Types.UrlRenderer
import Assistant.TransferQueue
-import Logs.Transfer
+import Types.Transfer
import Logs.Location
import Assistant.DaemonStatus
import qualified Remote
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 665394a4d..9b9e7ebe5 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -36,7 +36,7 @@ import Assistant.Threads.Watcher (watchThread, WatcherControl(..))
import Assistant.TransferSlots
import Assistant.TransferQueue
import Assistant.RepoProblem
-import Logs.Transfer
+import Types.Transfer
import Data.Time.Clock
import qualified Data.Map as M
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index d35bd79a2..7b366bc0a 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -17,7 +17,7 @@ import Assistant.Alert
import Assistant.DaemonStatus
import Assistant.TransferQueue
import Assistant.Drop
-import Logs.Transfer
+import Types.Transfer
import Logs.Location
import qualified Annex.Queue
import qualified Git.LsFiles
diff --git a/Assistant/Threads/Cronner.hs b/Assistant/Threads/Cronner.hs
index 14026cfcc..0b505b8f2 100644
--- a/Assistant/Threads/Cronner.hs
+++ b/Assistant/Threads/Cronner.hs
@@ -24,7 +24,7 @@ import Utility.HumanTime
import Utility.Batch
import Assistant.TransferQueue
import Annex.Content
-import Logs.Transfer
+import Types.Transfer
import Assistant.Types.UrlRenderer
import Assistant.Alert
import Remote
diff --git a/Assistant/Threads/Glacier.hs b/Assistant/Threads/Glacier.hs
index 900e0d423..b5eaa5ea9 100644
--- a/Assistant/Threads/Glacier.hs
+++ b/Assistant/Threads/Glacier.hs
@@ -14,6 +14,7 @@ import Assistant.Common
import Utility.ThreadScheduler
import qualified Types.Remote as Remote
import qualified Remote.Glacier as Glacier
+import Types.Transfer
import Logs.Transfer
import Assistant.DaemonStatus
import Assistant.TransferQueue
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index a4f037f5a..62ba8f0d0 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -38,7 +38,7 @@ import Git.Repair
import Git.Index
import Assistant.Unused
import Logs.Unused
-import Logs.Transfer
+import Types.Transfer
import Annex.Path
import qualified Annex
#ifdef WITH_WEBAPP
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs
index 73562dbf7..f5d6890c8 100644
--- a/Assistant/Threads/TransferPoller.hs
+++ b/Assistant/Threads/TransferPoller.hs
@@ -9,6 +9,7 @@ module Assistant.Threads.TransferPoller where
import Assistant.Common
import Assistant.DaemonStatus
+import Types.Transfer
import Logs.Transfer
import Utility.NotificationBroadcaster
import qualified Assistant.Threads.TransferWatcher as TransferWatcher
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 7386d5528..10aed20b0 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -16,6 +16,7 @@ import Assistant.Drop
import Assistant.Sync
import Assistant.DeleteRemote
import Assistant.Types.UrlRenderer
+import Types.Transfer
import Logs.Transfer
import Logs.Location
import Logs.Group
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index c452d87c2..a04c6c01c 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -10,6 +10,7 @@ module Assistant.Threads.TransferWatcher where
import Assistant.Common
import Assistant.DaemonStatus
import Assistant.TransferSlots
+import Types.Transfer
import Logs.Transfer
import Utility.DirWatcher
import Utility.DirWatcher.Types
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 9e9256e3a..293ce41c2 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -10,7 +10,7 @@ module Assistant.Threads.Transferrer where
import Assistant.Common
import Assistant.TransferQueue
import Assistant.TransferSlots
-import Logs.Transfer
+import Types.Transfer
import Annex.Path
import Utility.Batch
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs
index ba13b3f04..8117d309c 100644
--- a/Assistant/TransferQueue.hs
+++ b/Assistant/TransferQueue.hs
@@ -26,6 +26,7 @@ module Assistant.TransferQueue (
import Assistant.Common
import Assistant.DaemonStatus
import Assistant.Types.TransferQueue
+import Types.Transfer
import Logs.Transfer
import Types.Remote
import qualified Remote
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 2ea09c419..25342f2b3 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -21,6 +21,7 @@ import Assistant.Alert
import Assistant.Alert.Utility
import Assistant.Commits
import Assistant.Drop
+import Types.Transfer
import Logs.Transfer
import Logs.Location
import qualified Git
diff --git a/Assistant/TransferrerPool.hs b/Assistant/TransferrerPool.hs
index 152625f4f..7c0cb4415 100644
--- a/Assistant/TransferrerPool.hs
+++ b/Assistant/TransferrerPool.hs
@@ -9,7 +9,7 @@ module Assistant.TransferrerPool where
import Assistant.Common
import Assistant.Types.TransferrerPool
-import Logs.Transfer
+import Types.Transfer
import Utility.Batch
import qualified Command.TransferKeys as T
diff --git a/Assistant/Types/DaemonStatus.hs b/Assistant/Types/DaemonStatus.hs
index d9259843b..8bb66261e 100644
--- a/Assistant/Types/DaemonStatus.hs
+++ b/Assistant/Types/DaemonStatus.hs
@@ -10,7 +10,7 @@ module Assistant.Types.DaemonStatus where
import Annex.Common
import Assistant.Pairing
import Utility.NotificationBroadcaster
-import Logs.Transfer
+import Types.Transfer
import Assistant.Types.ThreadName
import Assistant.Types.NetMessager
import Assistant.Types.Alert
diff --git a/Assistant/Types/TransferQueue.hs b/Assistant/Types/TransferQueue.hs
index ee9409a4b..7e2b4ce3b 100644
--- a/Assistant/Types/TransferQueue.hs
+++ b/Assistant/Types/TransferQueue.hs
@@ -8,7 +8,7 @@
module Assistant.Types.TransferQueue where
import Annex.Common
-import Logs.Transfer
+import Types.Transfer
import Control.Concurrent.STM
import Utility.TList
diff --git a/CHANGELOG b/CHANGELOG
index 8ee86b2dd..bb8705a39 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -20,6 +20,8 @@ git-annex (6.20160726) UNRELEASED; urgency=medium
not been added on uuid-1.3.12.)
* info: When run on a file now includes an indication of whether
the content is present locally.
+ * get, move, copy, mirror: Added --failed switch which retries
+ failed copies/moves.
-- Joey Hess <id@joeyh.name> Wed, 20 Jul 2016 12:03:15 -0400
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index db2efeda5..64f70d178 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -139,32 +139,37 @@ parseToOption = parseRemoteOption $ strOption
data KeyOptions
= WantAllKeys
| WantUnusedKeys
+ | WantFailedTransfers
| WantSpecificKey Key
| WantIncompleteKeys
| WantBranchKeys [Branch]
-parseKeyOptions :: Bool -> Parser KeyOptions
-parseKeyOptions allowincomplete = if allowincomplete
- then base
- <|> flag' WantIncompleteKeys
- ( long "incomplete"
- <> help "resume previous downloads"
- )
- else base
- where
- base = parseAllOption
- <|> WantBranchKeys <$> some (option (str >>= pure . Ref)
- ( long "branch" <> metavar paramRef
- <> help "operate on files in the specified branch or treeish"
- ))
- <|> flag' WantUnusedKeys
- ( long "unused" <> short 'U'
- <> help "operate on files found by last run of git-annex unused"
- )
- <|> (WantSpecificKey <$> option (str >>= parseKey)
- ( long "key" <> metavar paramKey
- <> help "operate on specified key"
- ))
+parseKeyOptions :: Parser KeyOptions
+parseKeyOptions = parseAllOption
+ <|> WantBranchKeys <$> some (option (str >>= pure . Ref)
+ ( long "branch" <> metavar paramRef
+ <> help "operate on files in the specified branch or treeish"
+ ))
+ <|> flag' WantUnusedKeys
+ ( long "unused" <> short 'U'
+ <> help "operate on files found by last run of git-annex unused"
+ )
+ <|> (WantSpecificKey <$> option (str >>= parseKey)
+ ( long "key" <> metavar paramKey
+ <> help "operate on specified key"
+ ))
+
+parseFailedTransfersOption :: Parser KeyOptions
+parseFailedTransfersOption = flag' WantFailedTransfers
+ ( long "failed"
+ <> help "operate on files that recently failed to be transferred"
+ )
+
+parseIncompleteOption :: Parser KeyOptions
+parseIncompleteOption = flag' WantIncompleteKeys
+ ( long "incomplete"
+ <> help "resume previous downloads"
+ )
parseAllOption :: Parser KeyOptions
parseAllOption = flag' WantAllKeys
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 56592349b..5d20ad0db 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -25,6 +25,10 @@ import CmdLine.GitAnnex.Options
import CmdLine.Action
import Logs.Location
import Logs.Unused
+import Types.Transfer
+import Logs.Transfer
+import Remote.List
+import qualified Remote
import Annex.CatFile
import Annex.Content
@@ -154,8 +158,9 @@ withNothing :: CommandStart -> CmdParams -> CommandSeek
withNothing a [] = seekActions $ return [a]
withNothing _ _ = error "This command takes no parameters."
-{- Handles the --all, --branch, --unused, --key, and --incomplete options,
- - which specify particular keys to run an action on.
+{- Handles the --all, --branch, --unused, --failed, --key, and
+ - --incomplete options, which specify particular keys to run an
+ - action on.
-
- In a bare repo, --all is the default.
-
@@ -180,8 +185,7 @@ withKeyOptions'
:: Maybe KeyOptions
-> Bool
-> Annex (Key -> ActionItem -> Annex ())
- -> (CmdParams
- -> CommandSeek)
+ -> (CmdParams -> CommandSeek)
-> CmdParams
-> CommandSeek
withKeyOptions' ko auto mkkeyaction fallbackaction params = do
@@ -195,10 +199,11 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
(False, Nothing) -> fallbackaction params
(True, Just WantAllKeys) -> noauto $ runkeyaction loggedKeys
(True, Just WantUnusedKeys) -> noauto $ runkeyaction unusedKeys'
+ (True, Just WantFailedTransfers) -> noauto runfailedtransfers
(True, Just (WantSpecificKey k)) -> noauto $ runkeyaction (return [k])
(True, Just WantIncompleteKeys) -> noauto $ runkeyaction incompletekeys
(True, Just (WantBranchKeys bs)) -> noauto $ runbranchkeys bs
- (False, Just _) -> error "Can only specify one of file names, --all, --branch, --unused, --key, or --incomplete"
+ (False, Just _) -> error "Can only specify one of file names, --all, --branch, --unused, --failed, --key, or --incomplete"
where
noauto a
| auto = error "Cannot use --auto with --all or --branch or --unused or --key or --incomplete"
@@ -218,6 +223,12 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
=<< catKey (LsTree.sha i)
unlessM (liftIO cleanup) $
error ("git ls-tree " ++ Git.fromRef b ++ " failed")
+ runfailedtransfers = do
+ keyaction <- mkkeyaction
+ rs <- remoteList
+ ts <- concat <$> mapM (getFailedTransfers . Remote.uuid) rs
+ forM_ ts $ \(t, i) ->
+ keyaction (transferKey t) (mkActionItem (t, i))
prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
prepFiltered a fs = do
diff --git a/Command.hs b/Command.hs
index 82c8b3cc1..4ffc7c319 100644
--- a/Command.hs
+++ b/Command.hs
@@ -1,6 +1,6 @@
{- git-annex command infrastructure
-
- - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -26,6 +26,8 @@ import qualified Git
import Annex.Init
import Config
import Utility.Daemon
+import Types.Transfer
+import Types.ActionItem
{- Generates a normal Command -}
command :: String -> CommandSection -> String -> CmdParamsDesc -> (CmdParamsDesc -> CommandParser) -> Command
@@ -91,6 +93,15 @@ stop = return Nothing
stopUnless :: Annex Bool -> Annex (Maybe a) -> Annex (Maybe a)
stopUnless c a = ifM c ( a , stop )
+{- When acting on a failed transfer, stops unless it was in the specified
+ - direction. -}
+checkFailedTransferDirection :: ActionItem -> Direction -> Annex (Maybe a) -> Annex (Maybe a)
+checkFailedTransferDirection ai d = stopUnless (pure check)
+ where
+ check = case actionItemTransferDirection ai of
+ Nothing -> True
+ Just d' -> d' == d
+
commonChecks :: [CommandCheck]
commonChecks = [repoExists]
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 79797ab02..129dce035 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -41,7 +41,7 @@ optParser desc = DropOptions
<$> cmdParams desc
<*> optional parseDropFromOption
<*> parseAutoOption
- <*> optional (parseKeyOptions False)
+ <*> optional parseKeyOptions
<*> parseBatchOption
parseDropFromOption :: Parser (DeferredParse Remote)
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 4972be649..b37a26e12 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -66,7 +66,7 @@ optParser desc = FsckOptions
<> completeRemotes
))
<*> optional parseincremental
- <*> optional (parseKeyOptions False)
+ <*> optional parseKeyOptions
where
parseincremental =
flag' StartIncrementalO
diff --git a/Command/Get.hs b/Command/Get.hs
index 3f461fa04..bd4891b92 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -14,6 +14,7 @@ import Annex.Transfer
import Annex.NumCopies
import Annex.Wanted
import qualified Command.Move
+import Types.ActionItem
cmd :: Command
cmd = withGlobalOptions (jobsOption : jsonOption : annexedMatchingOptions) $
@@ -34,7 +35,7 @@ optParser desc = GetOptions
<$> cmdParams desc
<*> optional parseFromOption
<*> parseAutoOption
- <*> optional (parseKeyOptions True)
+ <*> optional (parseIncompleteOption <|> parseKeyOptions <|> parseFailedTransfersOption)
<*> parseBatchOption
seek :: GetOptions -> CommandSeek
@@ -57,7 +58,8 @@ start o from file key = start' expensivecheck from key afile (mkActionItem afile
| otherwise = return True
startKeys :: Maybe Remote -> Key -> ActionItem -> CommandStart
-startKeys from key = start' (return True) from key Nothing
+startKeys from key ai = checkFailedTransferDirection ai Download $
+ start' (return True) from key Nothing ai
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> CommandStart
start' expensivecheck from key afile ai = stopUnless (not <$> inAnnex key) $
diff --git a/Command/Info.hs b/Command/Info.hs
index 39511e6d4..f8a13eb1c 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -32,6 +32,7 @@ import Remote
import Config
import Git.Config (boolConfig)
import Utility.Percentage
+import Types.Transfer
import Logs.Transfer
import Types.TrustLevel
import Types.FileMatcher
diff --git a/Command/MetaData.hs b/Command/MetaData.hs
index 4233c56a7..e3cf921cb 100644
--- a/Command/MetaData.hs
+++ b/Command/MetaData.hs
@@ -40,7 +40,7 @@ optParser :: CmdParamsDesc -> Parser MetaDataOptions
optParser desc = MetaDataOptions
<$> cmdParams desc
<*> ((Get <$> getopt) <|> (Set <$> some modopts) <|> pure GetAll)
- <*> optional (parseKeyOptions False)
+ <*> optional parseKeyOptions
<*> parseBatchOption
where
getopt = option (eitherReader mkMetaField)
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index 50aca0338..1c7b6e396 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -14,6 +14,7 @@ import qualified Command.Get
import qualified Remote
import Annex.Content
import Annex.NumCopies
+import Types.Transfer
cmd :: Command
cmd = withGlobalOptions ([jobsOption] ++ annexedMatchingOptions) $
@@ -31,7 +32,7 @@ optParser :: CmdParamsDesc -> Parser MirrorOptions
optParser desc = MirrorOptions
<$> cmdParams desc
<*> parseFromToOptions
- <*> optional (parseKeyOptions False)
+ <*> optional (parseKeyOptions <|> parseFailedTransfersOption)
instance DeferredParseClass MirrorOptions where
finishParse v = MirrorOptions
@@ -53,13 +54,13 @@ start o file k = startKey o afile k (mkActionItem afile)
startKey :: MirrorOptions -> Maybe FilePath -> Key -> ActionItem -> CommandStart
startKey o afile key ai = case fromToOptions o of
- ToRemote r -> ifM (inAnnex key)
+ ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key)
( Command.Move.toStart False afile key ai =<< getParsed r
, do
numcopies <- getnumcopies
Command.Drop.startRemote afile ai numcopies key =<< getParsed r
)
- FromRemote r -> do
+ FromRemote r -> checkFailedTransferDirection ai Download $ do
haskey <- flip Remote.hasKey key =<< getParsed r
case haskey of
Left _ -> stop
diff --git a/Command/Move.hs b/Command/Move.hs
index 88ca4e01d..bf2aa0a24 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -35,7 +35,7 @@ optParser :: CmdParamsDesc -> Parser MoveOptions
optParser desc = MoveOptions
<$> cmdParams desc
<*> parseFromToOptions
- <*> optional (parseKeyOptions False)
+ <*> optional (parseKeyOptions <|> parseFailedTransfersOption)
instance DeferredParseClass MoveOptions where
finishParse v = MoveOptions
@@ -61,8 +61,10 @@ startKey o move = start' o move Nothing
start' :: MoveOptions -> Bool -> AssociatedFile -> Key -> ActionItem -> CommandStart
start' o move afile key ai =
case fromToOptions o of
- FromRemote src -> fromStart move afile key ai =<< getParsed src
- ToRemote dest -> toStart move afile key ai =<< getParsed dest
+ FromRemote src -> checkFailedTransferDirection ai Download $
+ fromStart move afile key ai =<< getParsed src
+ ToRemote dest -> checkFailedTransferDirection ai Upload $
+ toStart move afile key ai =<< getParsed dest
showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
showMoveAction move = showStart' (if move then "move" else "copy")
diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index 5bd2d8b59..103db559b 100644
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -12,7 +12,7 @@ import Annex.Content
import Annex.Action
import Annex
import Utility.Rsync
-import Logs.Transfer
+import Types.Transfer
import Command.SendKey (fieldTransfer)
import qualified CmdLine.GitAnnexShell.Fields as Fields
diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs
index 4db3f8de3..21b7830c3 100644
--- a/Command/TransferInfo.hs
+++ b/Command/TransferInfo.hs
@@ -9,6 +9,7 @@ module Command.TransferInfo where
import Command
import Annex.Content
+import Types.Transfer
import Logs.Transfer
import qualified CmdLine.GitAnnexShell.Fields as Fields
import Utility.Metered
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index b91c31ca1..3a21e0a3b 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -31,7 +31,7 @@ data WhereisOptions = WhereisOptions
optParser :: CmdParamsDesc -> Parser WhereisOptions
optParser desc = WhereisOptions
<$> cmdParams desc
- <*> optional (parseKeyOptions False)
+ <*> optional parseKeyOptions
<*> parseBatchOption
seek :: WhereisOptions -> CommandSeek
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index bd910cd55..3d62b6bb1 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -9,6 +9,7 @@
module Logs.Transfer where
+import Types.Transfer
import Annex.Common
import Annex.Perms
import qualified Git
@@ -23,38 +24,6 @@ import Data.Time.Clock
import Data.Time.Clock.POSIX
import Control.Concurrent
-{- Enough information to uniquely identify a transfer, used as the filename
- - of the transfer information file. -}
-data Transfer = Transfer
- { transferDirection :: Direction
- , transferUUID :: UUID
- , transferKey :: Key
- }
- deriving (Eq, Ord, Read, Show)
-
-{- Information about a Transfer, stored in the transfer information file.
- -
- - Note that the associatedFile may not correspond to a file in the local
- - git repository. It's some file, possibly relative to some directory,
- - of some repository, that was acted on to initiate the transfer.
- -}
-data TransferInfo = TransferInfo
- { startedTime :: Maybe POSIXTime
- , transferPid :: Maybe PID
- , transferTid :: Maybe ThreadId
- , transferRemote :: Maybe Remote
- , bytesComplete :: Maybe Integer
- , associatedFile :: Maybe FilePath
- , transferPaused :: Bool
- }
- deriving (Show, Eq, Ord)
-
-stubTransferInfo :: TransferInfo
-stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False
-
-data Direction = Upload | Download
- deriving (Eq, Ord, Read, Show)
-
showLcDirection :: Direction -> String
showLcDirection Upload = "upload"
showLcDirection Download = "download"
diff --git a/Messages.hs b/Messages.hs
index 339823d42..f1055efb8 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -5,8 +5,6 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-
module Messages (
showStart,
ActionItem,
@@ -53,11 +51,10 @@ import System.Log.Handler.Simple
import Common
import Types
import Types.Messages
-import Git.FilePath
+import Types.ActionItem
import Messages.Internal
import qualified Messages.JSON as JSON
import Utility.JSONStream (JSONChunk(..))
-import Types.Key
import qualified Annex
showStart :: String -> FilePath -> Annex ()
@@ -66,33 +63,6 @@ showStart command file = outputMessage json $
where
json = JSON.start command (Just file) Nothing
-data ActionItem
- = ActionItemAssociatedFile AssociatedFile
- | ActionItemKey
- | ActionItemBranchFilePath BranchFilePath
-
-class MkActionItem t where
- mkActionItem :: t -> ActionItem
-
-instance MkActionItem AssociatedFile where
- mkActionItem = ActionItemAssociatedFile
-
-instance MkActionItem Key where
- mkActionItem _ = ActionItemKey
-
-instance MkActionItem BranchFilePath where
- mkActionItem = ActionItemBranchFilePath
-
-actionItemDesc :: ActionItem -> Key -> String
-actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
-actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
-actionItemDesc ActionItemKey k = key2file k
-actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
-
-actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
-actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
-actionItemWorkTreeFile _ = Nothing
-
showStart' :: String -> Key -> ActionItem -> Annex ()
showStart' command key i = outputMessage json $
command ++ " " ++ actionItemDesc i key ++ " "
diff --git a/Remote/External.hs b/Remote/External.hs
index 9caf48aae..f88b069be 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -22,7 +22,7 @@ import Remote.Helper.ReadOnly
import Remote.Helper.Messages
import Utility.Metered
import Messages.Progress
-import Logs.Transfer
+import Types.Transfer
import Logs.PreferredContent.Raw
import Logs.RemoteState
import Logs.Web
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 66a285535..87c2dc056 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -34,7 +34,7 @@ module Remote.External.Types (
import Annex.Common
import Types.StandardGroups (PreferredContentExpression)
import Utility.Metered (BytesProcessed(..))
-import Logs.Transfer (Direction(..))
+import Types.Transfer (Direction(..))
import Config.Cost (Cost)
import Types.Remote (RemoteConfig)
import Types.Availability (Availability(..))
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index d34c733c5..a0c8ecaf7 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -25,6 +25,7 @@ import Types.Remote
import Types.GitConfig
import Types.Crypto
import Types.Creds
+import Types.Transfer
import qualified Git
import qualified Git.Command
import qualified Git.Config
@@ -47,7 +48,6 @@ import qualified Remote.Directory
import Utility.Rsync
import Utility.Tmp
import Logs.Remote
-import Logs.Transfer
import Utility.Gpg
remote :: RemoteType
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index cef30082b..4ec772296 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -20,7 +20,7 @@ import Messages.Progress
import Utility.Metered
import Utility.Rsync
import Types.Remote
-import Logs.Transfer
+import Types.Transfer
import Config
{- Generates parameters to ssh to a repository's host and run a command.
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 8acf91214..4695ac7a9 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -34,7 +34,7 @@ import Utility.Rsync
import Utility.CopyFile
import Messages.Progress
import Utility.Metered
-import Logs.Transfer
+import Types.Transfer
import Types.Creds
import Annex.DirHashes
import Utility.Tmp
diff --git a/Types/ActionItem.hs b/Types/ActionItem.hs
new file mode 100644
index 000000000..a0097e45a
--- /dev/null
+++ b/Types/ActionItem.hs
@@ -0,0 +1,54 @@
+{- items that a command can act on
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
+module Types.ActionItem where
+
+import Types.Key
+import Types.Transfer
+import Git.FilePath
+
+import Data.Maybe
+
+data ActionItem
+ = ActionItemAssociatedFile AssociatedFile
+ | ActionItemKey
+ | ActionItemBranchFilePath BranchFilePath
+ | ActionItemFailedTransfer Transfer TransferInfo
+
+class MkActionItem t where
+ mkActionItem :: t -> ActionItem
+
+instance MkActionItem AssociatedFile where
+ mkActionItem = ActionItemAssociatedFile
+
+instance MkActionItem Key where
+ mkActionItem _ = ActionItemKey
+
+instance MkActionItem BranchFilePath where
+ mkActionItem = ActionItemBranchFilePath
+
+instance MkActionItem (Transfer, TransferInfo) where
+ mkActionItem = uncurry ActionItemFailedTransfer
+
+actionItemDesc :: ActionItem -> Key -> String
+actionItemDesc (ActionItemAssociatedFile (Just f)) _ = f
+actionItemDesc (ActionItemAssociatedFile Nothing) k = key2file k
+actionItemDesc ActionItemKey k = key2file k
+actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
+actionItemDesc (ActionItemFailedTransfer _ i) k =
+ fromMaybe (key2file k) (associatedFile i)
+
+actionItemWorkTreeFile :: ActionItem -> Maybe FilePath
+actionItemWorkTreeFile (ActionItemAssociatedFile af) = af
+actionItemWorkTreeFile _ = Nothing
+
+actionItemTransferDirection :: ActionItem -> Maybe Direction
+actionItemTransferDirection (ActionItemFailedTransfer t _) = Just $
+ transferDirection t
+actionItemTransferDirection _ = Nothing
diff --git a/Types/Transfer.hs b/Types/Transfer.hs
new file mode 100644
index 000000000..528d1d5cb
--- /dev/null
+++ b/Types/Transfer.hs
@@ -0,0 +1,47 @@
+{- git-annex transfer types
+ -
+ - Copyright 2012 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Transfer where
+
+import Types
+import Utility.PID
+
+import Data.Time.Clock.POSIX
+import Control.Concurrent
+
+{- Enough information to uniquely identify a transfer, used as the filename
+ - of the transfer information file. -}
+data Transfer = Transfer
+ { transferDirection :: Direction
+ , transferUUID :: UUID
+ , transferKey :: Key
+ }
+ deriving (Eq, Ord, Read, Show)
+
+{- Information about a Transfer, stored in the transfer information file.
+ -
+ - Note that the associatedFile may not correspond to a file in the local
+ - git repository. It's some file, possibly relative to some directory,
+ - of some repository, that was acted on to initiate the transfer.
+ -}
+data TransferInfo = TransferInfo
+ { startedTime :: Maybe POSIXTime
+ , transferPid :: Maybe PID
+ , transferTid :: Maybe ThreadId
+ , transferRemote :: Maybe Remote
+ , bytesComplete :: Maybe Integer
+ , associatedFile :: Maybe FilePath
+ , transferPaused :: Bool
+ }
+ deriving (Show, Eq, Ord)
+
+stubTransferInfo :: TransferInfo
+stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False
+
+data Direction = Upload | Download
+ deriving (Eq, Ord, Read, Show)
+
diff --git a/doc/git-annex-copy.mdwn b/doc/git-annex-copy.mdwn
index 185333446..e99f9848d 100644
--- a/doc/git-annex-copy.mdwn
+++ b/doc/git-annex-copy.mdwn
@@ -59,6 +59,10 @@ Copies the content of files from or to another remote.
Operate on files found by last run of git-annex unused.
+* `--failed`
+
+ Operate on files that have recently failed to be transferred.
+
* `--key=keyname`
Use this option to move a specified key.
diff --git a/doc/git-annex-get.mdwn b/doc/git-annex-get.mdwn
index 34b698084..9d06786c6 100644
--- a/doc/git-annex-get.mdwn
+++ b/doc/git-annex-get.mdwn
@@ -32,6 +32,11 @@ or transferring them from some kind of key-value store.
Enables parallel download with up to the specified number of jobs
running at once. For example: `-J10`
+* file matching options
+
+ The [[git-annex-matching-options]](1)
+ can be used to specify files to get.
+
* `--incomplete`
Resume any incomplete downloads of files that were started and
@@ -45,11 +50,6 @@ or transferring them from some kind of key-value store.
as git-annex does not know the associated file, and the associated file
may not even be in the current git working directory.
-* file matching options
-
- The [[git-annex-matching-options]](1)
- can be used to specify files to get.
-
* `--all`
Rather than specifying a filename or path to get, this option can be
@@ -65,6 +65,10 @@ or transferring them from some kind of key-value store.
Operate on files found by last run of git-annex unused.
+* `--failed`
+
+ Operate on files that have recently failed to be transferred.
+
* `--key=keyname`
Use this option to get a specified key.
diff --git a/doc/git-annex-mirror.mdwn b/doc/git-annex-mirror.mdwn
index 9cc503f26..77df17045 100644
--- a/doc/git-annex-mirror.mdwn
+++ b/doc/git-annex-mirror.mdwn
@@ -53,6 +53,14 @@ contents. Use [[git-annex-sync]](1) for that.
Like --all, this bypasses checking the .gitattributes annex.numcopies
setting when dropping files.
+* `--unused`
+
+ Operate on files found by last run of git-annex unused.
+
+* `--failed`
+
+ Operate on files that have recently failed to be transferred.
+
* file matching options
The [[git-annex-matching-options]](1)
diff --git a/doc/git-annex-move.mdwn b/doc/git-annex-move.mdwn
index 2d1b2a896..bac5719f1 100644
--- a/doc/git-annex-move.mdwn
+++ b/doc/git-annex-move.mdwn
@@ -42,6 +42,10 @@ Moves the content of files from or to another remote.
Operate on files found by last run of git-annex unused.
+* `--failed`
+
+ Operate on files that have recently failed to be transferred.
+
* `--key=keyname`
Use this option to move a specified key.
diff --git a/doc/todo/__34__copy_--failed__34__.mdwn b/doc/todo/__34__copy_--failed__34__.mdwn
index 511265b30..fa3b071d7 100644
--- a/doc/todo/__34__copy_--failed__34__.mdwn
+++ b/doc/todo/__34__copy_--failed__34__.mdwn
@@ -3,3 +3,5 @@ I often "copy --to remote" many files at once, and inevitably the transfer fails
Related: <https://git-annex.branchable.com/todo/make_copy_--fast__faster/>
git-annex is awesome btw. Thanks!
+
+> [[done]] --[[Joey]]
diff --git a/doc/todo/__34__copy_--failed__34__/comment_1_ff81023df39f9faac5935f6417ad2b38._comment b/doc/todo/__34__copy_--failed__34__/comment_1_ff81023df39f9faac5935f6417ad2b38._comment
new file mode 100644
index 000000000..d0f49a54a
--- /dev/null
+++ b/doc/todo/__34__copy_--failed__34__/comment_1_ff81023df39f9faac5935f6417ad2b38._comment
@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2016-08-03T15:07:43Z"
+ content="""
+Nice idea, and there's already a log of recent failed transfers that
+could be used.
+"""]]
diff --git a/doc/todo/make_copy_--fast__faster/comment_4_3ac10a07c74e5debafc9ae574d26c955._comment b/doc/todo/make_copy_--fast__faster/comment_4_3ac10a07c74e5debafc9ae574d26c955._comment
new file mode 100644
index 000000000..bb9258b45
--- /dev/null
+++ b/doc/todo/make_copy_--fast__faster/comment_4_3ac10a07c74e5debafc9ae574d26c955._comment
@@ -0,0 +1,11 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2016-08-03T16:02:46Z"
+ content="""
+--failed can now be used to retry only failed transfers. So that will be a
+lot faster in that specific case.
+
+Leaving this bug open for the general wishlist that copy --fast be somehow
+a lot faster than it is at finding things that need to be copied.
+"""]]