improve error display when storing to an export/import remote fails

Prompted by the test suite on windows failing to with "export foo failed"
and no information about what went wrong.

Note that only storeExportWithContentIdentifier has been converted.
storeExport still returns a Bool and so exceptions may be hidden.

However, storeExportWithContentIdentifier has many more failure modes,
since it needs to avoid overwriting modified files. So it's more
important it have better error display.
This commit is contained in:
Joey Hess 2019-08-13 12:05:00 -04:00
parent 05d52f9699
commit 5004381dd9
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 37 additions and 33 deletions

View file

@ -395,20 +395,22 @@ retrieveExportWithContentIdentifierM dir loc cid dest mkkey p =
| currcid == Just cid = cont
| otherwise = return Nothing
storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)
storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)
storeExportWithContentIdentifierM dir src _k loc overwritablecids p =
catchDefaultIO Nothing $ do
catchIO go (return . Left . show)
where
go = do
liftIO $ createDirectoryIfMissing True destdir
withTmpFileIn destdir template $ \tmpf tmph -> do
liftIO $ withMeteredFile src p (L.hPut tmph)
liftIO $ hFlush tmph
liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case
Nothing -> return Nothing
Nothing ->
return $ Left "unable to generate content identifier"
Just newcid ->
checkExportContent dir loc (newcid:overwritablecids) Nothing $ const $ do
checkExportContent dir loc (newcid:overwritablecids) (Left "unsafe to overwrite file") $ const $ do
liftIO $ rename tmpf dest
return (Just newcid)
where
return (Right newcid)
dest = exportPath dir loc
(destdir, base) = splitFileName dest
template = relatedTemplate (base ++ ".tmp")