summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/Move.hs4
-rw-r--r--Command/SendKey.hs4
-rw-r--r--Command/TransferKey.hs4
-rw-r--r--Logs/Transfer.hs36
-rw-r--r--Remote/Git.hs4
-rw-r--r--doc/design/assistant/OSX.mdwn4
7 files changed, 39 insertions, 19 deletions
diff --git a/Command/Get.hs b/Command/Get.hs
index 18153ce88..ab0e60b41 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -66,7 +66,7 @@ getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
either (const False) id <$> Remote.hasKey r key
| otherwise = return True
docopy r continue = do
- ok <- download (Remote.uuid r) key (Just file) $ do
+ ok <- download (Remote.uuid r) key (Just file) noRetry $ do
showAction $ "from " ++ Remote.name r
Remote.retrieveKeyFile r key (Just file) dest
if ok then return ok else continue
diff --git a/Command/Move.hs b/Command/Move.hs
index 7955cecd3..36242f45c 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -89,7 +89,7 @@ toPerform dest move key file = moveLock move key $ do
stop
Right False -> do
showAction $ "to " ++ Remote.name dest
- ok <- upload (Remote.uuid dest) key (Just file) $
+ ok <- upload (Remote.uuid dest) key (Just file) noRetry $
Remote.storeKey dest key (Just file)
if ok
then finish
@@ -138,7 +138,7 @@ fromPerform src move key file = moveLock move key $
, handle move =<< go
)
where
- go = download (Remote.uuid src) key (Just file) $ do
+ go = download (Remote.uuid src) key (Just file) noRetry $ do
showAction $ "from " ++ Remote.name src
getViaTmp key $ Remote.retrieveKeyFile src key (Just file)
handle _ False = stop -- failed
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index e5d4c7e6e..2aae1ab90 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -24,7 +24,7 @@ seek = [withKeys start]
start :: Key -> CommandStart
start key = ifM (inAnnex key)
- ( fieldTransfer Upload key $ \p -> do
+ ( fieldTransfer Upload key $ \_p -> do
file <- inRepo $ gitAnnexLocation key
liftIO $ rsyncServerSend file
, do
@@ -36,7 +36,7 @@ fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
fieldTransfer direction key a = do
afile <- Fields.getField Fields.associatedFile
ok <- maybe (a $ const noop)
- (\u -> runTransfer (Transfer direction (toUUID u) key) afile a)
+ (\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)
=<< Fields.getField Fields.remoteUUID
if ok
then liftIO exitSuccess
diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs
index 793dbeb56..a308e0175 100644
--- a/Command/TransferKey.hs
+++ b/Command/TransferKey.hs
@@ -43,7 +43,7 @@ start to from file key =
toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
toPerform remote key file = next $
- upload (uuid remote) key file $ \p -> do
+ upload (uuid remote) key file forwardRetry $ \p -> do
ok <- Remote.storeKey remote key file p
when ok $
Remote.logStatus remote key InfoPresent
@@ -51,5 +51,5 @@ toPerform remote key file = next $
fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
fromPerform remote key file = next $
- download (uuid remote) key file $
+ download (uuid remote) key file forwardRetry $
getViaTmp key $ Remote.retrieveKeyFile remote key file
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 7188143d6..016571d23 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -74,11 +74,21 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage
percentComplete (Transfer { transferKey = key }) info =
percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info)
-upload :: UUID -> Key -> AssociatedFile -> (MeterUpdate -> Annex Bool) -> Annex Bool
-upload u key file a = runTransfer (Transfer Upload u key) file a
+type RetryDecider = TransferInfo -> TransferInfo -> Bool
-download :: UUID -> Key -> AssociatedFile -> Annex Bool -> Annex Bool
-download u key file a = runTransfer (Transfer Download u key) file (const a)
+noRetry :: RetryDecider
+noRetry _ _ = False
+
+{- Retries a transfer when it fails, as long as the failed transfer managed
+ - to send some data. -}
+forwardRetry :: RetryDecider
+forwardRetry old new = bytesComplete old < bytesComplete new
+
+upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
+upload u key = runTransfer (Transfer Upload u key)
+
+download :: UUID -> Key -> AssociatedFile -> RetryDecider -> Annex Bool -> Annex Bool
+download u key file shouldretry a = runTransfer (Transfer Download u key) file shouldretry (const a)
{- Runs a transfer action. Creates and locks the lock file while the
- action is running, and stores info in the transfer information
@@ -87,12 +97,12 @@ download u key file a = runTransfer (Transfer Download u key) file (const a)
- If the transfer action returns False, the transfer info is
- left in the failedTransferDir.
-}
-runTransfer :: Transfer -> Maybe FilePath -> (MeterUpdate -> Annex Bool) -> Annex Bool
-runTransfer t file a = do
+runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
+runTransfer t file shouldretry a = do
info <- liftIO $ startTransferInfo file
(meter, tfile) <- mkProgressUpdater t info
mode <- annexFileMode
- ok <- bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
+ ok <- retry tfile info $ bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
unless ok $ failed info
return ok
where
@@ -113,7 +123,17 @@ runTransfer t file a = do
failedtfile <- fromRepo $ failedTransferFile t
createAnnexDirectory $ takeDirectory failedtfile
liftIO $ writeTransferInfoFile info failedtfile
-
+ retry tfile oldinfo run = do
+ ok <- run
+ if ok
+ then return ok
+ else do
+ v <- liftIO $ readTransferInfoFile Nothing tfile
+ case v of
+ Nothing -> return ok
+ Just newinfo -> if shouldretry oldinfo newinfo
+ then retry tfile newinfo run
+ else return ok
{- Generates a callback that can be called as transfer progresses to update
- the transfer info file. Also returns the file it'll be updating. -}
diff --git a/Remote/Git.hs b/Remote/Git.hs
index a1c5b24b4..e7b1ca0e8 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -247,7 +247,7 @@ copyFromRemote r key file dest
liftIO $ onLocal r $ do
ensureInitialized
loc <- inRepo $ gitAnnexLocation key
- upload u key file $
+ upload u key file noRetry $
rsyncOrCopyFile params loc dest
| Git.repoIsSsh r = feedprogressback $ \feeder ->
rsyncHelper (Just feeder)
@@ -317,7 +317,7 @@ copyToRemote r key file p
( return False
, do
ensureInitialized
- download u key file $
+ download u key file noRetry $
Annex.Content.saveState True `after`
Annex.Content.getViaTmp key
(\d -> rsyncOrCopyFile params keysrc d p)
diff --git a/doc/design/assistant/OSX.mdwn b/doc/design/assistant/OSX.mdwn
index e34e88421..8fe321d5a 100644
--- a/doc/design/assistant/OSX.mdwn
+++ b/doc/design/assistant/OSX.mdwn
@@ -1,7 +1,7 @@
Misc OSX porting things:
-* autostart the assistant on OSX, using launchd
-* add webapp to OSX menu somehow
+* autostart the assistant on OSX, using launchd **done**
+* icon to start webapp **done**
* Use OSX's "network reachability functionality" to detect when on a network
<http://developer.apple.com/library/mac/#documentation/Networking/Conceptual/SystemConfigFrameworks/SC_Intro/SC_Intro.html#//apple_ref/doc/uid/TP40001065>
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-26 07:04:14 +0000