From 7cef5e8f35d211f09eee0af5f8ea0bf689a1d012 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 9 Mar 2024 13:37:51 -0400 Subject: [PATCH] export tree: avoid confusing output about renaming files When a file in the export is renamed, and the remote's renameExport returned Nothing, renaming to the temp file would first say it was renaming, and appear to succeed, but actually what it did was delete the file. Then renaming from the temp file would not do anything, since the temp file is not present on the remote. This appeared as if a file got renamed to a temp file and left there. Note that exporttree=yes importree=yes remotes have their usual renameExport replaced with one that returns Nothing. (For reasons explained in Remote.Helper.ExportImport.) So this happened even with remotes that support renameExport. Fix by letting renameExport = Nothing when it's not supported at all. This avoids displaying the rename. Sponsored-by: Graham Spencer on Patreon --- Command/Export.hs | 23 +++++++++++++---------- Remote/Adb.hs | 2 +- Remote/Directory.hs | 2 +- Remote/External.hs | 2 +- Remote/Helper/ExportImport.hs | 4 ++-- Remote/Helper/ReadOnly.hs | 5 +---- Remote/Rsync.hs | 2 +- Remote/S3.hs | 2 +- Remote/WebDAV.hs | 2 +- Types/Remote.hs | 2 +- 10 files changed, 23 insertions(+), 23 deletions(-) diff --git a/Command/Export.hs b/Command/Export.hs index bca9c9ffed..d0604aa8e1 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -406,9 +406,10 @@ startRecoverIncomplete r db sha oldf oldloc = mkExportLocation $ getTopFilePath oldf startMoveToTempName :: Remote -> ExportHandle -> TopFilePath -> Key -> CommandStart -startMoveToTempName r db f ek = - starting ("rename " ++ name r) ai si $ +startMoveToTempName r db f ek = case renameExport (exportActions r) of + Just _ -> starting ("rename " ++ name r) ai si $ performRename r db ek loc tmploc + Nothing -> stop where loc = mkExportLocation f' f' = getTopFilePath f @@ -418,27 +419,29 @@ startMoveToTempName r db f ek = si = SeekInput [] startMoveFromTempName :: Remote -> ExportHandle -> Key -> TopFilePath -> CommandStart -startMoveFromTempName r db ek f = do - let tmploc = exportTempName ek - let ai = ActionItemOther $ Just $ - QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f' - stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $ +startMoveFromTempName r db ek f = case renameExport (exportActions r) of + Just _ -> stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $ starting ("rename " ++ name r) ai si $ performRename r db ek tmploc loc + Nothing -> stop where loc = mkExportLocation f' f' = getTopFilePath f + tmploc = exportTempName ek + ai = ActionItemOther $ Just $ + QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f' si = SeekInput [] performRename :: Remote -> ExportHandle -> Key -> ExportLocation -> ExportLocation -> CommandPerform -performRename r db ek src dest = - tryNonAsync (renameExport (exportActions r) ek src dest) >>= \case +performRename r db ek src dest = case renameExport (exportActions r) of + Just renameaction -> tryNonAsync (renameaction ek src dest) >>= \case Right (Just ()) -> next $ cleanupRename r db ek src dest Left err -> do warning $ UnquotedString $ "rename failed (" ++ show err ++ "); deleting instead" fallbackdelete - -- remote does not support renaming Right Nothing -> fallbackdelete + -- remote does not support renaming + Nothing -> fallbackdelete where fallbackdelete = performUnexport r db [ek] src diff --git a/Remote/Adb.hs b/Remote/Adb.hs index 214733080c..9848833147 100644 --- a/Remote/Adb.hs +++ b/Remote/Adb.hs @@ -94,7 +94,7 @@ gen r u rc gc rs = do , versionedExport = False , checkPresentExport = checkPresentExportM serial adir , removeExportDirectory = Just $ removeExportDirectoryM serial adir - , renameExport = renameExportM serial adir + , renameExport = Just $ renameExportM serial adir } , importActions = ImportActions { listImportableContents = listImportableContentsM serial adir c diff --git a/Remote/Directory.hs b/Remote/Directory.hs index c83064ad78..82b7f114f0 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -112,7 +112,7 @@ gen r u rc gc rs = do -- Not needed because removeExportLocation -- auto-removes empty directories. , removeExportDirectory = Nothing - , renameExport = renameExportM dir + , renameExport = Just $ renameExportM dir } , importActions = ImportActions { listImportableContents = listImportableContentsM ii dir diff --git a/Remote/External.hs b/Remote/External.hs index d75c3ebb45..9b9961c7d1 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -98,7 +98,7 @@ gen r u rc gc rs , versionedExport = False , checkPresentExport = checkPresentExportM external , removeExportDirectory = Just $ removeExportDirectoryM external - , renameExport = renameExportM external + , renameExport = Just $ renameExportM external } else exportUnsupported -- Cheap exportSupported that replaces the expensive diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs index 377c4a7274..6d95ad1cf2 100644 --- a/Remote/Helper/ExportImport.hs +++ b/Remote/Helper/ExportImport.hs @@ -41,7 +41,7 @@ instance HasExportUnsupported (ExportActions Annex) where , removeExport = nope , versionedExport = False , removeExportDirectory = nope - , renameExport = \_ _ _ -> return Nothing + , renameExport = Nothing } where nope = giveup "export not supported" @@ -257,7 +257,7 @@ adjustExportImport' isexport isimport r rs = do -- renameExport is optional, and the remote's -- implementation may lose modifications to the file -- (by eg copying and then deleting) so don't use it - , renameExport = \_ _ _ -> return Nothing + , renameExport = Nothing , checkPresentExport = checkPresentImport ciddbv } diff --git a/Remote/Helper/ReadOnly.hs b/Remote/Helper/ReadOnly.hs index 71e31fdd0b..abce2fe2f4 100644 --- a/Remote/Helper/ReadOnly.hs +++ b/Remote/Helper/ReadOnly.hs @@ -34,7 +34,7 @@ adjustReadOnly r { storeExport = readonlyStoreExport , removeExport = readonlyRemoveExport , removeExportDirectory = Just readonlyRemoveExportDirectory - , renameExport = readonlyRenameExport + , renameExport = Nothing } , importActions = (importActions r) { storeExportWithContentIdentifier = readonlyStoreExportWithContentIdentifier @@ -62,9 +62,6 @@ readonlyRemoveExport _ _ = readonlyFail readonlyRemoveExportDirectory :: ExportDirectory -> Annex () readonlyRemoveExportDirectory _ = readonlyFail -readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) -readonlyRenameExport _ _ _ = return Nothing - readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index aaf0848b86..b225f8db14 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -106,7 +106,7 @@ gen r u rc gc rs = do , versionedExport = False , checkPresentExport = checkPresentExportM o , removeExportDirectory = Just (removeExportDirectoryM o) - , renameExport = renameExportM o + , renameExport = Just $ renameExportM o } , importActions = importUnsupported , whereisKey = Nothing diff --git a/Remote/S3.hs b/Remote/S3.hs index a2ab5a61ff..d2db401fe9 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -228,7 +228,7 @@ gen r u rc gc rs = do , checkPresentExport = checkPresentExportS3 hdl this info -- S3 does not have directories. , removeExportDirectory = Nothing - , renameExport = renameExportS3 hdl this rs info + , renameExport = Just $ renameExportS3 hdl this rs info } , importActions = ImportActions { listImportableContents = listImportableContentsS3 hdl this info c diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 08594dfba4..ab781c390e 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -104,7 +104,7 @@ gen r u rc gc rs = do , versionedExport = False , removeExportDirectory = Just $ removeExportDirectoryDav hdl - , renameExport = renameExportDav hdl + , renameExport = Just $ renameExportDav hdl } , importActions = importUnsupported , whereisKey = Nothing diff --git a/Types/Remote.hs b/Types/Remote.hs index 971c4a87c6..e4575eb3cd 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -302,7 +302,7 @@ data ExportActions a = ExportActions -- -- Throws an exception if the remote cannot be accessed, or -- the file doesn't exist or cannot be renamed. - , renameExport :: Key -> ExportLocation -> ExportLocation -> a (Maybe ()) + , renameExport :: Maybe (Key -> ExportLocation -> ExportLocation -> a (Maybe ())) } data ImportActions a = ImportActions -- 2.30.2