diff options
Diffstat (limited to 'Remote/Rsync.hs')
| -rw-r--r-- | Remote/Rsync.hs | 39 |
1 files changed, 23 insertions, 16 deletions
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index c28142077..68566c52a 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -92,11 +92,6 @@ rsyncUrls o k = map use annexHashes use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f) f = keyFile k -rsyncUrlDirs :: RsyncOpts -> Key -> [String] -rsyncUrlDirs o k = map use annexHashes - where - use h = rsyncUrl o </> h k </> rsyncEscape o (keyFile k) - store :: RsyncOpts -> Key -> Annex Bool store o k = rsyncSend o k =<< inRepo (gitAnnexLocation k) @@ -125,17 +120,29 @@ retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do else return res remove :: RsyncOpts -> Key -> Annex Bool -remove o k = untilTrue (rsyncUrlDirs o k) $ \d -> - withRsyncScratchDir $ \tmp -> liftIO $ do - {- Send an empty directory to rysnc as the - - parent directory of the file to remove. -} - let dummy = tmp </> keyFile k - createDirectoryIfMissing True dummy - rsync $ rsyncOptions o ++ - [ Params "--quiet --delete --recursive" - , partialParams - , Param $ addTrailingPathSeparator dummy - , Param d +remove o k = withRsyncScratchDir $ \tmp -> liftIO $ do + {- Send an empty directory to rysnc to make it delete. -} + let dummy = tmp </> keyFile k + createDirectoryIfMissing True dummy + rsync $ rsyncOptions o ++ + map (\s -> Param $ "--include=" ++ s) includes ++ + [ Param "--exclude=*" -- exclude everything else + , Params "--quiet --delete --recursive" + , partialParams + , Param $ addTrailingPathSeparator dummy + , Param $ rsyncUrl o + ] + where + {- Specify include rules to match the directories where the + - content could be. Note that the parent directories have + - to also be explicitly included, due to how rsync + - traverses directories. -} + includes = concatMap use annexHashes + use h = let dir = h k in + [ parentDir dir + , dir + -- match content directory and anything in it + , dir </> keyFile k </> "***" ] checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either String Bool) |