remove "checking remotename" message
This fixes fsck of a remote that uses chunking displaying (checking remotename) (checking remotename)" for every chunk. Also, some remotes displayed the message, and others did not, with no consistency. It was originally displayed only when accessing remotes that were expensive or might involve a password prompt, I think, but nothing in the API said when to do it so it became an inconsistent mess. Originally I thought fsck should always display it. But it only displays in fsck --from remote, so the user knows the remote is being accessed, so there is no reason to tell them it's accessing it over and over. It was also possible for git-annex move to sometimes display it twice, due to checking if content is present twice. But, the user of move specifies --from/--to, so it does not need to display when it's accessing the remote, as the user expects it to access the remote. git-annex get might display it, but only if the remote also supports hasKeyCheap, which is really only local git remotes, which didn't display it always; and in any case nothing displayed it before hasKeyCheap, which is checked first, so I don't think this needs to display it ever. mirror is like move. And that's all the main places it would have been displayed. This commit was sponsored by Jochen Bartl on Patreon.
This commit is contained in:
parent
f58fb5a610
commit
f8836306fa
14 changed files with 36 additions and 66 deletions
|
@ -15,7 +15,6 @@ import Types.Import
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
|
@ -77,7 +76,7 @@ gen r u rc gc rs = do
|
||||||
, retrieveExport = retrieveExportM serial adir
|
, retrieveExport = retrieveExportM serial adir
|
||||||
, removeExport = removeExportM serial adir
|
, removeExport = removeExportM serial adir
|
||||||
, versionedExport = False
|
, versionedExport = False
|
||||||
, checkPresentExport = checkPresentExportM this serial adir
|
, checkPresentExport = checkPresentExportM serial adir
|
||||||
, removeExportDirectory = Just $ removeExportDirectoryM serial adir
|
, removeExportDirectory = Just $ removeExportDirectoryM serial adir
|
||||||
, renameExport = renameExportM serial adir
|
, renameExport = renameExportM serial adir
|
||||||
}
|
}
|
||||||
|
@ -115,7 +114,7 @@ gen r u rc gc rs = do
|
||||||
(store serial adir)
|
(store serial adir)
|
||||||
(retrieve serial adir)
|
(retrieve serial adir)
|
||||||
(remove serial adir)
|
(remove serial adir)
|
||||||
(checkKey this serial adir)
|
(checkKey serial adir)
|
||||||
this
|
this
|
||||||
where
|
where
|
||||||
adir = maybe (giveup "missing androiddirectory") AndroidPath
|
adir = maybe (giveup "missing androiddirectory") AndroidPath
|
||||||
|
@ -214,12 +213,11 @@ remove' :: AndroidSerial -> AndroidPath -> Annex Bool
|
||||||
remove' serial aloc = adbShellBool serial
|
remove' serial aloc = adbShellBool serial
|
||||||
[Param "rm", Param "-f", File (fromAndroidPath aloc)]
|
[Param "rm", Param "-f", File (fromAndroidPath aloc)]
|
||||||
|
|
||||||
checkKey :: Remote -> AndroidSerial -> AndroidPath -> CheckPresent
|
checkKey :: AndroidSerial -> AndroidPath -> CheckPresent
|
||||||
checkKey r serial adir k = checkKey' r serial (androidLocation adir k)
|
checkKey serial adir k = checkKey' serial (androidLocation adir k)
|
||||||
|
|
||||||
checkKey' :: Remote -> AndroidSerial -> AndroidPath -> Annex Bool
|
checkKey' :: AndroidSerial -> AndroidPath -> Annex Bool
|
||||||
checkKey' r serial aloc = do
|
checkKey' serial aloc = do
|
||||||
showChecking r
|
|
||||||
out <- adbShellRaw serial $ unwords
|
out <- adbShellRaw serial $ unwords
|
||||||
[ "if test -e ", shellEscape (fromAndroidPath aloc)
|
[ "if test -e ", shellEscape (fromAndroidPath aloc)
|
||||||
, "; then echo y"
|
, "; then echo y"
|
||||||
|
@ -268,8 +266,8 @@ removeExportDirectoryM serial abase dir =
|
||||||
go = adbShellBool serial [Param "rm", Param "-rf", File (fromAndroidPath adir)]
|
go = adbShellBool serial [Param "rm", Param "-rf", File (fromAndroidPath adir)]
|
||||||
adir = androidExportLocation abase (mkExportLocation (fromExportDirectory dir))
|
adir = androidExportLocation abase (mkExportLocation (fromExportDirectory dir))
|
||||||
|
|
||||||
checkPresentExportM :: Remote -> AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool
|
checkPresentExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> Annex Bool
|
||||||
checkPresentExportM r serial adir _k loc = checkKey' r serial aloc
|
checkPresentExportM serial adir _k loc = checkKey' serial aloc
|
||||||
where
|
where
|
||||||
aloc = androidExportLocation adir loc
|
aloc = androidExportLocation adir loc
|
||||||
|
|
||||||
|
|
|
@ -27,7 +27,6 @@ import Config.Cost
|
||||||
import qualified Remote.Helper.Ssh as Ssh
|
import qualified Remote.Helper.Ssh as Ssh
|
||||||
import Annex.SpecialRemote.Config
|
import Annex.SpecialRemote.Config
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Utility.Hash
|
import Utility.Hash
|
||||||
import Utility.UserInfo
|
import Utility.UserInfo
|
||||||
|
@ -110,7 +109,7 @@ gen r u rc gc rs = do
|
||||||
(store this buprepo)
|
(store this buprepo)
|
||||||
(retrieve buprepo)
|
(retrieve buprepo)
|
||||||
(remove buprepo)
|
(remove buprepo)
|
||||||
(checkKey r bupr')
|
(checkKey bupr')
|
||||||
this
|
this
|
||||||
where
|
where
|
||||||
buprepo = fromMaybe (giveup "missing buprepo") $ remoteAnnexBupRepo gc
|
buprepo = fromMaybe (giveup "missing buprepo") $ remoteAnnexBupRepo gc
|
||||||
|
@ -212,11 +211,9 @@ remove buprepo k = do
|
||||||
- in a bup repository. One way it to check if the git repository has
|
- in a bup repository. One way it to check if the git repository has
|
||||||
- a branch matching the name (as created by bup split -n).
|
- a branch matching the name (as created by bup split -n).
|
||||||
-}
|
-}
|
||||||
checkKey :: Git.Repo -> Git.Repo -> CheckPresent
|
checkKey :: Git.Repo -> CheckPresent
|
||||||
checkKey r bupr k
|
checkKey bupr k
|
||||||
| Git.repoIsUrl bupr = do
|
| Git.repoIsUrl bupr = onBupRemote bupr boolSystem "git" params
|
||||||
showChecking r
|
|
||||||
onBupRemote bupr boolSystem "git" params
|
|
||||||
| otherwise = liftIO $ boolSystem "git" $
|
| otherwise = liftIO $ boolSystem "git" $
|
||||||
Git.Command.gitCommandLine params bupr
|
Git.Command.gitCommandLine params bupr
|
||||||
where
|
where
|
||||||
|
|
|
@ -27,7 +27,6 @@ import Annex.SpecialRemote.Config
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Remote.Helper.ReadOnly
|
import Remote.Helper.ReadOnly
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Types.Transfer
|
import Types.Transfer
|
||||||
import Logs.PreferredContent.Raw
|
import Logs.PreferredContent.Raw
|
||||||
|
@ -71,7 +70,7 @@ gen r u rc gc rs
|
||||||
readonlyStorer
|
readonlyStorer
|
||||||
retrieveUrl
|
retrieveUrl
|
||||||
readonlyRemoveKey
|
readonlyRemoveKey
|
||||||
(checkKeyUrl r)
|
checkKeyUrl
|
||||||
Nothing
|
Nothing
|
||||||
(externalInfo externaltype)
|
(externalInfo externaltype)
|
||||||
Nothing
|
Nothing
|
||||||
|
@ -815,9 +814,8 @@ retrieveUrl = fileRetriever $ \f k p -> do
|
||||||
unlessM (withUrlOptions $ downloadUrl k p us f) $
|
unlessM (withUrlOptions $ downloadUrl k p us f) $
|
||||||
giveup "failed to download content"
|
giveup "failed to download content"
|
||||||
|
|
||||||
checkKeyUrl :: Git.Repo -> CheckPresent
|
checkKeyUrl :: CheckPresent
|
||||||
checkKeyUrl r k = do
|
checkKeyUrl k = do
|
||||||
showChecking r
|
|
||||||
us <- getWebUrls k
|
us <- getWebUrls k
|
||||||
anyM (\u -> withUrlOptions $ checkBoth u (fromKey keySize k)) us
|
anyM (\u -> withUrlOptions $ checkBoth u (fromKey keySize k)) us
|
||||||
|
|
||||||
|
|
|
@ -460,7 +460,7 @@ checkKey' repo r rsyncopts accessmethod k
|
||||||
| accessmethod == AccessRsyncOverSsh = checkrsync
|
| accessmethod == AccessRsyncOverSsh = checkrsync
|
||||||
| otherwise = unsupportedUrl
|
| otherwise = unsupportedUrl
|
||||||
where
|
where
|
||||||
checkrsync = Remote.Rsync.checkKey repo rsyncopts k
|
checkrsync = Remote.Rsync.checkKey rsyncopts k
|
||||||
checkshell = Ssh.inAnnex repo k
|
checkshell = Ssh.inAnnex repo k
|
||||||
|
|
||||||
{- Annexed objects are hashed using lower-case directories for max
|
{- Annexed objects are hashed using lower-case directories for max
|
||||||
|
|
|
@ -407,7 +407,6 @@ inAnnex' repo rmt st@(State connpool duc _ _ _) key
|
||||||
| otherwise = checklocal
|
| otherwise = checklocal
|
||||||
where
|
where
|
||||||
checkhttp = do
|
checkhttp = do
|
||||||
showChecking repo
|
|
||||||
gc <- Annex.getGitConfig
|
gc <- Annex.getGitConfig
|
||||||
ifM (Url.withUrlOptionsPromptingCreds $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key))
|
ifM (Url.withUrlOptionsPromptingCreds $ \uo -> anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) (keyUrls gc repo rmt key))
|
||||||
( return True
|
( return True
|
||||||
|
|
|
@ -19,7 +19,6 @@ import Config
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Annex.SpecialRemote.Config
|
import Annex.SpecialRemote.Config
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import qualified Remote.Helper.AWS as AWS
|
import qualified Remote.Helper.AWS as AWS
|
||||||
import Creds
|
import Creds
|
||||||
|
@ -222,9 +221,7 @@ remove r k = unlessM go $
|
||||||
]
|
]
|
||||||
|
|
||||||
checkKey :: Remote -> CheckPresent
|
checkKey :: Remote -> CheckPresent
|
||||||
checkKey r k = do
|
checkKey r k = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
|
||||||
showChecking r
|
|
||||||
go =<< glacierEnv (config r) (gitconfig r) (uuid r)
|
|
||||||
where
|
where
|
||||||
go Nothing = giveup "cannot check glacier"
|
go Nothing = giveup "cannot check glacier"
|
||||||
go (Just e) = do
|
go (Just e) = do
|
||||||
|
|
|
@ -25,9 +25,6 @@ instance Describable (Remote.RemoteA a) where
|
||||||
instance Describable String where
|
instance Describable String where
|
||||||
describe = id
|
describe = id
|
||||||
|
|
||||||
showChecking :: Describable a => a -> Annex ()
|
|
||||||
showChecking v = showAction $ "checking " ++ describe v
|
|
||||||
|
|
||||||
cantCheck :: Describable a => a -> e
|
cantCheck :: Describable a => a -> e
|
||||||
cantCheck v = giveup $ "unable to check " ++ describe v
|
cantCheck v = giveup $ "unable to check " ++ describe v
|
||||||
|
|
||||||
|
|
|
@ -94,9 +94,8 @@ onRemote cs r (with, errorval) command params fields = do
|
||||||
|
|
||||||
{- Checks if a remote contains a key. -}
|
{- Checks if a remote contains a key. -}
|
||||||
inAnnex :: Git.Repo -> Key -> Annex Bool
|
inAnnex :: Git.Repo -> Key -> Annex Bool
|
||||||
inAnnex r k = do
|
inAnnex r k = onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex"
|
||||||
showChecking r
|
[Param $ serializeKey k] []
|
||||||
onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] []
|
|
||||||
where
|
where
|
||||||
runcheck c p = liftIO $ dispatch =<< safeSystem c p
|
runcheck c p = liftIO $ dispatch =<< safeSystem c p
|
||||||
dispatch ExitSuccess = return True
|
dispatch ExitSuccess = return True
|
||||||
|
|
|
@ -17,7 +17,6 @@ import Config.Cost
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Annex.SpecialRemote.Config
|
import Annex.SpecialRemote.Config
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Utility.Env
|
import Utility.Env
|
||||||
import Messages.Progress
|
import Messages.Progress
|
||||||
|
@ -54,7 +53,7 @@ gen r u rc gc rs = do
|
||||||
(store hooktype)
|
(store hooktype)
|
||||||
(retrieve hooktype)
|
(retrieve hooktype)
|
||||||
(remove hooktype)
|
(remove hooktype)
|
||||||
(checkKey r hooktype)
|
(checkKey hooktype)
|
||||||
Remote
|
Remote
|
||||||
{ uuid = u
|
{ uuid = u
|
||||||
, cost = cst
|
, cost = cst
|
||||||
|
@ -169,9 +168,8 @@ remove h k =
|
||||||
unlessM (runHook' h "remove" k Nothing $ return True) $
|
unlessM (runHook' h "remove" k Nothing $ return True) $
|
||||||
giveup "failed to remove content"
|
giveup "failed to remove content"
|
||||||
|
|
||||||
checkKey :: Git.Repo -> HookName -> CheckPresent
|
checkKey :: HookName -> CheckPresent
|
||||||
checkKey r h k = do
|
checkKey h k = do
|
||||||
showChecking r
|
|
||||||
v <- lookupHook h action
|
v <- lookupHook h action
|
||||||
liftIO $ check v
|
liftIO $ check v
|
||||||
where
|
where
|
||||||
|
|
|
@ -11,7 +11,6 @@ import Annex.Common
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import Types.ProposedAccepted
|
import Types.ProposedAccepted
|
||||||
import Types.Export
|
import Types.Export
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
@ -67,7 +66,7 @@ gen r u rc gc rs = do
|
||||||
, retrievalSecurityPolicy = RetrievalAllKeysSecure
|
, retrievalSecurityPolicy = RetrievalAllKeysSecure
|
||||||
, removeKey = cannotModify
|
, removeKey = cannotModify
|
||||||
, lockContent = Nothing
|
, lockContent = Nothing
|
||||||
, checkPresent = checkKey url ll (this url ll c cst)
|
, checkPresent = checkKey url ll
|
||||||
, checkPresentCheap = False
|
, checkPresentCheap = False
|
||||||
, exportActions = ExportActions
|
, exportActions = ExportActions
|
||||||
{ storeExport = cannotModify
|
{ storeExport = cannotModify
|
||||||
|
@ -130,9 +129,8 @@ downloadAction dest p key run =
|
||||||
run (\url -> Url.download' p url dest uo)
|
run (\url -> Url.download' p url dest uo)
|
||||||
>>= either giveup (const (return ()))
|
>>= either giveup (const (return ()))
|
||||||
|
|
||||||
checkKey :: Maybe URLString -> LearnedLayout -> Remote -> Key -> Annex Bool
|
checkKey :: Maybe URLString -> LearnedLayout -> Key -> Annex Bool
|
||||||
checkKey baseurl ll r key = do
|
checkKey baseurl ll key =
|
||||||
showChecking r
|
|
||||||
isRight <$> keyUrlAction baseurl ll key (checkKey' key)
|
isRight <$> keyUrlAction baseurl ll key (checkKey' key)
|
||||||
|
|
||||||
checkKey' :: Key -> URLString -> Annex (Either String ())
|
checkKey' :: Key -> URLString -> Annex (Either String ())
|
||||||
|
|
|
@ -29,7 +29,6 @@ import Annex.UUID
|
||||||
import Annex.Ssh
|
import Annex.Ssh
|
||||||
import Annex.Perms
|
import Annex.Perms
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Types.Export
|
import Types.Export
|
||||||
import Types.ProposedAccepted
|
import Types.ProposedAccepted
|
||||||
|
@ -84,7 +83,7 @@ gen r u rc gc rs = do
|
||||||
(fileStorer $ store o)
|
(fileStorer $ store o)
|
||||||
(fileRetriever $ retrieve o)
|
(fileRetriever $ retrieve o)
|
||||||
(remove o)
|
(remove o)
|
||||||
(checkKey r o)
|
(checkKey o)
|
||||||
Remote
|
Remote
|
||||||
{ uuid = u
|
{ uuid = u
|
||||||
, cost = cst
|
, cost = cst
|
||||||
|
@ -280,10 +279,8 @@ removeGeneric o includes = do
|
||||||
unless ok $
|
unless ok $
|
||||||
giveup "rsync failed"
|
giveup "rsync failed"
|
||||||
|
|
||||||
checkKey :: Git.Repo -> RsyncOpts -> CheckPresent
|
checkKey :: RsyncOpts -> CheckPresent
|
||||||
checkKey r o k = do
|
checkKey o k = checkPresentGeneric o (rsyncUrls o k)
|
||||||
showChecking r
|
|
||||||
checkPresentGeneric o (rsyncUrls o k)
|
|
||||||
|
|
||||||
checkPresentGeneric :: RsyncOpts -> [RsyncUrl] -> Annex Bool
|
checkPresentGeneric :: RsyncOpts -> [RsyncUrl] -> Annex Bool
|
||||||
checkPresentGeneric o rsyncurls = do
|
checkPresentGeneric o rsyncurls = do
|
||||||
|
|
|
@ -47,7 +47,6 @@ import Config.Cost
|
||||||
import Annex.SpecialRemote.Config
|
import Annex.SpecialRemote.Config
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Http
|
import Remote.Helper.Http
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import Types.Import
|
import Types.Import
|
||||||
import qualified Remote.Helper.AWS as AWS
|
import qualified Remote.Helper.AWS as AWS
|
||||||
|
@ -449,9 +448,7 @@ lockContentS3 hv r rs c info
|
||||||
|
|
||||||
checkKey :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> CheckPresent
|
checkKey :: S3HandleVar -> Remote -> RemoteStateHandle -> ParsedRemoteConfig -> S3Info -> CheckPresent
|
||||||
checkKey hv r rs c info k = withS3Handle hv $ \case
|
checkKey hv r rs c info k = withS3Handle hv $ \case
|
||||||
Just h -> do
|
Just h -> eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case
|
||||||
showChecking r
|
|
||||||
eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case
|
|
||||||
Left failreason -> do
|
Left failreason -> do
|
||||||
warning failreason
|
warning failreason
|
||||||
giveup "cannot check content"
|
giveup "cannot check content"
|
||||||
|
@ -462,7 +459,6 @@ checkKey hv r rs c info k = withS3Handle hv $ \case
|
||||||
warning failreason
|
warning failreason
|
||||||
giveup "cannot check content"
|
giveup "cannot check content"
|
||||||
Right us -> do
|
Right us -> do
|
||||||
showChecking r
|
|
||||||
let check u = withUrlOptions $
|
let check u = withUrlOptions $
|
||||||
Url.checkBoth u (fromKey keySize k)
|
Url.checkBoth u (fromKey keySize k)
|
||||||
anyM check us
|
anyM check us
|
||||||
|
|
|
@ -9,7 +9,6 @@ module Remote.Web (remote, getWebUrls) where
|
||||||
|
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Construct
|
import qualified Git.Construct
|
||||||
|
@ -112,7 +111,6 @@ checkKey key = do
|
||||||
checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
|
checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
|
||||||
checkKey' key us = firsthit us (Right False) $ \u -> do
|
checkKey' key us = firsthit us (Right False) $ \u -> do
|
||||||
let (u', downloader) = getDownloader u
|
let (u', downloader) = getDownloader u
|
||||||
showChecking u'
|
|
||||||
case downloader of
|
case downloader of
|
||||||
YoutubeDownloader -> youtubeDlCheck u'
|
YoutubeDownloader -> youtubeDlCheck u'
|
||||||
_ -> catchMsgIO $
|
_ -> catchMsgIO $
|
||||||
|
|
|
@ -33,7 +33,6 @@ import Config
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Annex.SpecialRemote.Config
|
import Annex.SpecialRemote.Config
|
||||||
import Remote.Helper.Special
|
import Remote.Helper.Special
|
||||||
import Remote.Helper.Messages
|
|
||||||
import Remote.Helper.Http
|
import Remote.Helper.Http
|
||||||
import Remote.Helper.ExportImport
|
import Remote.Helper.ExportImport
|
||||||
import qualified Remote.Helper.Chunked.Legacy as Legacy
|
import qualified Remote.Helper.Chunked.Legacy as Legacy
|
||||||
|
@ -78,7 +77,7 @@ gen r u rc gc rs = do
|
||||||
(store hdl chunkconfig)
|
(store hdl chunkconfig)
|
||||||
(retrieve hdl chunkconfig)
|
(retrieve hdl chunkconfig)
|
||||||
(remove hdl)
|
(remove hdl)
|
||||||
(checkKey hdl this chunkconfig)
|
(checkKey hdl chunkconfig)
|
||||||
this
|
this
|
||||||
where
|
where
|
||||||
this = Remote
|
this = Remote
|
||||||
|
@ -198,9 +197,8 @@ removeHelper d = do
|
||||||
Right False -> return ()
|
Right False -> return ()
|
||||||
_ -> giveup "failed to remove content from remote"
|
_ -> giveup "failed to remove content from remote"
|
||||||
|
|
||||||
checkKey :: DavHandleVar -> Remote -> ChunkConfig -> CheckPresent
|
checkKey :: DavHandleVar -> ChunkConfig -> CheckPresent
|
||||||
checkKey hv r chunkconfig k = withDavHandle hv $ \dav -> do
|
checkKey hv chunkconfig k = withDavHandle hv $ \dav ->
|
||||||
showChecking r
|
|
||||||
case chunkconfig of
|
case chunkconfig of
|
||||||
LegacyChunks _ -> checkKeyLegacyChunked dav k
|
LegacyChunks _ -> checkKeyLegacyChunked dav k
|
||||||
_ -> do
|
_ -> do
|
||||||
|
|
Loading…
Reference in a new issue