summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Bup.hs10
-rw-r--r--Remote/Directory.hs8
-rw-r--r--Remote/Git.hs32
-rw-r--r--Remote/Helper/Encryptable.hs14
-rw-r--r--Remote/Helper/Hooks.hs4
-rw-r--r--Remote/Hook.hs8
-rw-r--r--Remote/Rsync.hs12
-rw-r--r--Remote/S3.hs10
-rw-r--r--Remote/Web.hs10
9 files changed, 58 insertions, 50 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index f1a36e468..0d1b606d3 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -108,8 +108,8 @@ bupSplitParams r buprepo k src = do
return $ bupParams "split" buprepo
(os ++ [Param "-n", Param (bupRef k), src])
-store :: Git.Repo -> BupRepo -> Key -> Annex Bool
-store r buprepo k = do
+store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> Annex Bool
+store r buprepo k _f = do
src <- inRepo $ gitAnnexLocation k
params <- bupSplitParams r buprepo k (File src)
liftIO $ boolSystem "bup" params
@@ -122,11 +122,11 @@ storeEncrypted r buprepo (cipher, enck) k = do
withEncryptedHandle cipher (L.readFile src) $ \h ->
pipeBup params (Just h) Nothing
-retrieve :: BupRepo -> Key -> FilePath -> Annex Bool
-retrieve buprepo k f = do
+retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieve buprepo k _f d = do
let params = bupParams "join" buprepo [Param $ bupRef k]
liftIO $ catchBoolIO $ do
- tofile <- openFile f WriteMode
+ tofile <- openFile d WriteMode
pipeBup params Nothing (Just tofile)
retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index f618f518e..6b158730e 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -122,8 +122,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 -> Annex Bool
-store d chunksize k = do
+store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> Annex Bool
+store d chunksize k _f = do
src <- inRepo $ gitAnnexLocation k
metered k $ \meterupdate ->
storeHelper d chunksize k $ \dests ->
@@ -242,8 +242,8 @@ storeHelper d chunksize key a = prep <&&> check <&&> go
preventWrite dir
return (not $ null stored)
-retrieve :: FilePath -> ChunkSize -> Key -> FilePath -> Annex Bool
-retrieve d chunksize k f = metered k $ \meterupdate ->
+retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieve d chunksize k _ f = metered k $ \meterupdate ->
liftIO $ withStoredFiles chunksize d k $ \files ->
catchBoolIO $ do
meteredWriteFile' meterupdate f files feeder
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 60a881803..0b839c9a5 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -21,6 +21,7 @@ import qualified Git.Config
import qualified Git.Construct
import qualified Annex
import Logs.Presence
+import Logs.Transfer
import Annex.UUID
import qualified Annex.Content
import qualified Annex.BranchState
@@ -219,14 +220,19 @@ dropKey r key
]
{- Tries to copy a key's content from a remote's annex to a file. -}
-copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
-copyFromRemote r key file
+copyFromRemote :: Git.Repo -> Key -> AssociatedFile -> FilePath -> Annex Bool
+copyFromRemote r key file dest
| not $ Git.repoIsUrl r = guardUsable r False $ do
params <- rsyncParams r
- loc <- liftIO $ gitAnnexLocation key r
- rsyncOrCopyFile params loc file
- | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
- | Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) file
+ u <- getUUID
+ -- run copy from perspective of remote
+ liftIO $ onLocal r $ do
+ ensureInitialized
+ loc <- inRepo $ gitAnnexLocation key
+ upload u key file $
+ rsyncOrCopyFile params loc dest
+ | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key dest
+ | Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest
| otherwise = error "copying from non-ssh, non-http repo not supported"
copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
@@ -236,23 +242,25 @@ copyFromRemoteCheap r key file
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
| Git.repoIsSsh r =
ifM (Annex.Content.preseedTmp key file)
- ( copyFromRemote r key file
+ ( copyFromRemote r key Nothing file
, return False
)
| otherwise = return False
{- Tries to copy a key's content to a remote's annex. -}
-copyToRemote :: Git.Repo -> Key -> Annex Bool
-copyToRemote r key
+copyToRemote :: Git.Repo -> Key -> AssociatedFile -> Annex Bool
+copyToRemote r key file
| not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ do
keysrc <- inRepo $ gitAnnexLocation key
params <- rsyncParams r
+ u <- getUUID
-- run copy from perspective of remote
liftIO $ onLocal r $ do
ensureInitialized
- Annex.Content.saveState True `after`
- Annex.Content.getViaTmp key
- (rsyncOrCopyFile params keysrc)
+ download u key file $
+ Annex.Content.saveState True `after`
+ Annex.Content.getViaTmp key
+ (rsyncOrCopyFile params keysrc)
| Git.repoIsSsh r = commitOnCleanup r $ do
keysrc <- inRepo $ gitAnnexLocation key
rsyncHelper =<< rsyncParamsRemote r False key keysrc
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 789a1d996..6d5405d9e 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -59,14 +59,14 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
cost = cost r + encryptedRemoteCostAdj
}
where
- store k = cip k >>= maybe
- (storeKey r k)
+ store k f = cip k >>= maybe
+ (storeKey r k f)
(`storeKeyEncrypted` k)
- retrieve k f = cip k >>= maybe
- (retrieveKeyFile r k f)
- (\enck -> retrieveKeyFileEncrypted enck k f)
- retrieveCheap k f = cip k >>= maybe
- (retrieveKeyFileCheap r k f)
+ retrieve k f d = cip k >>= maybe
+ (retrieveKeyFile r k f d)
+ (\enck -> retrieveKeyFileEncrypted enck k d)
+ retrieveCheap k d = cip k >>= maybe
+ (retrieveKeyFileCheap r k d)
(\_ -> return False)
withkey a k = cip k >>= maybe (a k) (a . snd)
cip = cipherKey c
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index d85959062..0a6b22081 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -27,8 +27,8 @@ addHooks' r Nothing Nothing = r
addHooks' r starthook stophook = r'
where
r' = r
- { storeKey = \k -> wrapper $ storeKey r k
- , retrieveKeyFile = \k f -> wrapper $ retrieveKeyFile r k f
+ { storeKey = \k f -> wrapper $ storeKey r k f
+ , retrieveKeyFile = \k f d -> wrapper $ retrieveKeyFile r k f d
, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
, removeKey = \k -> wrapper $ removeKey r k
, hasKey = \k -> wrapper $ hasKey r k
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 5fb793e65..9e8d3c620 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -101,8 +101,8 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
return False
)
-store :: String -> Key -> Annex Bool
-store h k = do
+store :: String -> Key -> AssociatedFile -> Annex Bool
+store h k _f = do
src <- inRepo $ gitAnnexLocation k
runHook h "store" k (Just src) $ return True
@@ -112,8 +112,8 @@ storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
runHook h "store" enck (Just tmp) $ return True
-retrieve :: String -> Key -> FilePath -> Annex Bool
-retrieve h k f = runHook h "retrieve" k (Just f) $ return True
+retrieve :: String -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieve h k _f d = runHook h "retrieve" k (Just d) $ return True
retrieveCheap :: String -> Key -> FilePath -> Annex Bool
retrieveCheap _ _ _ = return False
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 6207e1425..887c68339 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -99,8 +99,8 @@ rsyncUrls o k = map use annexHashes
use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f)
f = keyFile k
-store :: RsyncOpts -> Key -> Annex Bool
-store o k = rsyncSend o k <=< inRepo $ gitAnnexLocation k
+store :: RsyncOpts -> Key -> AssociatedFile -> Annex Bool
+store o k _f = rsyncSend o k <=< inRepo $ gitAnnexLocation k
storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool
storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
@@ -108,8 +108,8 @@ storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp
rsyncSend o enck tmp
-retrieve :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieve o k f = untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o
+retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieve o k _ f = untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o
-- use inplace when retrieving to support resuming
[ Param "--inplace"
, Param u
@@ -117,11 +117,11 @@ retrieve o k f = untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o
]
retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieveCheap o k f = ifM (preseedTmp k f) ( retrieve o k f , return False )
+retrieveCheap o k f = ifM (preseedTmp k f) ( retrieve o k undefined f , return False )
retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> Annex Bool
retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp -> do
- ifM (retrieve o enck tmp)
+ ifM (retrieve o enck undefined tmp)
( liftIO $ catchBoolIO $ do
withDecryptedContent cipher (L.readFile tmp) $ L.writeFile f
return True
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 18d4915dc..dca08fff8 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -113,8 +113,8 @@ s3Setup u c = handlehost $ M.lookup "host" c
-- be human-readable
M.delete "bucket" defaults
-store :: Remote -> Key -> Annex Bool
-store r k = s3Action r False $ \(conn, bucket) -> do
+store :: Remote -> Key -> AssociatedFile -> Annex Bool
+store r k _f = s3Action r False $ \(conn, bucket) -> do
dest <- inRepo $ gitAnnexLocation k
res <- liftIO $ storeHelper (conn, bucket) r k dest
s3Bool res
@@ -149,12 +149,12 @@ storeHelper (conn, bucket) r k file = do
xheaders = filter isxheader $ M.assocs $ fromJust $ config r
isxheader (h, _) = "x-amz-" `isPrefixOf` h
-retrieve :: Remote -> Key -> FilePath -> Annex Bool
-retrieve r k f = s3Action r False $ \(conn, bucket) -> do
+retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
+retrieve r k _f d = s3Action r False $ \(conn, bucket) -> do
res <- liftIO $ getObject conn $ bucketKey r bucket k
case res of
Right o -> do
- liftIO $ L.writeFile f $ obj_data o
+ liftIO $ L.writeFile d $ obj_data o
return True
Left e -> s3Warning e
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 5fc592326..2516240ab 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -51,21 +51,21 @@ gen r _ _ =
remotetype = remote
}
-downloadKey :: Key -> FilePath -> Annex Bool
-downloadKey key file = get =<< getUrls key
+downloadKey :: Key -> AssociatedFile -> FilePath -> Annex Bool
+downloadKey key _file dest = get =<< getUrls key
where
get [] = do
warning "no known url"
return False
get urls = do
showOutput -- make way for download progress bar
- downloadUrl urls file
+ downloadUrl urls dest
downloadKeyCheap :: Key -> FilePath -> Annex Bool
downloadKeyCheap _ _ = return False
-uploadKey :: Key -> Annex Bool
-uploadKey _ = do
+uploadKey :: Key -> AssociatedFile -> Annex Bool
+uploadKey _ _ = do
warning "upload to web not supported"
return False
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-08 21:55:51 +0000