diff options
| -rw-r--r-- | Annex/Content.hs | 11 | ||||
| -rw-r--r-- | Remote/Git.hs | 10 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 11 |
3 files changed, 19 insertions, 13 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index ba67a2f15..efd360a09 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -22,6 +22,7 @@ module Annex.Content ( getKeysPresent, saveState, downloadUrl, + preseedTmp, ) where import System.IO.Error (try) @@ -40,6 +41,7 @@ import Utility.FileMode import qualified Utility.Url as Url import Types.Key import Utility.DataUnits +import Utility.CopyFile import Config import Annex.Exception @@ -301,3 +303,12 @@ downloadUrl urls file = do g <- gitRepo o <- map Param . words <$> getConfig g "web-options" "" liftIO $ anyM (\u -> Url.download u o file) urls + +{- Copies a key's content, when present, to a temp file. + - This is used to speed up some rsyncs. -} +preseedTmp :: Key -> FilePath -> Annex () +preseedTmp key file = + unlessM (liftIO $ doesFileExist file) $ whenM (inAnnex key) $ do + s <- inRepo $ gitAnnexLocation key + liftIO $ whenM (copyFileExternal s file) $ + allowWrite file diff --git a/Remote/Git.hs b/Remote/Git.hs index 5dae3334e..2196292cd 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -199,12 +199,16 @@ dropKey r key {- Tries to copy a key's content from a remote's annex to a file. -} copyFromRemote :: Git.Repo -> Key -> Bool -> FilePath -> Annex Bool -copyFromRemote r key _ file +copyFromRemote r key tmp file | not $ Git.repoIsUrl r = do params <- rsyncParams r loc <- liftIO $ gitAnnexLocation key r - rsyncOrCopyFile params loc file - | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file + if tmp + then liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True + else rsyncOrCopyFile params loc file + | Git.repoIsSsh r = do + when tmp $ Annex.Content.preseedTmp key file + rsyncHelper =<< rsyncParamsRemote r True key file | Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) file | otherwise = error "copying from non-ssh, non-http repo not supported" diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index b4ff3d6f1..a1722fe17 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -19,8 +19,6 @@ import Remote.Helper.Special import Remote.Helper.Encryptable import Crypto import Utility.RsyncFile -import Utility.CopyFile -import Utility.FileMode type RsyncUrl = String @@ -106,20 +104,13 @@ storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do retrieve :: RsyncOpts -> Key -> Bool -> FilePath -> Annex Bool retrieve o k tmp f = untilTrue (rsyncUrls o k) $ \u -> do - when tmp $ preseed + when tmp $ preseedTmp k f rsyncRemote o -- use inplace when retrieving to support resuming [ Param "--inplace" , Param u , Param f ] - where - -- this speeds up fsck --from - preseed = unlessM (liftIO $ doesFileExist f) $ - whenM (inAnnex k) $ do - s <- inRepo $ gitAnnexLocation k - liftIO $ whenM (copyFileExternal s f) $ - allowWrite f retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> FilePath -> Annex Bool retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do |