From b15366494a641f5b48e829e6f8de0b41395bcfe5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 21 Jul 2023 14:57:29 -0400 Subject: [PATCH] directory: Remove empty hash directories when dropping content Failure to remove is not treated as a problem, and no permissions modifications are done, to avoid unexpected states. Sponsored-by: Luke Shumaker on Patreon --- CHANGELOG | 1 + Remote/Directory.hs | 21 +++++++++++++++---- Remote/GCrypt.hs | 2 +- ...34___special_remote_leaves_empty_dirs.mdwn | 2 ++ ..._8cef8650103d118fbbe56d20a4f59f96._comment | 16 ++++++++++++++ 5 files changed, 37 insertions(+), 5 deletions(-) create mode 100644 doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs/comment_1_8cef8650103d118fbbe56d20a4f59f96._comment diff --git a/CHANGELOG b/CHANGELOG index bb001943cc..8eafb7bd6f 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -22,6 +22,7 @@ git-annex (10.20230627) UNRELEASED; urgency=medium * S3: Allow setting publicurl=yes without public=yes, to support buckets that are configured with a Bucket Policy that allows public access. + * directory: Remove empty hash directories when dropping content. * dropunused: Support --jobs -- Joey Hess Mon, 26 Jun 2023 13:10:40 -0400 diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 4d91b2551e..b5f756716c 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -232,7 +232,7 @@ checkDiskSpaceDirectory d k = do - down. -} finalizeStoreGeneric :: RawFilePath -> RawFilePath -> RawFilePath -> IO () finalizeStoreGeneric d tmp dest = do - removeDirGeneric (fromRawFilePath d) dest' + removeDirGeneric False (fromRawFilePath d) dest' createDirectoryUnder [d] (parentDir dest) renameDirectory (fromRawFilePath tmp) dest' -- may fail on some filesystems @@ -266,7 +266,7 @@ retrieveKeyFileCheapM _ _ = Nothing #endif removeKeyM :: RawFilePath -> Remover -removeKeyM d k = liftIO $ removeDirGeneric +removeKeyM d k = liftIO $ removeDirGeneric True (fromRawFilePath d) (fromRawFilePath (storeDir d k)) @@ -279,9 +279,13 @@ removeKeyM d k = liftIO $ removeDirGeneric - 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. + - + - Empty parent directories (up to but not including the topdir) + - can also be removed. Failure to remove such a directory is not treated + - as an error. -} -removeDirGeneric :: FilePath -> FilePath -> IO () -removeDirGeneric topdir dir = do +removeDirGeneric :: Bool -> FilePath -> FilePath -> IO () +removeDirGeneric removeemptyparents topdir dir = do void $ tryIO $ allowWrite (toRawFilePath dir) #ifdef mingw32_HOST_OS {- Windows needs the files inside the directory to be writable @@ -293,6 +297,15 @@ removeDirGeneric topdir dir = do Left e -> unlessM (doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)) $ throwM e + when removeemptyparents $ do + subdir <- relPathDirToFile (toRawFilePath topdir) (P.takeDirectory (toRawFilePath dir)) + goparents (Just (P.takeDirectory subdir)) (Right ()) + where + goparents _ (Left _e) = return () + goparents Nothing _ = return () + goparents (Just subdir) _ = do + let d = topdir fromRawFilePath subdir + goparents (upFrom subdir) =<< tryIO (removeDirectory d) checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 3429c1a037..fec30195c9 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -439,7 +439,7 @@ remove r rsyncopts accessmethod k = do remove' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> AccessMethod -> Remover remove' repo r rsyncopts accessmethod k | not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ - liftIO $ Remote.Directory.removeDirGeneric + liftIO $ Remote.Directory.removeDirGeneric False (fromRawFilePath (Git.repoPath repo)) (fromRawFilePath (parentDir (toRawFilePath (gCryptLocation repo k)))) | Git.repoIsSsh repo = shellOrRsync r removeshell removersync diff --git a/doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs.mdwn b/doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs.mdwn index a7a95567e8..148f57ebed 100644 --- a/doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs.mdwn +++ b/doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs.mdwn @@ -112,3 +112,5 @@ drop sp_rsync a ok I'm tinkering with annex for about 1 week, "doing research" in preparation to use it as storage for backups. + +> [[fixed|done]] --[[Joey]] diff --git a/doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs/comment_1_8cef8650103d118fbbe56d20a4f59f96._comment b/doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs/comment_1_8cef8650103d118fbbe56d20a4f59f96._comment new file mode 100644 index 0000000000..2d75add7f6 --- /dev/null +++ b/doc/bugs/__34__directory__34___special_remote_leaves_empty_dirs/comment_1_8cef8650103d118fbbe56d20a4f59f96._comment @@ -0,0 +1,16 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 1""" + date="2023-07-21T18:08:52Z" + content=""" +Hmm, I guess this wasn't implemented because a generally small number of +hash directories are not a bother. And because implementing it was a bit +annoying. + +Testremote cannot test for this, because remotes do not need to have the +concept of a "directory". For example, a S3 bucket does not contain +directories, only filenames that may contain a "/" in them. Also, I don't +think it's necessarily a bug for a special remote to leave hash directories +in place when removing files. There could be good reasons to do that in +some cases. +"""]] -- 2.30.2