This commit is contained in:
Joey Hess 2021-03-05 14:17:48 -04:00
parent 1b041f5c51
commit cdd512cd9f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 19 additions and 17 deletions

View file

@ -17,6 +17,8 @@ import qualified Git
import qualified Types.Remote as Remote
import Messages
import Data.Maybe
-- From a sha pointing to the content of a file to the key
-- to use to export it. When the file is annexed, it's the annexed key.
-- When the file is stored in git, it's a special type of key to indicate
@ -48,6 +50,10 @@ keyGitSha k
Just (Git.Ref (fromKey keyName k))
| otherwise = Nothing
-- Is a key storing a git sha, and not used for an annexed file?
isGitShaKey :: Key -> Bool
isGitShaKey = isJust . keyGitSha
warnExportImportConflict :: Remote -> Annex ()
warnExportImportConflict r = do
isimport <- Remote.isImportSupported r

View file

@ -180,11 +180,10 @@ recordImportTree remote importtreeconfig importable = do
let stillpresent db k = liftIO $ not . null
<$> Export.getExportedLocation db k
let updater db moldkey _newkey _ = case moldkey of
Just oldkey -> case keyGitSha oldkey of
Nothing -> unlessM (stillpresent db oldkey) $
Just oldkey | not (isGitShaKey oldkey) ->
unlessM (stillpresent db oldkey) $
logChange oldkey (Remote.uuid remote) InfoMissing
Just _ -> noop
Nothing -> noop
_ -> noop
db <- Export.openDb (Remote.uuid remote)
forM_ (exportedTreeishes oldexport) $ \oldtree ->
Export.runExportDiffUpdater updater db oldtree finaltree

View file

@ -280,8 +280,8 @@ startExport r db cvar allfilledvar ti = do
performExport :: Remote -> ExportHandle -> Key -> AssociatedFile -> Sha -> ExportLocation -> MVar AllFilled -> CommandPerform
performExport r db ek af contentsha loc allfilledvar = do
let storer = storeExport (exportActions r)
sent <- tryNonAsync $ case keyGitSha ek of
Nothing -> ifM (inAnnex ek)
sent <- tryNonAsync $ if not (isGitShaKey ek)
then ifM (inAnnex ek)
( notifyTransfer Upload af $
-- alwaysUpload because the same key
-- could be used for more than one export
@ -298,13 +298,12 @@ performExport r db ek af contentsha loc allfilledvar = do
return False
)
-- Sending a non-annexed file.
Just _ ->
withTmpFile "export" $ \tmp h -> do
b <- catObject contentsha
liftIO $ L.hPut h b
liftIO $ hClose h
Remote.action $
storer tmp ek loc nullMeterUpdate
else withTmpFile "export" $ \tmp h -> do
b <- catObject contentsha
liftIO $ L.hPut h b
liftIO $ hClose h
Remote.action $
storer tmp ek loc nullMeterUpdate
let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False))
case sent of
Right True -> next $ cleanupExport r db ek loc True
@ -318,10 +317,8 @@ performExport r db ek af contentsha loc allfilledvar = do
cleanupExport :: Remote -> ExportHandle -> Key -> ExportLocation -> Bool -> CommandCleanup
cleanupExport r db ek loc sent = do
liftIO $ addExportedLocation db ek loc
when sent $
case keyGitSha ek of
Nothing -> logChange ek (uuid r) InfoPresent
Just _ -> noop
when (sent && not (isGitShaKey ek)) $
logChange ek (uuid r) InfoPresent
return True
startUnexport :: Remote -> ExportHandle -> TopFilePath -> [Git.Sha] -> CommandStart