diff options
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 8 | ||||
-rw-r--r-- | Remote/Directory.hs | 8 | ||||
-rw-r--r-- | Remote/Git.hs | 10 | ||||
-rw-r--r-- | Remote/Glacier.hs | 16 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 8 | ||||
-rw-r--r-- | Remote/Helper/Hooks.hs | 2 | ||||
-rw-r--r-- | Remote/Hook.hs | 8 | ||||
-rw-r--r-- | Remote/Rsync.hs | 26 | ||||
-rw-r--r-- | Remote/S3.hs | 12 | ||||
-rw-r--r-- | Remote/Web.hs | 4 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 8 |
11 files changed, 58 insertions, 52 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 1c69d0a1c..77d506d7c 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -136,8 +136,8 @@ storeEncrypted r buprepo (cipher, enck) k _p = encrypt (getGpgOpts r) cipher (feedFile src) $ \h -> pipeBup params (Just h) Nothing -retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve buprepo k _f d = do +retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +retrieve buprepo k _f d _p = do let params = bupParams "join" buprepo [Param $ bupRef k] liftIO $ catchBoolIO $ do tofile <- openFile d WriteMode @@ -146,8 +146,8 @@ retrieve buprepo k _f d = do retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False -retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted buprepo (cipher, enck) _ f = liftIO $ catchBoolIO $ +retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool +retrieveEncrypted buprepo (cipher, enck) _ f _p = liftIO $ catchBoolIO $ withHandle StdoutHandle createProcessSuccess p $ \h -> do decrypt cipher (\toh -> L.hPut toh =<< L.hGetContents h) $ readBytes $ L.writeFile f diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 8c5fa795e..1c81377fc 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -197,15 +197,15 @@ storeHelper d chunksize key storer = check <&&> go writeFile f s void $ tryIO $ preventWrite f -retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve d chunksize k _ f = metered Nothing k $ \meterupdate -> +retrieve :: FilePath -> ChunkSize -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +retrieve d chunksize k _ f p = metered (Just p) k $ \meterupdate -> liftIO $ withStoredFiles chunksize d k $ \files -> catchBoolIO $ do meteredWriteFileChunks meterupdate f files $ L.readFile return True -retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted d chunksize (cipher, enck) k f = metered Nothing k $ \meterupdate -> +retrieveEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool +retrieveEncrypted d chunksize (cipher, enck) k f p = metered (Just p) k $ \meterupdate -> liftIO $ withStoredFiles chunksize d enck $ \files -> catchBoolIO $ do decrypt cipher (feeder files) $ diff --git a/Remote/Git.hs b/Remote/Git.hs index eecc9cf2a..4110c1491 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -271,8 +271,10 @@ dropKey r key [] {- Tries to copy a key's content from a remote's annex to a file. -} -copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool -copyFromRemote r key file dest +copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +copyFromRemote r key file dest _p = copyFromRemote' r key file dest +copyFromRemote' :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool +copyFromRemote' r key file dest | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do let params = rsyncParams r u <- getUUID @@ -338,7 +340,7 @@ copyFromRemoteCheap r key file liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True | Git.repoIsSsh (repo r) = ifM (Annex.Content.preseedTmp key file) - ( copyFromRemote r key Nothing file + ( copyFromRemote' r key Nothing file , return False ) | otherwise = return False @@ -367,7 +369,7 @@ copyToRemote r key file p ( return True , do ensureInitialized - download u key file noRetry $ + download u key file noRetry $ const $ Annex.Content.saveState True `after` Annex.Content.getViaTmpChecked (liftIO checksuccessio) key (\d -> rsyncOrCopyFile params object d p) diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 088c62fb3..65c978bd4 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -83,31 +83,31 @@ glacierSetup u c = do ] store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool -store r k _f m +store r k _f p | keySize k == Just 0 = do warning "Cannot store empty files in Glacier." return False | otherwise = sendAnnex k (void $ remove r k) $ \src -> - metered (Just m) k $ \meterupdate -> + metered (Just p) k $ \meterupdate -> storeHelper r k $ streamMeteredFile src meterupdate storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool -storeEncrypted r (cipher, enck) k m = sendAnnex k (void $ remove r enck) $ \src -> do - metered (Just m) k $ \meterupdate -> +storeEncrypted r (cipher, enck) k p = sendAnnex k (void $ remove r enck) $ \src -> do + metered (Just p) k $ \meterupdate -> storeHelper r enck $ \h -> encrypt (getGpgOpts r) cipher (feedFile src) (readBytes $ meteredWrite meterupdate h) -retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve r k _f d = metered Nothing k $ \meterupdate -> +retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +retrieve r k _f d p = metered (Just p) k $ \meterupdate -> retrieveHelper r k $ readBytes $ meteredWriteFile meterupdate d retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False -retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate -> +retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool +retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate -> retrieveHelper r enck $ readBytes $ \b -> decrypt cipher (feedBytes b) $ readBytes $ meteredWriteFile meterupdate d diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index b52d2e73a..b9a08bea6 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -54,7 +54,7 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of encryptableRemote :: RemoteConfig -> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool) - -> ((Cipher, Key) -> Key -> FilePath -> Annex Bool) + -> ((Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool) -> Remote -> Remote encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = @@ -70,9 +70,9 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = 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) + retrieve k f d p = cip k >>= maybe + (retrieveKeyFile r k f d p) + (\enck -> retrieveKeyFileEncrypted enck k d p) retrieveCheap k d = cip k >>= maybe (retrieveKeyFileCheap r k d) (\_ -> return False) diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index bdeb653eb..1aeb6cdcd 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -29,7 +29,7 @@ addHooks' r starthook stophook = r' where r' = r { storeKey = \k f p -> wrapper $ storeKey r k f p - , retrieveKeyFile = \k f d -> wrapper $ retrieveKeyFile r k f d + , retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p , 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 46ee8000f..9a4849b6e 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -116,14 +116,14 @@ storeEncrypted h gpgOpts (cipher, enck) k _p = withTmp enck $ \tmp -> readBytes $ L.writeFile tmp runHook h "store" enck (Just tmp) $ return True -retrieve :: String -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve h k _f d = runHook h "retrieve" k (Just d) $ return True +retrieve :: String -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +retrieve h k _f d _p = runHook h "retrieve" k (Just d) $ return True retrieveCheap :: String -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False -retrieveEncrypted :: String -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted h (cipher, enck) _ f = withTmp enck $ \tmp -> +retrieveEncrypted :: String -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool +retrieveEncrypted h (cipher, enck) _ f _p = withTmp enck $ \tmp -> runHook h "retrieve" enck (Just tmp) $ liftIO $ catchBoolIO $ do decrypt cipher (feedFile tmp) $ readBytes $ L.writeFile f diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index a5750437d..deaf4de46 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -115,20 +115,15 @@ storeEncrypted o gpgOpts (cipher, enck) k p = withTmp enck $ \tmp -> readBytes $ L.writeFile tmp rsyncSend o p enck True tmp -retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve o k _ f = untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o Nothing - -- use inplace when retrieving to support resuming - [ Param "--inplace" - , Param u - , Param f - ] +retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +retrieve o k _ f p = rsyncRetrieve o k f (Just p) retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool -retrieveCheap o k f = ifM (preseedTmp k f) ( retrieve o k undefined f , return False ) +retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False ) -retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted o (cipher, enck) _ f = withTmp enck $ \tmp -> - ifM (retrieve o enck undefined tmp) +retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool +retrieveEncrypted o (cipher, enck) _ f p = withTmp enck $ \tmp -> + ifM (rsyncRetrieve o enck tmp (Just p)) ( liftIO $ catchBoolIO $ do decrypt cipher (feedFile tmp) $ readBytes $ L.writeFile f @@ -197,6 +192,15 @@ withRsyncScratchDir a = do nuke d = liftIO $ whenM (doesDirectoryExist d) $ removeDirectoryRecursive d +rsyncRetrieve :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex Bool +rsyncRetrieve o k dest callback = + untilTrue (rsyncUrls o k) $ \u -> rsyncRemote o callback + -- use inplace when retrieving to support resuming + [ Param "--inplace" + , Param u + , Param dest + ] + rsyncRemote :: RsyncOpts -> (Maybe MeterUpdate) -> [CommandParam] -> Annex Bool rsyncRemote o callback params = do showOutput -- make way for progress bar diff --git a/Remote/S3.hs b/Remote/S3.hs index 017886694..00b5b5dc6 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -152,9 +152,9 @@ storeHelper (conn, bucket) r k p file = do xheaders = filter isxheader $ M.assocs $ config r isxheader (h, _) = "x-amz-" `isPrefixOf` h -retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve r k _f d = s3Action r False $ \(conn, bucket) -> - metered Nothing k $ \meterupdate -> do +retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +retrieve r k _f d p = s3Action r False $ \(conn, bucket) -> + metered (Just p) k $ \meterupdate -> do res <- liftIO $ getObject conn $ bucketKey r bucket k case res of Right o -> do @@ -166,9 +166,9 @@ retrieve r k _f d = s3Action r False $ \(conn, bucket) -> retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False -retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted r (cipher, enck) k d = s3Action r False $ \(conn, bucket) -> - metered Nothing k $ \meterupdate -> do +retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool +retrieveEncrypted r (cipher, enck) k d p = s3Action r False $ \(conn, bucket) -> + metered (Just p) k $ \meterupdate -> do res <- liftIO $ getObject conn $ bucketKey r bucket enck case res of Right o -> liftIO $ decrypt cipher (\h -> meteredWrite meterupdate h $ obj_data o) $ diff --git a/Remote/Web.hs b/Remote/Web.hs index 5af3c5228..2c59528ef 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -59,8 +59,8 @@ gen r _ _ gc = remotetype = remote } -downloadKey :: Key -> AssociatedFile -> FilePath -> Annex Bool -downloadKey key _file dest = get =<< getUrls key +downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +downloadKey key _file dest _p = get =<< getUrls key where get [] = do warning "no known url" diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index db5535494..0f94a2f08 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -118,8 +118,8 @@ storeHelper r k baseurl user pass b = catchBoolIO $ do retrieveCheap :: Remote -> Key -> FilePath -> Annex Bool retrieveCheap _ _ _ = return False -retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool -retrieve r k _f d = metered Nothing k $ \meterupdate -> +retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool +retrieve r k _f d p = metered (Just p) k $ \meterupdate -> davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $ withStoredFiles r k baseurl user pass onerr $ \urls -> do meteredWriteFileChunks meterupdate d urls $ \url -> do @@ -131,8 +131,8 @@ retrieve r k _f d = metered Nothing k $ \meterupdate -> where onerr _ = return False -retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> Annex Bool -retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate -> +retrieveEncrypted :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool +retrieveEncrypted r (cipher, enck) k d p = metered (Just p) k $ \meterupdate -> davAction r False $ \(baseurl, user, pass) -> liftIO $ catchBoolIO $ withStoredFiles r enck baseurl user pass onerr $ \urls -> do decrypt cipher (feeder user pass urls) $ |