aboutsummaryrefslogtreecommitdiff
path: root/Logs/Transfer.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-03-22 10:42:38 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-03-22 14:12:19 -0400
commit35419994e9418444dc82e5c90c579203cc4c3616 (patch)
tree0d4374fbc7f233cfa409e9e142b36f00d12f71f4 /Logs/Transfer.hs
parentf2a5858f85f1d6e999d707f4b48cd2ea643197bc (diff)
add desktop notifications
Motivation: Hook scripts for nautilus or other file managers need to provide the user with feedback that a file is being downloaded. This commit was sponsored by THM Schoemaker.
Diffstat (limited to 'Logs/Transfer.hs')
-rw-r--r--Logs/Transfer.hs102
1 files changed, 0 insertions, 102 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 742bdc7b9..c96d9cd1e 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -88,108 +88,6 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage
percentComplete (Transfer { transferKey = key }) info =
percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info)
-type RetryDecider = TransferInfo -> TransferInfo -> Bool
-
-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 -> (MeterUpdate -> Annex Bool) -> Annex Bool
-download u key = runTransfer (Transfer Download u key)
-
-{- Runs a transfer action. Creates and locks the lock file while the
- - action is running, and stores info in the transfer information
- - file.
- -
- - If the transfer action returns False, the transfer info is
- - left in the failedTransferDir.
- -
- - If the transfer is already in progress, returns False.
- -
- - An upload can be run from a read-only filesystem, and in this case
- - no transfer information or lock file is used.
- -}
-runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool
-runTransfer t file shouldretry a = do
- info <- liftIO $ startTransferInfo file
- (meter, tfile, metervar) <- mkProgressUpdater t info
- mode <- annexFileMode
- (fd, inprogress) <- liftIO $ prep tfile mode info
- if inprogress
- then do
- showNote "transfer already in progress"
- return False
- else do
- ok <- retry info metervar $
- bracketIO (return fd) (cleanup tfile) (const $ a meter)
- unless ok $ recordFailedTransfer t info
- return ok
- where
-#ifndef mingw32_HOST_OS
- prep tfile mode info = do
- mfd <- catchMaybeIO $
- openFd (transferLockFile tfile) ReadWrite (Just mode)
- defaultFileFlags { trunc = True }
- case mfd of
- Nothing -> return (Nothing, False)
- Just fd -> do
- locked <- catchMaybeIO $
- setLock fd (WriteLock, AbsoluteSeek, 0, 0)
- if isNothing locked
- then return (Nothing, True)
- else do
- void $ tryIO $ writeTransferInfoFile info tfile
- return (mfd, False)
-#else
- prep tfile _mode info = do
- v <- catchMaybeIO $ lockExclusive (transferLockFile tfile)
- case v of
- Nothing -> return (Nothing, False)
- Just Nothing -> return (Nothing, True)
- Just (Just lockhandle) -> do
- void $ tryIO $ writeTransferInfoFile info tfile
- return (Just lockhandle, False)
-#endif
- cleanup _ Nothing = noop
- cleanup tfile (Just lockhandle) = do
- void $ tryIO $ removeFile tfile
-#ifndef mingw32_HOST_OS
- void $ tryIO $ removeFile $ transferLockFile tfile
- closeFd lockhandle
-#else
- {- Windows cannot delete the lockfile until the lock
- - is closed. So it's possible to race with another
- - process that takes the lock before it's removed,
- - so ignore failure to remove.
- -}
- dropLock lockhandle
- void $ tryIO $ removeFile $ transferLockFile tfile
-#endif
- retry oldinfo metervar run = do
- v <- tryAnnex run
- case v of
- Right b -> return b
- Left _ -> do
- b <- getbytescomplete metervar
- let newinfo = oldinfo { bytesComplete = Just b }
- if shouldretry oldinfo newinfo
- then retry newinfo metervar run
- else return False
- getbytescomplete metervar
- | transferDirection t == Upload =
- liftIO $ readMVar metervar
- | otherwise = do
- f <- fromRepo $ gitAnnexTmpObjectLocation (transferKey t)
- liftIO $ catchDefaultIO 0 $
- fromIntegral . fileSize <$> getFileStatus f
-
{- Generates a callback that can be called as transfer progresses to update
- the transfer info file. Also returns the file it'll be updating, and a
- MVar that can be used to read the number of bytesComplete. -}