diff options
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 10 | ||||
-rw-r--r-- | Remote/Directory.hs | 8 | ||||
-rw-r--r-- | Remote/Git.hs | 32 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 14 | ||||
-rw-r--r-- | Remote/Helper/Hooks.hs | 4 | ||||
-rw-r--r-- | Remote/Hook.hs | 8 | ||||
-rw-r--r-- | Remote/Rsync.hs | 12 | ||||
-rw-r--r-- | Remote/S3.hs | 10 | ||||
-rw-r--r-- | Remote/Web.hs | 10 |
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 |