add a progress callback to storeKey, and threaded it all the way through
Transfer info files are updated when the callback is called, updating the number of bytes transferred. Left unused p variables at every place the callback should be used. Which is rather a lot..
This commit is contained in:
parent
3c81d70c1b
commit
aff09a1f33
14 changed files with 75 additions and 59 deletions
|
@ -113,14 +113,14 @@ bupSplitParams r buprepo k src = do
|
|||
return $ bupParams "split" buprepo
|
||||
(os ++ [Param "-n", Param (bupRef k), src])
|
||||
|
||||
store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> Annex Bool
|
||||
store r buprepo k _f = do
|
||||
store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool
|
||||
store r buprepo k _f p = do
|
||||
src <- inRepo $ gitAnnexLocation k
|
||||
params <- bupSplitParams r buprepo k (File src)
|
||||
liftIO $ boolSystem "bup" params
|
||||
|
||||
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
|
||||
storeEncrypted r buprepo (cipher, enck) k = do
|
||||
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool
|
||||
storeEncrypted r buprepo (cipher, enck) k p = do
|
||||
src <- inRepo $ gitAnnexLocation k
|
||||
params <- bupSplitParams r buprepo enck (Param "-")
|
||||
liftIO $ catchBoolIO $
|
||||
|
|
|
@ -124,8 +124,8 @@ withCheckedFiles check (Just _) d k a = go $ locations d k
|
|||
withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool
|
||||
withStoredFiles = withCheckedFiles doesFileExist
|
||||
|
||||
store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> Annex Bool
|
||||
store d chunksize k _f = do
|
||||
store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool
|
||||
store d chunksize k _f p = do
|
||||
src <- inRepo $ gitAnnexLocation k
|
||||
metered k $ \meterupdate ->
|
||||
storeHelper d chunksize k $ \dests ->
|
||||
|
@ -139,8 +139,8 @@ store d chunksize k _f = do
|
|||
storeSplit meterupdate chunksize dests
|
||||
=<< L.readFile src
|
||||
|
||||
storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> Annex Bool
|
||||
storeEncrypted d chunksize (cipher, enck) k = do
|
||||
storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool
|
||||
storeEncrypted d chunksize (cipher, enck) k p = do
|
||||
src <- inRepo $ gitAnnexLocation k
|
||||
metered k $ \meterupdate ->
|
||||
storeHelper d chunksize enck $ \dests ->
|
||||
|
|
|
@ -262,8 +262,8 @@ copyFromRemoteCheap r key file
|
|||
| otherwise = return False
|
||||
|
||||
{- Tries to copy a key's content to a remote's annex. -}
|
||||
copyToRemote :: Git.Repo -> Key -> AssociatedFile -> Annex Bool
|
||||
copyToRemote r key file
|
||||
copyToRemote :: Git.Repo -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool
|
||||
copyToRemote r key file p
|
||||
| not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ do
|
||||
keysrc <- inRepo $ gitAnnexLocation key
|
||||
params <- rsyncParams r
|
||||
|
@ -276,7 +276,7 @@ copyToRemote r key file
|
|||
download u key file $
|
||||
Annex.Content.saveState True `after`
|
||||
Annex.Content.getViaTmp key
|
||||
(rsyncOrCopyFile params keysrc)
|
||||
(\d -> rsyncOrCopyFile params keysrc d p)
|
||||
)
|
||||
| Git.repoIsSsh r = commitOnCleanup r $ do
|
||||
keysrc <- inRepo $ gitAnnexLocation key
|
||||
|
@ -295,8 +295,8 @@ rsyncHelper p = do
|
|||
|
||||
{- Copys a file with rsync unless both locations are on the same
|
||||
- filesystem. Then cp could be faster. -}
|
||||
rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> Annex Bool
|
||||
rsyncOrCopyFile rsyncparams src dest =
|
||||
rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> ProgressCallback -> Annex Bool
|
||||
rsyncOrCopyFile rsyncparams src dest p =
|
||||
ifM (sameDeviceIds src dest)
|
||||
( liftIO $ copyFileExternal src dest
|
||||
, rsyncHelper $ rsyncparams ++ [Param src, Param dest]
|
||||
|
|
|
@ -45,7 +45,7 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of
|
|||
- to support storing and retrieving encrypted content. -}
|
||||
encryptableRemote
|
||||
:: Maybe RemoteConfig
|
||||
-> ((Cipher, Key) -> Key -> Annex Bool)
|
||||
-> ((Cipher, Key) -> Key -> ProgressCallback -> Annex Bool)
|
||||
-> ((Cipher, Key) -> Key -> FilePath -> Annex Bool)
|
||||
-> Remote
|
||||
-> Remote
|
||||
|
@ -59,9 +59,9 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
|
|||
cost = cost r + encryptedRemoteCostAdj
|
||||
}
|
||||
where
|
||||
store k f = cip k >>= maybe
|
||||
(storeKey r k f)
|
||||
(`storeKeyEncrypted` k)
|
||||
store k f p = cip k >>= maybe
|
||||
(storeKey r k f p)
|
||||
(\enck -> storeKeyEncrypted enck k p)
|
||||
retrieve k f d = cip k >>= maybe
|
||||
(retrieveKeyFile r k f d)
|
||||
(\enck -> retrieveKeyFileEncrypted enck k d)
|
||||
|
|
|
@ -27,7 +27,7 @@ addHooks' r Nothing Nothing = r
|
|||
addHooks' r starthook stophook = r'
|
||||
where
|
||||
r' = r
|
||||
{ storeKey = \k f -> wrapper $ storeKey r k f
|
||||
{ storeKey = \k f p -> wrapper $ storeKey r k f p
|
||||
, retrieveKeyFile = \k f d -> wrapper $ retrieveKeyFile r k f d
|
||||
, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
|
||||
, removeKey = \k -> wrapper $ removeKey r k
|
||||
|
|
|
@ -103,13 +103,13 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
|
|||
return False
|
||||
)
|
||||
|
||||
store :: String -> Key -> AssociatedFile -> Annex Bool
|
||||
store h k _f = do
|
||||
store :: String -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool
|
||||
store h k _f _p = do
|
||||
src <- inRepo $ gitAnnexLocation k
|
||||
runHook h "store" k (Just src) $ return True
|
||||
|
||||
storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool
|
||||
storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
|
||||
storeEncrypted :: String -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool
|
||||
storeEncrypted h (cipher, enck) k _p = withTmp enck $ \tmp -> do
|
||||
src <- inRepo $ gitAnnexLocation k
|
||||
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
|
||||
runHook h "store" enck (Just tmp) $ return True
|
||||
|
|
|
@ -104,11 +104,11 @@ rsyncUrls o k = map use annexHashes
|
|||
use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f)
|
||||
f = keyFile k
|
||||
|
||||
store :: RsyncOpts -> Key -> AssociatedFile -> Annex Bool
|
||||
store o k _f = rsyncSend o k <=< inRepo $ gitAnnexLocation k
|
||||
store :: RsyncOpts -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool
|
||||
store o k _f p = rsyncSend o k <=< inRepo $ gitAnnexLocation k
|
||||
|
||||
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
|
||||
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
|
||||
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool
|
||||
storeEncrypted o (cipher, enck) k p = withTmp enck $ \tmp -> do
|
||||
src <- inRepo $ gitAnnexLocation k
|
||||
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
|
||||
rsyncSend o enck tmp
|
||||
|
|
|
@ -115,14 +115,14 @@ s3Setup u c = handlehost $ M.lookup "host" c
|
|||
-- be human-readable
|
||||
M.delete "bucket" defaults
|
||||
|
||||
store :: Remote -> Key -> AssociatedFile -> Annex Bool
|
||||
store r k _f = s3Action r False $ \(conn, bucket) -> do
|
||||
store :: Remote -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool
|
||||
store r k _f p = s3Action r False $ \(conn, bucket) -> do
|
||||
dest <- inRepo $ gitAnnexLocation k
|
||||
res <- liftIO $ storeHelper (conn, bucket) r k dest
|
||||
s3Bool res
|
||||
|
||||
storeEncrypted :: Remote -> (Cipher, Key) -> Key -> Annex Bool
|
||||
storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) ->
|
||||
storeEncrypted :: Remote -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool
|
||||
storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) ->
|
||||
-- To get file size of the encrypted content, have to use a temp file.
|
||||
-- (An alternative would be chunking to to a constant size.)
|
||||
withTmp enck $ \tmp -> do
|
||||
|
|
|
@ -66,8 +66,8 @@ downloadKey key _file dest = get =<< getUrls key
|
|||
downloadKeyCheap :: Key -> FilePath -> Annex Bool
|
||||
downloadKeyCheap _ _ = return False
|
||||
|
||||
uploadKey :: Key -> AssociatedFile -> Annex Bool
|
||||
uploadKey _ _ = do
|
||||
uploadKey :: Key -> AssociatedFile -> ProgressCallback -> Annex Bool
|
||||
uploadKey _ _ _ = do
|
||||
warning "upload to web not supported"
|
||||
return False
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue