diff --git a/Remote/Directory.hs b/Remote/Directory.hs index db141e01ad..3b54ad2000 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -7,7 +7,7 @@ {-# LANGUAGE CPP #-} -module Remote.Directory (remote) where +module Remote.Directory (remote, removeDirGeneric) where import qualified Data.ByteString.Lazy as L import qualified Data.Map as M @@ -152,7 +152,20 @@ retrieveCheap _ _ _ _ = return False #endif remove :: FilePath -> Key -> Annex Bool -remove d k = liftIO $ do +remove d k = liftIO $ removeDirGeneric d (storeDir d k) + +{- Removes the directory, which must be located under the topdir. + - + - Succeeds even on directories and contents that do not have write + - permission. + - + - If the directory does not exist, succeeds as long as the topdir does + - exist. If the topdir does not exist, fails, because in this case the + - remote is not currently accessible and probably still has the content + - we were supposed to remove from it. + -} +removeDirGeneric :: FilePath -> FilePath -> IO Bool +removeDirGeneric topdir dir = do void $ tryIO $ allowWrite dir #ifdef mingw32_HOST_OS {- Windows needs the files inside the directory to be writable @@ -162,14 +175,9 @@ remove d k = liftIO $ do ok <- catchBoolIO $ do removeDirectoryRecursive dir return True - {- Removing the subdirectory will fail if it doesn't exist. - - But, we want to succeed in that case, as long as the directory - - remote's top-level directory does exist. -} if ok then return ok - else doesDirectoryExist d <&&> (not <$> doesDirectoryExist dir) - where - dir = storeDir d k + else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir) checkPresent :: FilePath -> ChunkConfig -> Key -> Annex (Either String Bool) checkPresent d (LegacyChunks _) k = Legacy.checkPresent d locations k diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 02c31f38d0..a0292a954d 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -40,6 +40,7 @@ import Utility.Metered import Annex.UUID import Annex.Ssh import qualified Remote.Rsync +import qualified Remote.Directory import Utility.Rsync import Utility.Tmp import Logs.Remote @@ -335,14 +336,8 @@ retrieve r rsyncopts remove :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex Bool remove r rsyncopts k - | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do - let f = gCryptLocation r k - let d = parentDir f - liftIO $ do - allowWrite d - allowWrite f - removeDirectoryRecursive d - return True + | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ + liftIO $ Remote.Directory.removeDirGeneric (Git.repoLocation (repo r)) (parentDir (gCryptLocation r k)) | Git.repoIsSsh (repo r) = shellOrRsync r removeshell removersync | otherwise = unsupportedUrl where