better indicate when special remotes do not support renameExport
Avoid a warning message when renameExport is not supported, and just fallback to deleting with a subsequent re-upload. Especially needed for importtree remotes, where renameExport needs to be disabled. This changes the external special remote protocol, but in a backwards-compatible way. A reply of UNSUPPORTED-REQUEST to an older version of git-annex will cause it to make renameExport return False.
This commit is contained in:
parent
c755788256
commit
2912429640
11 changed files with 62 additions and 53 deletions
|
@ -379,15 +379,16 @@ startMoveFromTempName r db ek f = do
|
|||
f' = getTopFilePath f
|
||||
|
||||
performRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
|
||||
performRename r db ek src dest = do
|
||||
ifM (renameExport (exportActions r) (asKey ek) src dest)
|
||||
( next $ cleanupRename r db ek src dest
|
||||
-- In case the special remote does not support renaming,
|
||||
-- unexport the src instead.
|
||||
, do
|
||||
performRename r db ek src dest =
|
||||
renameExport (exportActions r) (asKey ek) src dest >>= \case
|
||||
Just True -> next $ cleanupRename r db ek src dest
|
||||
Just False -> do
|
||||
warning "rename failed; deleting instead"
|
||||
performUnexport r db [ek] src
|
||||
)
|
||||
fallbackdelete
|
||||
-- Remote does not support renaming, so don't warn about it.
|
||||
Nothing -> fallbackdelete
|
||||
where
|
||||
fallbackdelete = performUnexport r db [ek] src
|
||||
|
||||
cleanupRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup
|
||||
cleanupRename r db ek src dest = do
|
||||
|
|
|
@ -222,9 +222,9 @@ checkPresentExportM r serial adir _k loc = checkKey' r serial aloc
|
|||
where
|
||||
aloc = androidExportLocation adir loc
|
||||
|
||||
renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex Bool
|
||||
renameExportM serial adir _k old new = liftIO $ adbShellBool serial
|
||||
[Param "mv", Param "-f", File oldloc, File newloc]
|
||||
renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
|
||||
renameExportM serial adir _k old new = liftIO $ Just <$>
|
||||
adbShellBool serial [Param "mv", Param "-f", File oldloc, File newloc]
|
||||
where
|
||||
oldloc = fromAndroidPath $ androidExportLocation adir old
|
||||
newloc = fromAndroidPath $ androidExportLocation adir new
|
||||
|
|
|
@ -279,13 +279,15 @@ checkPresentExportM :: FilePath -> Key -> ExportLocation -> Annex Bool
|
|||
checkPresentExportM d _k loc =
|
||||
checkPresentGeneric d [exportPath d loc]
|
||||
|
||||
renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool
|
||||
renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do
|
||||
createDirectoryIfMissing True (takeDirectory dest)
|
||||
renameFile src dest
|
||||
removeExportLocation d oldloc
|
||||
return True
|
||||
renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
|
||||
renameExportM d _k oldloc newloc = liftIO $ Just <$> go
|
||||
where
|
||||
go = catchBoolIO $ do
|
||||
createDirectoryIfMissing True (takeDirectory dest)
|
||||
renameFile src dest
|
||||
removeExportLocation d oldloc
|
||||
return True
|
||||
|
||||
src = exportPath d oldloc
|
||||
dest = exportPath d newloc
|
||||
|
||||
|
|
|
@ -307,25 +307,28 @@ removeExportDirectoryM external dir = safely $
|
|||
where
|
||||
req = REMOVEEXPORTDIRECTORY dir
|
||||
|
||||
renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex Bool
|
||||
renameExportM external k src dest = safely $
|
||||
renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
|
||||
renameExportM external k src dest = safely' (Just False) $
|
||||
handleRequestExport external src req k Nothing $ \resp -> case resp of
|
||||
RENAMEEXPORT_SUCCESS k'
|
||||
| k' == k -> result True
|
||||
| k' == k -> result (Just True)
|
||||
RENAMEEXPORT_FAILURE k'
|
||||
| k' == k -> result False
|
||||
UNSUPPORTED_REQUEST -> result False
|
||||
| k' == k -> result (Just False)
|
||||
UNSUPPORTED_REQUEST -> result Nothing
|
||||
_ -> Nothing
|
||||
where
|
||||
req sk = RENAMEEXPORT sk dest
|
||||
|
||||
safely :: Annex Bool -> Annex Bool
|
||||
safely a = go =<< tryNonAsync a
|
||||
safely = safely' False
|
||||
|
||||
safely' :: a -> Annex a -> Annex a
|
||||
safely' onerr a = go =<< tryNonAsync a
|
||||
where
|
||||
go (Right r) = return r
|
||||
go (Left e) = do
|
||||
toplevelWarning False (show e)
|
||||
return False
|
||||
return onerr
|
||||
|
||||
{- Sends a Request to the external remote, and waits for it to generate
|
||||
- a Response. That is fed into the responsehandler, which should return
|
||||
|
|
|
@ -43,7 +43,7 @@ instance HasExportUnsupported (ExportActions Annex) where
|
|||
, checkPresentExport = \_ _ -> return False
|
||||
, removeExport = \_ _ -> return False
|
||||
, removeExportDirectory = Just $ \_ -> return False
|
||||
, renameExport = \_ _ _ -> return False
|
||||
, renameExport = \_ _ _ -> return Nothing
|
||||
}
|
||||
|
||||
-- | Use for remotes that do not support imports.
|
||||
|
@ -170,7 +170,7 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
|
|||
-- lose modifications to the file
|
||||
-- (by eg copying and then deleting)
|
||||
-- so don't use it
|
||||
, renameExport = \_ _ _ -> return False
|
||||
, renameExport = \_ _ _ -> return Nothing
|
||||
, checkPresentExport = checkpresent
|
||||
}
|
||||
, checkPresent = if appendonly r'
|
||||
|
|
|
@ -293,8 +293,8 @@ removeExportDirectoryM o ed = removeGeneric o (allbelow d : includes d)
|
|||
Nothing -> []
|
||||
Just f' -> includes f'
|
||||
|
||||
renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex Bool
|
||||
renameExportM _ _ _ _ = return False
|
||||
renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
|
||||
renameExportM _ _ _ _ = return Nothing
|
||||
|
||||
{- Rsync params to enable resumes of sending files safely,
|
||||
- ensure that files are only moved into place once complete
|
||||
|
|
19
Remote/S3.hs
19
Remote/S3.hs
|
@ -398,15 +398,17 @@ checkPresentExportS3 hv r info k loc = withS3Handle hv $ \case
|
|||
giveup "No S3 credentials configured"
|
||||
|
||||
-- S3 has no move primitive; copy and delete.
|
||||
renameExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex Bool
|
||||
renameExportS3 hv r info k src dest = withS3Handle hv $ \case
|
||||
Just h -> checkVersioning info (uuid r) k $
|
||||
catchNonAsync (go h) (\_ -> return False)
|
||||
Nothing -> do
|
||||
warning $ needS3Creds (uuid r)
|
||||
return False
|
||||
renameExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
|
||||
renameExportS3 hv r info k src dest = Just <$> go
|
||||
where
|
||||
go h = liftIO $ runResourceT $ do
|
||||
go = withS3Handle hv $ \case
|
||||
Just h -> checkVersioning info (uuid r) k $
|
||||
catchNonAsync (go' h) (\_ -> return False)
|
||||
Nothing -> do
|
||||
warning $ needS3Creds (uuid r)
|
||||
return False
|
||||
|
||||
go' h = liftIO $ runResourceT $ do
|
||||
let co = S3.copyObject (bucket info) dstobject
|
||||
(S3.ObjectId (bucket info) srcobject Nothing)
|
||||
S3.CopyMetadata
|
||||
|
@ -414,6 +416,7 @@ renameExportS3 hv r info k src dest = withS3Handle hv $ \case
|
|||
void $ sendS3Handle h $ co { S3.coAcl = acl info }
|
||||
void $ sendS3Handle h $ S3.DeleteObject srcobject (bucket info)
|
||||
return True
|
||||
|
||||
srcobject = T.pack $ bucketExportLocation info src
|
||||
dstobject = T.pack $ bucketExportLocation info dest
|
||||
|
||||
|
|
|
@ -239,19 +239,21 @@ removeExportDirectoryDav r dir = withDAVHandle r $ \mh -> runExport mh $ \_dav -
|
|||
safely (inLocation d delContentM)
|
||||
>>= maybe (return False) (const $ return True)
|
||||
|
||||
renameExportDav :: Remote -> Key -> ExportLocation -> ExportLocation -> Annex Bool
|
||||
renameExportDav :: Remote -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)
|
||||
renameExportDav r _k src dest = case (exportLocation src, exportLocation dest) of
|
||||
(Right srcl, Right destl) -> withDAVHandle r $ \case
|
||||
Just h
|
||||
-- box.com's DAV endpoint has buggy handling of renames,
|
||||
-- so avoid renaming when using it.
|
||||
| boxComUrl `isPrefixOf` baseURL h -> return False
|
||||
| otherwise -> runExport (Just h) $ \dav -> do
|
||||
maybe noop (void . mkColRecursive) (locationParent destl)
|
||||
moveDAV (baseURL dav) srcl destl
|
||||
return True
|
||||
Nothing -> return False
|
||||
_ -> return False
|
||||
| boxComUrl `isPrefixOf` baseURL h -> return Nothing
|
||||
| otherwise -> do
|
||||
v <- runExport (Just h) $ \dav -> do
|
||||
maybe noop (void . mkColRecursive) (locationParent destl)
|
||||
moveDAV (baseURL dav) srcl destl
|
||||
return True
|
||||
return (Just v)
|
||||
Nothing -> return (Just False)
|
||||
_ -> return (Just False)
|
||||
|
||||
runExport :: Maybe DavHandle -> (DavHandle -> DAVT IO Bool) -> Annex Bool
|
||||
runExport Nothing _ = return False
|
||||
|
|
|
@ -242,9 +242,9 @@ data ExportActions a = ExportActions
|
|||
-- Throws an exception if the remote cannot be accessed.
|
||||
, checkPresentExport :: Key -> ExportLocation -> a Bool
|
||||
-- Renames an already exported file.
|
||||
-- This may fail, if the file doesn't exist, or the remote does not
|
||||
-- support renames.
|
||||
, renameExport :: Key -> ExportLocation -> ExportLocation -> a Bool
|
||||
-- This may fail with False, if the file doesn't exist.
|
||||
-- If the remote does not support renames, it can return Nothing.
|
||||
, renameExport :: Key -> ExportLocation -> ExportLocation -> a (Maybe Bool)
|
||||
}
|
||||
|
||||
data ImportActions a = ImportActions
|
||||
|
|
|
@ -211,7 +211,8 @@ replying with `UNSUPPORTED-REQUEST` is acceptable.
|
|||
Requests the remote rename a file stored on it from the previously
|
||||
provided Name to the NewName.
|
||||
The remote responds with `RENAMEEXPORT-SUCCESS` or
|
||||
`RENAMEEXPORT-FAILURE`.
|
||||
`RENAMEEXPORT-FAILURE` or with `UNSUPPORTED-REQUEST` if renaming is not
|
||||
supported.
|
||||
|
||||
To support old external special remote programs that have not been updated
|
||||
to support exports, git-annex will need to handle an `ERROR` response
|
||||
|
@ -318,7 +319,8 @@ while it's handling a request.
|
|||
* `REMOVEEXPORTDIRECTORY-FAILURE`
|
||||
Indicates that a `REMOVEEXPORTDIRECTORY` failed for whatever reason.
|
||||
* `UNSUPPORTED-REQUEST`
|
||||
Indicates that the special remote does not know how to handle a request.
|
||||
Indicates that the special remote does not know how to handle a request,
|
||||
or cannot handle the request.
|
||||
|
||||
## special remote messages
|
||||
|
||||
|
|
|
@ -10,10 +10,6 @@ this.
|
|||
|
||||
## implementation notes
|
||||
|
||||
* renameExport is disabled in a way that makes export tree
|
||||
complain unncessarily verbosely. Perhaps change renameExport
|
||||
to a Maybe so it can know when it's not available.
|
||||
|
||||
* Does export of master:subdir update the remote tracking branch right?
|
||||
|
||||
* Does sync --content with remote.name.annex-tracking-branch=master:subdir
|
||||
|
|
Loading…
Reference in a new issue