pushed checkPresent exception handling out of Remote implementations
I tend to prefer moving toward explicit exception handling, not away from it, but in this case, I think there are good reasons to let checkPresent throw exceptions: 1. They can all be caught in one place (Remote.hasKey), and we know every possible exception is caught there now, which we didn't before. 2. It simplified the code of the Remotes. I think it makes sense for Remotes to be able to be implemented without needing to worry about catching exceptions inside them. (Mostly.) 3. Types.StoreRetrieve.Preparer can only work on things that return a Bool, which all the other relevant remote methods already did. I do not see a good way to generalize that type; my previous attempts failed miserably.
This commit is contained in:
parent
781833b16f
commit
b4cf22a388
24 changed files with 167 additions and 163 deletions
|
@ -56,6 +56,7 @@ import Data.Ord
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
import Annex.Exception
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import Logs.UUID
|
import Logs.UUID
|
||||||
import Logs.Trust
|
import Logs.Trust
|
||||||
|
@ -312,3 +313,10 @@ isXMPPRemote :: Remote -> Bool
|
||||||
isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r
|
isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r
|
||||||
where
|
where
|
||||||
r = repo remote
|
r = repo remote
|
||||||
|
|
||||||
|
hasKey :: Remote -> Key -> Annex (Either String Bool)
|
||||||
|
hasKey r k = either (Left . show) Right
|
||||||
|
<$> tryNonAsyncAnnex (checkPresent r k)
|
||||||
|
|
||||||
|
hasKeyCheap :: Remote -> Bool
|
||||||
|
hasKeyCheap = checkPresentCheap
|
||||||
|
|
|
@ -58,8 +58,8 @@ gen r u c gc = do
|
||||||
, retrieveKeyFile = retreiveKeyFileDummy
|
, retrieveKeyFile = retreiveKeyFileDummy
|
||||||
, retrieveKeyFileCheap = retrieveCheap buprepo
|
, retrieveKeyFileCheap = retrieveCheap buprepo
|
||||||
, removeKey = remove buprepo
|
, removeKey = remove buprepo
|
||||||
, hasKey = checkPresent r bupr'
|
, checkPresent = checkKey r bupr'
|
||||||
, hasKeyCheap = bupLocal buprepo
|
, checkPresentCheap = bupLocal buprepo
|
||||||
, whereisKey = Nothing
|
, whereisKey = Nothing
|
||||||
, remoteFsck = Nothing
|
, remoteFsck = Nothing
|
||||||
, repairRepo = Nothing
|
, repairRepo = Nothing
|
||||||
|
@ -163,14 +163,13 @@ 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).
|
||||||
-}
|
-}
|
||||||
checkPresent :: Git.Repo -> Git.Repo -> Key -> Annex (Either String Bool)
|
checkKey :: Git.Repo -> Git.Repo -> Key -> Annex Bool
|
||||||
checkPresent r bupr k
|
checkKey r bupr k
|
||||||
| Git.repoIsUrl bupr = do
|
| Git.repoIsUrl bupr = do
|
||||||
showChecking r
|
showChecking r
|
||||||
ok <- onBupRemote bupr boolSystem "git" params
|
onBupRemote bupr boolSystem "git" params
|
||||||
return $ Right ok
|
| otherwise = liftIO $ boolSystem "git" $
|
||||||
| otherwise = liftIO $ catchMsgIO $
|
Git.Command.gitCommandLine params bupr
|
||||||
boolSystem "git" $ Git.Command.gitCommandLine params bupr
|
|
||||||
where
|
where
|
||||||
params =
|
params =
|
||||||
[ Params "show-ref --quiet --verify"
|
[ Params "show-ref --quiet --verify"
|
||||||
|
|
|
@ -54,8 +54,8 @@ gen r u c gc = do
|
||||||
, retrieveKeyFile = retreiveKeyFileDummy
|
, retrieveKeyFile = retreiveKeyFileDummy
|
||||||
, retrieveKeyFileCheap = retrieveCheap
|
, retrieveKeyFileCheap = retrieveCheap
|
||||||
, removeKey = remove ddarrepo
|
, removeKey = remove ddarrepo
|
||||||
, hasKey = checkPresent ddarrepo
|
, checkPresent = checkKey ddarrepo
|
||||||
, hasKeyCheap = ddarLocal ddarrepo
|
, checkPresentCheap = ddarLocal ddarrepo
|
||||||
, whereisKey = Nothing
|
, whereisKey = Nothing
|
||||||
, remoteFsck = Nothing
|
, remoteFsck = Nothing
|
||||||
, repairRepo = Nothing
|
, repairRepo = Nothing
|
||||||
|
@ -181,13 +181,14 @@ inDdarManifest ddarrepo k = do
|
||||||
where
|
where
|
||||||
k' = key2file k
|
k' = key2file k
|
||||||
|
|
||||||
checkPresent :: DdarRepo -> Key -> Annex (Either String Bool)
|
checkKey :: DdarRepo -> Key -> Annex Bool
|
||||||
checkPresent ddarrepo key = do
|
checkKey ddarrepo key = do
|
||||||
directoryExists <- ddarDirectoryExists ddarrepo
|
directoryExists <- ddarDirectoryExists ddarrepo
|
||||||
case directoryExists of
|
case directoryExists of
|
||||||
Left e -> return $ Left e
|
Left e -> error e
|
||||||
Right True -> inDdarManifest ddarrepo key
|
Right True -> either error return
|
||||||
Right False -> return $ Right False
|
=<< inDdarManifest ddarrepo key
|
||||||
|
Right False -> return False
|
||||||
|
|
||||||
ddarLocal :: DdarRepo -> Bool
|
ddarLocal :: DdarRepo -> Bool
|
||||||
ddarLocal = notElem ':'
|
ddarLocal = notElem ':'
|
||||||
|
|
|
@ -52,8 +52,8 @@ gen r u c gc = do
|
||||||
retrieveKeyFile = retreiveKeyFileDummy,
|
retrieveKeyFile = retreiveKeyFileDummy,
|
||||||
retrieveKeyFileCheap = retrieveCheap dir chunkconfig,
|
retrieveKeyFileCheap = retrieveCheap dir chunkconfig,
|
||||||
removeKey = remove dir,
|
removeKey = remove dir,
|
||||||
hasKey = checkPresent dir chunkconfig,
|
checkPresent = checkKey dir chunkconfig,
|
||||||
hasKeyCheap = True,
|
checkPresentCheap = True,
|
||||||
whereisKey = Nothing,
|
whereisKey = Nothing,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -189,13 +189,10 @@ removeDirGeneric topdir dir = do
|
||||||
then return ok
|
then return ok
|
||||||
else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)
|
else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)
|
||||||
|
|
||||||
checkPresent :: FilePath -> ChunkConfig -> Key -> Annex (Either String Bool)
|
checkKey :: FilePath -> ChunkConfig -> Key -> Annex Bool
|
||||||
checkPresent d (LegacyChunks _) k = Legacy.checkPresent d locations k
|
checkKey d (LegacyChunks _) k = Legacy.checkKey d locations k
|
||||||
checkPresent d _ k = liftIO $ do
|
checkKey d _ k = liftIO $
|
||||||
v <- catchMsgIO $ anyM doesFileExist (locations d k)
|
ifM (anyM doesFileExist (locations d k))
|
||||||
case v of
|
( return True
|
||||||
Right False -> ifM (doesDirectoryExist d)
|
, error $ "directory " ++ d ++ " is not accessible"
|
||||||
( return v
|
|
||||||
, return $ Left $ "directory " ++ d ++ " is not accessible"
|
|
||||||
)
|
)
|
||||||
_ -> return v
|
|
||||||
|
|
|
@ -103,8 +103,7 @@ retrieve locations d basek a = do
|
||||||
liftIO $ nukeFile tmp
|
liftIO $ nukeFile tmp
|
||||||
sink b
|
sink b
|
||||||
|
|
||||||
checkPresent :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> Annex (Either String Bool)
|
checkKey :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> Annex Bool
|
||||||
checkPresent d locations k = liftIO $ catchMsgIO $
|
checkKey d locations k = liftIO $ withStoredFiles d locations k $
|
||||||
withStoredFiles d locations k $
|
|
||||||
-- withStoredFiles checked that it exists
|
-- withStoredFiles checked that it exists
|
||||||
const $ return True
|
const $ return True
|
||||||
|
|
|
@ -53,8 +53,8 @@ gen r u c gc = do
|
||||||
retrieveKeyFile = retreiveKeyFileDummy,
|
retrieveKeyFile = retreiveKeyFileDummy,
|
||||||
retrieveKeyFileCheap = \_ _ -> return False,
|
retrieveKeyFileCheap = \_ _ -> return False,
|
||||||
removeKey = remove external,
|
removeKey = remove external,
|
||||||
hasKey = checkPresent external,
|
checkPresent = checkKey external,
|
||||||
hasKeyCheap = False,
|
checkPresentCheap = False,
|
||||||
whereisKey = Nothing,
|
whereisKey = Nothing,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -121,8 +121,8 @@ remove external k = safely $
|
||||||
return False
|
return False
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
checkPresent :: External -> Key -> Annex (Either String Bool)
|
checkKey :: External -> Key -> Annex Bool
|
||||||
checkPresent external k = either (Left . show) id <$> tryAnnex go
|
checkKey external k = either error id <$> go
|
||||||
where
|
where
|
||||||
go = handleRequest external (CHECKPRESENT k) Nothing $ \resp ->
|
go = handleRequest external (CHECKPRESENT k) Nothing $ \resp ->
|
||||||
case resp of
|
case resp of
|
||||||
|
|
|
@ -46,7 +46,6 @@ import Utility.Tmp
|
||||||
import Logs.Remote
|
import Logs.Remote
|
||||||
import Logs.Transfer
|
import Logs.Transfer
|
||||||
import Utility.Gpg
|
import Utility.Gpg
|
||||||
import Utility.FileMode
|
|
||||||
|
|
||||||
remote :: RemoteType
|
remote :: RemoteType
|
||||||
remote = RemoteType {
|
remote = RemoteType {
|
||||||
|
@ -109,8 +108,8 @@ gen' r u c gc = do
|
||||||
, retrieveKeyFile = retreiveKeyFileDummy
|
, retrieveKeyFile = retreiveKeyFileDummy
|
||||||
, retrieveKeyFileCheap = \_ _ -> return False
|
, retrieveKeyFileCheap = \_ _ -> return False
|
||||||
, removeKey = remove this rsyncopts
|
, removeKey = remove this rsyncopts
|
||||||
, hasKey = checkPresent this rsyncopts
|
, checkPresent = checkKey this rsyncopts
|
||||||
, hasKeyCheap = repoCheap r
|
, checkPresentCheap = repoCheap r
|
||||||
, whereisKey = Nothing
|
, whereisKey = Nothing
|
||||||
, remoteFsck = Nothing
|
, remoteFsck = Nothing
|
||||||
, repairRepo = Nothing
|
, repairRepo = Nothing
|
||||||
|
@ -342,16 +341,15 @@ remove r rsyncopts k
|
||||||
removersync = Remote.Rsync.remove rsyncopts k
|
removersync = Remote.Rsync.remove rsyncopts k
|
||||||
removeshell = Ssh.dropKey (repo r) k
|
removeshell = Ssh.dropKey (repo r) k
|
||||||
|
|
||||||
checkPresent :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex (Either String Bool)
|
checkKey :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex Bool
|
||||||
checkPresent r rsyncopts k
|
checkKey r rsyncopts k
|
||||||
| not $ Git.repoIsUrl (repo r) =
|
| not $ Git.repoIsUrl (repo r) =
|
||||||
guardUsable (repo r) (cantCheck $ repo r) $
|
guardUsable (repo r) (cantCheck $ repo r) $
|
||||||
liftIO $ catchDefaultIO (cantCheck $ repo r) $
|
liftIO $ doesFileExist (gCryptLocation r k)
|
||||||
Right <$> doesFileExist (gCryptLocation r k)
|
|
||||||
| Git.repoIsSsh (repo r) = shellOrRsync r checkshell checkrsync
|
| Git.repoIsSsh (repo r) = shellOrRsync r checkshell checkrsync
|
||||||
| otherwise = unsupportedUrl
|
| otherwise = unsupportedUrl
|
||||||
where
|
where
|
||||||
checkrsync = Remote.Rsync.checkPresent (repo r) rsyncopts k
|
checkrsync = Remote.Rsync.checkKey (repo r) rsyncopts k
|
||||||
checkshell = Ssh.inAnnex (repo r) k
|
checkshell = Ssh.inAnnex (repo r) k
|
||||||
|
|
||||||
{- Annexed objects are hashed using lower-case directories for max
|
{- Annexed objects are hashed using lower-case directories for max
|
||||||
|
|
|
@ -141,8 +141,8 @@ gen r u c gc
|
||||||
, retrieveKeyFile = copyFromRemote new
|
, retrieveKeyFile = copyFromRemote new
|
||||||
, retrieveKeyFileCheap = copyFromRemoteCheap new
|
, retrieveKeyFileCheap = copyFromRemoteCheap new
|
||||||
, removeKey = dropKey new
|
, removeKey = dropKey new
|
||||||
, hasKey = inAnnex new
|
, checkPresent = inAnnex new
|
||||||
, hasKeyCheap = repoCheap r
|
, checkPresentCheap = repoCheap r
|
||||||
, whereisKey = Nothing
|
, whereisKey = Nothing
|
||||||
, remoteFsck = if Git.repoIsUrl r
|
, remoteFsck = if Git.repoIsUrl r
|
||||||
then Nothing
|
then Nothing
|
||||||
|
@ -284,11 +284,8 @@ tryGitConfigRead r
|
||||||
void $ tryAnnex $ ensureInitialized
|
void $ tryAnnex $ ensureInitialized
|
||||||
Annex.getState Annex.repo
|
Annex.getState Annex.repo
|
||||||
|
|
||||||
{- Checks if a given remote has the content for a key inAnnex.
|
{- Checks if a given remote has the content for a key in its annex. -}
|
||||||
- If the remote cannot be accessed, or if it cannot determine
|
inAnnex :: Remote -> Key -> Annex Bool
|
||||||
- whether it has the content, returns a Left error message.
|
|
||||||
-}
|
|
||||||
inAnnex :: Remote -> Key -> Annex (Either String Bool)
|
|
||||||
inAnnex rmt key
|
inAnnex rmt key
|
||||||
| Git.repoIsHttp r = checkhttp
|
| Git.repoIsHttp r = checkhttp
|
||||||
| Git.repoIsUrl r = checkremote
|
| Git.repoIsUrl r = checkremote
|
||||||
|
@ -298,17 +295,13 @@ inAnnex rmt key
|
||||||
checkhttp = do
|
checkhttp = do
|
||||||
showChecking r
|
showChecking r
|
||||||
ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))
|
ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))
|
||||||
( return $ Right True
|
( return True
|
||||||
, return $ Left "not found"
|
, error "not found"
|
||||||
)
|
)
|
||||||
checkremote = Ssh.inAnnex r key
|
checkremote = Ssh.inAnnex r key
|
||||||
checklocal = guardUsable r (cantCheck r) $ dispatch <$> check
|
checklocal = guardUsable r (cantCheck r) $
|
||||||
where
|
fromMaybe (cantCheck r)
|
||||||
check = either (Left . show) Right
|
<$> onLocal rmt (Annex.Content.inAnnexSafe key)
|
||||||
<$> tryAnnex (onLocal rmt $ Annex.Content.inAnnexSafe key)
|
|
||||||
dispatch (Left e) = Left e
|
|
||||||
dispatch (Right (Just b)) = Right b
|
|
||||||
dispatch (Right Nothing) = cantCheck r
|
|
||||||
|
|
||||||
keyUrls :: Remote -> Key -> [String]
|
keyUrls :: Remote -> Key -> [String]
|
||||||
keyUrls r key = map tourl locs'
|
keyUrls r key = map tourl locs'
|
||||||
|
|
|
@ -52,8 +52,8 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
|
||||||
retrieveKeyFile = retreiveKeyFileDummy,
|
retrieveKeyFile = retreiveKeyFileDummy,
|
||||||
retrieveKeyFileCheap = retrieveCheap this,
|
retrieveKeyFileCheap = retrieveCheap this,
|
||||||
removeKey = remove this,
|
removeKey = remove this,
|
||||||
hasKey = checkPresent this,
|
checkPresent = checkKey this,
|
||||||
hasKeyCheap = False,
|
checkPresentCheap = False,
|
||||||
whereisKey = Nothing,
|
whereisKey = Nothing,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -164,25 +164,21 @@ remove r k = glacierAction r
|
||||||
, Param $ archive r k
|
, Param $ archive r k
|
||||||
]
|
]
|
||||||
|
|
||||||
checkPresent :: Remote -> Key -> Annex (Either String Bool)
|
checkKey :: Remote -> Key -> Annex Bool
|
||||||
checkPresent r k = do
|
checkKey r k = do
|
||||||
showAction $ "checking " ++ name r
|
showAction $ "checking " ++ name r
|
||||||
go =<< glacierEnv (config r) (uuid r)
|
go =<< glacierEnv (config r) (uuid r)
|
||||||
where
|
where
|
||||||
go Nothing = return $ Left "cannot check glacier"
|
go Nothing = error "cannot check glacier"
|
||||||
go (Just e) = do
|
go (Just e) = do
|
||||||
{- glacier checkpresent outputs the archive name to stdout if
|
{- glacier checkpresent outputs the archive name to stdout if
|
||||||
- it's present. -}
|
- it's present. -}
|
||||||
v <- liftIO $ catchMsgIO $
|
s <- liftIO $ readProcessEnv "glacier" (toCommand params) (Just e)
|
||||||
readProcessEnv "glacier" (toCommand params) (Just e)
|
|
||||||
case v of
|
|
||||||
Right s -> do
|
|
||||||
let probablypresent = key2file k `elem` lines s
|
let probablypresent = key2file k `elem` lines s
|
||||||
if probablypresent
|
if probablypresent
|
||||||
then ifM (Annex.getFlag "trustglacier")
|
then ifM (Annex.getFlag "trustglacier")
|
||||||
( return $ Right True, untrusted )
|
( return True, error untrusted )
|
||||||
else return $ Right False
|
else return False
|
||||||
Left err -> return $ Left err
|
|
||||||
|
|
||||||
params = glacierParams (config r)
|
params = glacierParams (config r)
|
||||||
[ Param "archive"
|
[ Param "archive"
|
||||||
|
@ -192,7 +188,7 @@ checkPresent r k = do
|
||||||
, Param $ archive r k
|
, Param $ archive r k
|
||||||
]
|
]
|
||||||
|
|
||||||
untrusted = return $ Left $ unlines
|
untrusted = unlines
|
||||||
[ "Glacier's inventory says it has a copy."
|
[ "Glacier's inventory says it has a copy."
|
||||||
, "However, the inventory could be out of date, if it was recently removed."
|
, "However, the inventory could be out of date, if it was recently removed."
|
||||||
, "(Use --trust-glacier if you're sure it's still in Glacier.)"
|
, "(Use --trust-glacier if you're sure it's still in Glacier.)"
|
||||||
|
|
|
@ -12,7 +12,7 @@ module Remote.Helper.Chunked (
|
||||||
storeChunks,
|
storeChunks,
|
||||||
removeChunks,
|
removeChunks,
|
||||||
retrieveChunks,
|
retrieveChunks,
|
||||||
hasKeyChunks,
|
checkPresentChunks,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
|
@ -94,8 +94,8 @@ storeChunks
|
||||||
-> Key
|
-> Key
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-> MeterUpdate
|
-> MeterUpdate
|
||||||
-> (Key -> ContentSource -> MeterUpdate -> Annex Bool)
|
-> Storer
|
||||||
-> (Key -> Annex (Either String Bool))
|
-> CheckPresent
|
||||||
-> Annex Bool
|
-> Annex Bool
|
||||||
storeChunks u chunkconfig k f p storer checker =
|
storeChunks u chunkconfig k f p storer checker =
|
||||||
case chunkconfig of
|
case chunkconfig of
|
||||||
|
@ -158,7 +158,7 @@ storeChunks u chunkconfig k f p storer checker =
|
||||||
seekResume
|
seekResume
|
||||||
:: Handle
|
:: Handle
|
||||||
-> ChunkKeyStream
|
-> ChunkKeyStream
|
||||||
-> (Key -> Annex (Either String Bool))
|
-> CheckPresent
|
||||||
-> Annex (ChunkKeyStream, BytesProcessed)
|
-> Annex (ChunkKeyStream, BytesProcessed)
|
||||||
seekResume h chunkkeys checker = do
|
seekResume h chunkkeys checker = do
|
||||||
sz <- liftIO (hFileSize h)
|
sz <- liftIO (hFileSize h)
|
||||||
|
@ -172,7 +172,7 @@ seekResume h chunkkeys checker = do
|
||||||
liftIO $ hSeek h AbsoluteSeek sz
|
liftIO $ hSeek h AbsoluteSeek sz
|
||||||
return (cks, toBytesProcessed sz)
|
return (cks, toBytesProcessed sz)
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
v <- checker k
|
v <- tryNonAsyncAnnex (checker k)
|
||||||
case v of
|
case v of
|
||||||
Right True ->
|
Right True ->
|
||||||
check pos' cks' sz
|
check pos' cks' sz
|
||||||
|
@ -331,43 +331,48 @@ setupResume ls currsize = map dropunneeded ls
|
||||||
{- Checks if a key is present in a remote. This requires any one
|
{- Checks if a key is present in a remote. This requires any one
|
||||||
- of the lists of options returned by chunkKeys to all check out
|
- of the lists of options returned by chunkKeys to all check out
|
||||||
- as being present using the checker action.
|
- as being present using the checker action.
|
||||||
|
-
|
||||||
|
- Throws an exception if the remote is not accessible.
|
||||||
-}
|
-}
|
||||||
hasKeyChunks
|
checkPresentChunks
|
||||||
:: (Key -> Annex (Either String Bool))
|
:: CheckPresent
|
||||||
-> UUID
|
-> UUID
|
||||||
-> ChunkConfig
|
-> ChunkConfig
|
||||||
-> EncKey
|
-> EncKey
|
||||||
-> Key
|
-> Key
|
||||||
-> Annex (Either String Bool)
|
-> Annex Bool
|
||||||
hasKeyChunks checker u chunkconfig encryptor basek
|
checkPresentChunks checker u chunkconfig encryptor basek
|
||||||
| noChunks chunkconfig =
|
| noChunks chunkconfig = do
|
||||||
-- Optimisation: Try the unchunked key first, to avoid
|
-- Optimisation: Try the unchunked key first, to avoid
|
||||||
-- looking in the git-annex branch for chunk counts
|
-- looking in the git-annex branch for chunk counts
|
||||||
-- that are likely not there.
|
-- that are likely not there.
|
||||||
ifM ((Right True ==) <$> checker (encryptor basek))
|
v <- check basek
|
||||||
( return (Right True)
|
case v of
|
||||||
, checklists Nothing =<< chunkKeysOnly u basek
|
Right True -> return True
|
||||||
)
|
_ -> checklists Nothing =<< chunkKeysOnly u basek
|
||||||
| otherwise = checklists Nothing =<< chunkKeys u chunkconfig basek
|
| otherwise = checklists Nothing =<< chunkKeys u chunkconfig basek
|
||||||
where
|
where
|
||||||
checklists Nothing [] = return (Right False)
|
checklists Nothing [] = return False
|
||||||
checklists (Just deferrederror) [] = return (Left deferrederror)
|
checklists (Just deferrederror) [] = error deferrederror
|
||||||
checklists d (l:ls)
|
checklists d (l:ls)
|
||||||
| not (null l) = do
|
| not (null l) = do
|
||||||
v <- checkchunks l
|
v <- checkchunks l
|
||||||
case v of
|
case v of
|
||||||
Left e -> checklists (Just e) ls
|
Left e -> checklists (Just e) ls
|
||||||
Right True -> return (Right True)
|
Right True -> return True
|
||||||
Right False -> checklists Nothing ls
|
Right False -> checklists Nothing ls
|
||||||
| otherwise = checklists d ls
|
| otherwise = checklists d ls
|
||||||
|
|
||||||
checkchunks :: [Key] -> Annex (Either String Bool)
|
checkchunks :: [Key] -> Annex (Either String Bool)
|
||||||
checkchunks [] = return (Right True)
|
checkchunks [] = return (Right True)
|
||||||
checkchunks (k:ks) = do
|
checkchunks (k:ks) = do
|
||||||
v <- checker (encryptor k)
|
v <- check k
|
||||||
if v == Right True
|
case v of
|
||||||
then checkchunks ks
|
Right True -> checkchunks ks
|
||||||
else return v
|
Right False -> return $ Right False
|
||||||
|
Left e -> return $ Left $ show e
|
||||||
|
|
||||||
|
check = tryNonAsyncAnnex . checker . encryptor
|
||||||
|
|
||||||
{- A key can be stored in a remote unchunked, or as a list of chunked keys.
|
{- A key can be stored in a remote unchunked, or as a list of chunked keys.
|
||||||
- This can be the case whether or not the remote is currently configured
|
- This can be the case whether or not the remote is currently configured
|
||||||
|
|
|
@ -91,9 +91,9 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = r
|
||||||
, removeKey = \k -> cip k >>= maybe
|
, removeKey = \k -> cip k >>= maybe
|
||||||
(removeKey r k)
|
(removeKey r k)
|
||||||
(\(_, enckey) -> removeKey r enckey)
|
(\(_, enckey) -> removeKey r enckey)
|
||||||
, hasKey = \k -> cip k >>= maybe
|
, checkPresent = \k -> cip k >>= maybe
|
||||||
(hasKey r k)
|
(checkPresent r k)
|
||||||
(\(_, enckey) -> hasKey r enckey)
|
(\(_, enckey) -> checkPresent r enckey)
|
||||||
, cost = maybe
|
, cost = maybe
|
||||||
(cost r)
|
(cost r)
|
||||||
(const $ cost r + encryptedRemoteCostAdj)
|
(const $ cost r + encryptedRemoteCostAdj)
|
||||||
|
|
|
@ -39,7 +39,7 @@ addHooks' r starthook stophook = r'
|
||||||
, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
|
, retrieveKeyFile = \k f d p -> wrapper $ retrieveKeyFile r k f d p
|
||||||
, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
|
, retrieveKeyFileCheap = \k f -> wrapper $ retrieveKeyFileCheap r k f
|
||||||
, removeKey = wrapper . removeKey r
|
, removeKey = wrapper . removeKey r
|
||||||
, hasKey = wrapper . hasKey r
|
, checkPresent = wrapper . checkPresent r
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
wrapper = runHooks r' starthook stophook
|
wrapper = runHooks r' starthook stophook
|
||||||
|
|
|
@ -13,5 +13,5 @@ import qualified Git
|
||||||
showChecking :: Git.Repo -> Annex ()
|
showChecking :: Git.Repo -> Annex ()
|
||||||
showChecking r = showAction $ "checking " ++ Git.repoDescribe r
|
showChecking r = showAction $ "checking " ++ Git.repoDescribe r
|
||||||
|
|
||||||
cantCheck :: Git.Repo -> Either String Bool
|
cantCheck :: Git.Repo -> a
|
||||||
cantCheck r = Left $ "unable to check " ++ Git.repoDescribe r
|
cantCheck r = error $ "unable to check " ++ Git.repoDescribe r
|
||||||
|
|
|
@ -148,7 +148,7 @@ specialRemote' cfg c preparestorer prepareretriever baser = encr
|
||||||
(retrieveKeyFileCheap baser k d)
|
(retrieveKeyFileCheap baser k d)
|
||||||
(\_ -> return False)
|
(\_ -> return False)
|
||||||
, removeKey = \k -> cip >>= removeKeyGen k
|
, removeKey = \k -> cip >>= removeKeyGen k
|
||||||
, hasKey = \k -> cip >>= hasKeyGen k
|
, checkPresent = \k -> cip >>= checkPresentGen k
|
||||||
, cost = maybe
|
, cost = maybe
|
||||||
(cost baser)
|
(cost baser)
|
||||||
(const $ cost baser + encryptedRemoteCostAdj)
|
(const $ cost baser + encryptedRemoteCostAdj)
|
||||||
|
@ -167,7 +167,7 @@ specialRemote' cfg c preparestorer prepareretriever baser = encr
|
||||||
displayprogress p k $ \p' ->
|
displayprogress p k $ \p' ->
|
||||||
storeChunks (uuid baser) chunkconfig k src p'
|
storeChunks (uuid baser) chunkconfig k src p'
|
||||||
(storechunk enc storer)
|
(storechunk enc storer)
|
||||||
(hasKey baser)
|
(checkPresent baser)
|
||||||
go Nothing = return False
|
go Nothing = return False
|
||||||
rollback = void $ removeKey encr k
|
rollback = void $ removeKey encr k
|
||||||
|
|
||||||
|
@ -193,10 +193,10 @@ specialRemote' cfg c preparestorer prepareretriever baser = encr
|
||||||
enck = maybe id snd enc
|
enck = maybe id snd enc
|
||||||
remover = removeKey baser
|
remover = removeKey baser
|
||||||
|
|
||||||
hasKeyGen k enc = hasKeyChunks checker (uuid baser) chunkconfig enck k
|
checkPresentGen k enc = checkPresentChunks checker (uuid baser) chunkconfig enck k
|
||||||
where
|
where
|
||||||
enck = maybe id snd enc
|
enck = maybe id snd enc
|
||||||
checker = hasKey baser
|
checker = checkPresent baser
|
||||||
|
|
||||||
chunkconfig = chunkConfig cfg
|
chunkconfig = chunkConfig cfg
|
||||||
|
|
||||||
|
|
|
@ -81,14 +81,14 @@ onRemote r (with, errorval) command params fields = do
|
||||||
Nothing -> return errorval
|
Nothing -> return errorval
|
||||||
|
|
||||||
{- Checks if a remote contains a key. -}
|
{- Checks if a remote contains a key. -}
|
||||||
inAnnex :: Git.Repo -> Key -> Annex (Either String Bool)
|
inAnnex :: Git.Repo -> Key -> Annex Bool
|
||||||
inAnnex r k = do
|
inAnnex r k = do
|
||||||
showChecking r
|
showChecking r
|
||||||
onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] []
|
onRemote r (check, cantCheck r) "inannex" [Param $ key2file k] []
|
||||||
where
|
where
|
||||||
check c p = dispatch <$> safeSystem c p
|
check c p = dispatch <$> safeSystem c p
|
||||||
dispatch ExitSuccess = Right True
|
dispatch ExitSuccess = True
|
||||||
dispatch (ExitFailure 1) = Right False
|
dispatch (ExitFailure 1) = False
|
||||||
dispatch _ = cantCheck r
|
dispatch _ = cantCheck r
|
||||||
|
|
||||||
{- Removes a key from a remote. -}
|
{- Removes a key from a remote. -}
|
||||||
|
|
|
@ -45,8 +45,8 @@ gen r u c gc = do
|
||||||
retrieveKeyFile = retreiveKeyFileDummy,
|
retrieveKeyFile = retreiveKeyFileDummy,
|
||||||
retrieveKeyFileCheap = retrieveCheap hooktype,
|
retrieveKeyFileCheap = retrieveCheap hooktype,
|
||||||
removeKey = remove hooktype,
|
removeKey = remove hooktype,
|
||||||
hasKey = checkPresent r hooktype,
|
checkPresent = checkKey r hooktype,
|
||||||
hasKeyCheap = False,
|
checkPresentCheap = False,
|
||||||
whereisKey = Nothing,
|
whereisKey = Nothing,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -128,11 +128,11 @@ retrieveCheap _ _ _ = return False
|
||||||
remove :: HookName -> Key -> Annex Bool
|
remove :: HookName -> Key -> Annex Bool
|
||||||
remove h k = runHook h "remove" k Nothing $ return True
|
remove h k = runHook h "remove" k Nothing $ return True
|
||||||
|
|
||||||
checkPresent :: Git.Repo -> HookName -> Key -> Annex (Either String Bool)
|
checkKey :: Git.Repo -> HookName -> Key -> Annex Bool
|
||||||
checkPresent r h k = do
|
checkKey r h k = do
|
||||||
showAction $ "checking " ++ Git.repoDescribe r
|
showAction $ "checking " ++ Git.repoDescribe r
|
||||||
v <- lookupHook h action
|
v <- lookupHook h action
|
||||||
liftIO $ catchMsgIO $ check v
|
liftIO $ check v
|
||||||
where
|
where
|
||||||
action = "checkpresent"
|
action = "checkpresent"
|
||||||
findkey s = key2file k `elem` lines s
|
findkey s = key2file k `elem` lines s
|
||||||
|
|
|
@ -12,7 +12,7 @@ module Remote.Rsync (
|
||||||
store,
|
store,
|
||||||
retrieve,
|
retrieve,
|
||||||
remove,
|
remove,
|
||||||
checkPresent,
|
checkKey,
|
||||||
withRsyncScratchDir,
|
withRsyncScratchDir,
|
||||||
genRsyncOpts,
|
genRsyncOpts,
|
||||||
RsyncOpts
|
RsyncOpts
|
||||||
|
@ -66,8 +66,8 @@ gen r u c gc = do
|
||||||
, retrieveKeyFile = retreiveKeyFileDummy
|
, retrieveKeyFile = retreiveKeyFileDummy
|
||||||
, retrieveKeyFileCheap = retrieveCheap o
|
, retrieveKeyFileCheap = retrieveCheap o
|
||||||
, removeKey = remove o
|
, removeKey = remove o
|
||||||
, hasKey = checkPresent r o
|
, checkPresent = checkKey r o
|
||||||
, hasKeyCheap = False
|
, checkPresentCheap = False
|
||||||
, whereisKey = Nothing
|
, whereisKey = Nothing
|
||||||
, remoteFsck = Nothing
|
, remoteFsck = Nothing
|
||||||
, repairRepo = Nothing
|
, repairRepo = Nothing
|
||||||
|
@ -214,14 +214,12 @@ remove o k = do
|
||||||
, dir </> keyFile k </> "***"
|
, dir </> keyFile k </> "***"
|
||||||
]
|
]
|
||||||
|
|
||||||
checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either String Bool)
|
checkKey :: Git.Repo -> RsyncOpts -> Key -> Annex Bool
|
||||||
checkPresent r o k = do
|
checkKey r o k = do
|
||||||
showAction $ "checking " ++ Git.repoDescribe r
|
showAction $ "checking " ++ Git.repoDescribe r
|
||||||
-- note: Does not currently differentiate between rsync failing
|
-- note: Does not currently differentiate between rsync failing
|
||||||
-- to connect, and the file not being present.
|
-- to connect, and the file not being present.
|
||||||
Right <$> check
|
untilTrue (rsyncUrls o k) $ \u ->
|
||||||
where
|
|
||||||
check = untilTrue (rsyncUrls o k) $ \u ->
|
|
||||||
liftIO $ catchBoolIO $ do
|
liftIO $ catchBoolIO $ do
|
||||||
withQuietOutput createProcessSuccess $
|
withQuietOutput createProcessSuccess $
|
||||||
proc "rsync" $ toCommand $
|
proc "rsync" $ toCommand $
|
||||||
|
|
16
Remote/S3.hs
16
Remote/S3.hs
|
@ -57,8 +57,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
||||||
retrieveKeyFile = retreiveKeyFileDummy,
|
retrieveKeyFile = retreiveKeyFileDummy,
|
||||||
retrieveKeyFileCheap = retrieveCheap this,
|
retrieveKeyFileCheap = retrieveCheap this,
|
||||||
removeKey = remove this c,
|
removeKey = remove this c,
|
||||||
hasKey = checkPresent this,
|
checkPresent = checkKey this,
|
||||||
hasKeyCheap = False,
|
checkPresentCheap = False,
|
||||||
whereisKey = Nothing,
|
whereisKey = Nothing,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -167,16 +167,16 @@ remove' :: Remote -> Key -> Annex Bool
|
||||||
remove' r k = s3Action r False $ \(conn, bucket) ->
|
remove' r k = s3Action r False $ \(conn, bucket) ->
|
||||||
s3Bool =<< liftIO (deleteObject conn $ bucketKey r bucket k)
|
s3Bool =<< liftIO (deleteObject conn $ bucketKey r bucket k)
|
||||||
|
|
||||||
checkPresent :: Remote -> Key -> Annex (Either String Bool)
|
checkKey :: Remote -> Key -> Annex Bool
|
||||||
checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
|
checkKey r k = s3Action r noconn $ \(conn, bucket) -> do
|
||||||
showAction $ "checking " ++ name r
|
showAction $ "checking " ++ name r
|
||||||
res <- liftIO $ getObjectInfo conn $ bucketKey r bucket k
|
res <- liftIO $ getObjectInfo conn $ bucketKey r bucket k
|
||||||
case res of
|
case res of
|
||||||
Right _ -> return $ Right True
|
Right _ -> return True
|
||||||
Left (AWSError _ _) -> return $ Right False
|
Left (AWSError _ _) -> return False
|
||||||
Left e -> return $ Left (s3Error e)
|
Left e -> s3Error e
|
||||||
where
|
where
|
||||||
noconn = Left $ error "S3 not configured"
|
noconn = error "S3 not configured"
|
||||||
|
|
||||||
s3Warning :: ReqError -> Annex Bool
|
s3Warning :: ReqError -> Annex Bool
|
||||||
s3Warning e = do
|
s3Warning e = do
|
||||||
|
|
|
@ -72,8 +72,8 @@ gen r u c gc = do
|
||||||
retrieveKeyFile = retrieve u hdl,
|
retrieveKeyFile = retrieve u hdl,
|
||||||
retrieveKeyFileCheap = \_ _ -> return False,
|
retrieveKeyFileCheap = \_ _ -> return False,
|
||||||
removeKey = remove,
|
removeKey = remove,
|
||||||
hasKey = checkPresent u hdl,
|
checkPresent = checkKey u hdl,
|
||||||
hasKeyCheap = False,
|
checkPresentCheap = False,
|
||||||
whereisKey = Nothing,
|
whereisKey = Nothing,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -123,14 +123,16 @@ remove _k = do
|
||||||
warning "content cannot be removed from tahoe remote"
|
warning "content cannot be removed from tahoe remote"
|
||||||
return False
|
return False
|
||||||
|
|
||||||
checkPresent :: UUID -> TahoeHandle -> Key -> Annex (Either String Bool)
|
checkKey :: UUID -> TahoeHandle -> Key -> Annex Bool
|
||||||
checkPresent u hdl k = go =<< getCapability u k
|
checkKey u hdl k = go =<< getCapability u k
|
||||||
where
|
where
|
||||||
go Nothing = return (Right False)
|
go Nothing = return False
|
||||||
go (Just cap) = liftIO $ parseCheck <$> readTahoe hdl "check"
|
go (Just cap) = liftIO $ do
|
||||||
|
v <- parseCheck <$> readTahoe hdl "check"
|
||||||
[ Param "--raw"
|
[ Param "--raw"
|
||||||
, Param cap
|
, Param cap
|
||||||
]
|
]
|
||||||
|
either error return v
|
||||||
|
|
||||||
defaultTahoeConfigDir :: UUID -> IO TahoeConfigDir
|
defaultTahoeConfigDir :: UUID -> IO TahoeConfigDir
|
||||||
defaultTahoeConfigDir u = do
|
defaultTahoeConfigDir u = do
|
||||||
|
|
|
@ -50,8 +50,8 @@ gen r _ c gc =
|
||||||
retrieveKeyFile = downloadKey,
|
retrieveKeyFile = downloadKey,
|
||||||
retrieveKeyFileCheap = downloadKeyCheap,
|
retrieveKeyFileCheap = downloadKeyCheap,
|
||||||
removeKey = dropKey,
|
removeKey = dropKey,
|
||||||
hasKey = checkKey,
|
checkPresent = checkKey,
|
||||||
hasKeyCheap = False,
|
checkPresentCheap = False,
|
||||||
whereisKey = Just getUrls,
|
whereisKey = Just getUrls,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -98,12 +98,12 @@ dropKey k = do
|
||||||
mapM_ (setUrlMissing k) =<< getUrls k
|
mapM_ (setUrlMissing k) =<< getUrls k
|
||||||
return True
|
return True
|
||||||
|
|
||||||
checkKey :: Key -> Annex (Either String Bool)
|
checkKey :: Key -> Annex Bool
|
||||||
checkKey key = do
|
checkKey key = do
|
||||||
us <- getUrls key
|
us <- getUrls key
|
||||||
if null us
|
if null us
|
||||||
then return $ Right False
|
then return False
|
||||||
else return =<< checkKey' key us
|
else either error return =<< checkKey' key us
|
||||||
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
|
||||||
|
|
|
@ -63,8 +63,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
|
||||||
retrieveKeyFile = retrieve this,
|
retrieveKeyFile = retrieve this,
|
||||||
retrieveKeyFileCheap = retrieveCheap this,
|
retrieveKeyFileCheap = retrieveCheap this,
|
||||||
removeKey = remove this,
|
removeKey = remove this,
|
||||||
hasKey = checkPresent this,
|
checkPresent = checkKey this,
|
||||||
hasKeyCheap = False,
|
checkPresentCheap = False,
|
||||||
whereisKey = Nothing,
|
whereisKey = Nothing,
|
||||||
remoteFsck = Nothing,
|
remoteFsck = Nothing,
|
||||||
repairRepo = Nothing,
|
repairRepo = Nothing,
|
||||||
|
@ -170,10 +170,10 @@ remove r k = davAction r False $ \(baseurl, user, pass) -> liftIO $ do
|
||||||
let url = davLocation baseurl k
|
let url = davLocation baseurl k
|
||||||
isJust . eitherToMaybe <$> tryNonAsync (deleteDAV url user pass)
|
isJust . eitherToMaybe <$> tryNonAsync (deleteDAV url user pass)
|
||||||
|
|
||||||
checkPresent :: Remote -> Key -> Annex (Either String Bool)
|
checkKey :: Remote -> Key -> Annex Bool
|
||||||
checkPresent r k = davAction r noconn go
|
checkKey r k = davAction r noconn (either error id <$$> go)
|
||||||
where
|
where
|
||||||
noconn = Left $ error $ name r ++ " not configured"
|
noconn = error $ name r ++ " not configured"
|
||||||
|
|
||||||
go (baseurl, user, pass) = do
|
go (baseurl, user, pass) = do
|
||||||
showAction $ "checking " ++ name r
|
showAction $ "checking " ++ name r
|
||||||
|
|
|
@ -68,12 +68,12 @@ data RemoteA a = Remote {
|
||||||
retrieveKeyFileCheap :: Key -> FilePath -> a Bool,
|
retrieveKeyFileCheap :: Key -> FilePath -> a Bool,
|
||||||
-- removes a key's contents (succeeds if the contents are not present)
|
-- removes a key's contents (succeeds if the contents are not present)
|
||||||
removeKey :: Key -> a Bool,
|
removeKey :: Key -> a Bool,
|
||||||
-- Checks if a key is present in the remote; if the remote
|
-- Checks if a key is present in the remote.
|
||||||
-- cannot be accessed returns a Left error message.
|
-- Throws an exception if the remote cannot be accessed.
|
||||||
hasKey :: Key -> a (Either String Bool),
|
checkPresent :: Key -> a Bool,
|
||||||
-- Some remotes can check hasKey without an expensive network
|
-- Some remotes can checkPresent without an expensive network
|
||||||
-- operation.
|
-- operation.
|
||||||
hasKeyCheap :: Bool,
|
checkPresentCheap :: Bool,
|
||||||
-- Some remotes can provide additional details for whereis.
|
-- Some remotes can provide additional details for whereis.
|
||||||
whereisKey :: Maybe (Key -> a [String]),
|
whereisKey :: Maybe (Key -> a [String]),
|
||||||
-- Some remotes can run a fsck operation on the remote,
|
-- Some remotes can run a fsck operation on the remote,
|
||||||
|
|
|
@ -33,3 +33,11 @@ type Storer = Key -> ContentSource -> MeterUpdate -> Annex Bool
|
||||||
-- callback, which will fully consume the content before returning.
|
-- callback, which will fully consume the content before returning.
|
||||||
-- Throws exception if key is not present, or remote is not accessible.
|
-- Throws exception if key is not present, or remote is not accessible.
|
||||||
type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex Bool) -> Annex Bool
|
type Retriever = Key -> MeterUpdate -> (ContentSource -> Annex Bool) -> Annex Bool
|
||||||
|
|
||||||
|
-- Action that removes a Key's content from a remote.
|
||||||
|
-- Succeeds if key is already not present; never throws exceptions.
|
||||||
|
type Remover = Key -> Annex Bool
|
||||||
|
|
||||||
|
-- Checks if a Key's content is present on a remote.
|
||||||
|
-- Throws an exception if the remote is not accessible.
|
||||||
|
type CheckPresent = Key -> Annex Bool
|
||||||
|
|
|
@ -91,7 +91,7 @@ cannot tell when we've gotten the last chunk. (Also, we cannot strip
|
||||||
padding.) Note that `addurl` sometimes generates keys w/o size info
|
padding.) Note that `addurl` sometimes generates keys w/o size info
|
||||||
(particularly, it does so by design when using quvi).
|
(particularly, it does so by design when using quvi).
|
||||||
|
|
||||||
Problem: Also, this makes `hasKey` hard to implement: How can it know if
|
Problem: Also, this makes `checkPresent` hard to implement: How can it know if
|
||||||
all the chunks are present, if the key size is not known?
|
all the chunks are present, if the key size is not known?
|
||||||
|
|
||||||
Problem: Also, this makes it difficult to download encrypted keys, because
|
Problem: Also, this makes it difficult to download encrypted keys, because
|
||||||
|
@ -111,7 +111,7 @@ So, SHA256-1048576-c1--xxxxxxx for the first chunk of 1 megabyte.
|
||||||
Before any chunks are stored, write a chunkcount file, eg
|
Before any chunks are stored, write a chunkcount file, eg
|
||||||
SHA256-s12345-c0--xxxxxxx. Note that this key is the same as the original
|
SHA256-s12345-c0--xxxxxxx. Note that this key is the same as the original
|
||||||
object's key, except with chunk number set to 0. This file contains both
|
object's key, except with chunk number set to 0. This file contains both
|
||||||
the number of chunks, and also the chunk size used. `hasKey` downloads this
|
the number of chunks, and also the chunk size used. `checkPresent` downloads this
|
||||||
file, and then verifies that each chunk is present, looking for keys with
|
file, and then verifies that each chunk is present, looking for keys with
|
||||||
the expected chunk numbers and chunk size.
|
the expected chunk numbers and chunk size.
|
||||||
|
|
||||||
|
@ -126,7 +126,7 @@ Note: This design lets an attacker with logs tell the (appoximate) size of
|
||||||
objects, by finding the small files that contain a chunk count, and
|
objects, by finding the small files that contain a chunk count, and
|
||||||
correlating when that is written/read and when other files are
|
correlating when that is written/read and when other files are
|
||||||
written/read. That could be solved by padding the chunkcount key up to the
|
written/read. That could be solved by padding the chunkcount key up to the
|
||||||
size of the rest of the keys, but that's very innefficient; `hasKey` is not
|
size of the rest of the keys, but that's very innefficient; `checkPresent` is not
|
||||||
designed to need to download large files.
|
designed to need to download large files.
|
||||||
|
|
||||||
# design 3
|
# design 3
|
||||||
|
@ -139,7 +139,7 @@ This seems difficult; attacker could probably tell where the first encrypted
|
||||||
part stops and the next encrypted part starts by looking for gpg headers,
|
part stops and the next encrypted part starts by looking for gpg headers,
|
||||||
and so tell which files are the first chunks.
|
and so tell which files are the first chunks.
|
||||||
|
|
||||||
Also, `hasKey` would need to download some or all of the first file.
|
Also, `checkPresent` would need to download some or all of the first file.
|
||||||
If all, that's a lot more expensive. If only some is downloaded, an
|
If all, that's a lot more expensive. If only some is downloaded, an
|
||||||
attacker can guess that the file that was partially downloaded is the
|
attacker can guess that the file that was partially downloaded is the
|
||||||
first chunk in a series, and wait for a time when it's fully downloaded to
|
first chunk in a series, and wait for a time when it's fully downloaded to
|
||||||
|
@ -163,7 +163,7 @@ The location log does not record locations of individual chunk keys
|
||||||
(too space-inneficient). Instead, look at a chunk log in the
|
(too space-inneficient). Instead, look at a chunk log in the
|
||||||
git-annex branch to get the chunk count and size for a key.
|
git-annex branch to get the chunk count and size for a key.
|
||||||
|
|
||||||
`hasKey` would check if any of the logged sets of chunks is
|
`checkPresent` would check if any of the logged sets of chunks is
|
||||||
present on the remote. It would also check if the non-chunked key is
|
present on the remote. It would also check if the non-chunked key is
|
||||||
present, as a fallback.
|
present, as a fallback.
|
||||||
|
|
||||||
|
@ -225,7 +225,7 @@ Reasons:
|
||||||
|
|
||||||
Note that this means that the chunks won't exactly match the configured
|
Note that this means that the chunks won't exactly match the configured
|
||||||
chunk size. gpg does compression, which might make them a
|
chunk size. gpg does compression, which might make them a
|
||||||
lot smaller. Or gpg overhead could make them slightly larger. So `hasKey`
|
lot smaller. Or gpg overhead could make them slightly larger. So `checkPresent`
|
||||||
cannot check exact file sizes.
|
cannot check exact file sizes.
|
||||||
|
|
||||||
If padding is enabled, gpg compression should be disabled, to not leak
|
If padding is enabled, gpg compression should be disabled, to not leak
|
||||||
|
@ -250,10 +250,10 @@ and skip forward to the next needed chunk. Easy.
|
||||||
Uploads: Check if the 1st chunk is present. If so, check the second chunk,
|
Uploads: Check if the 1st chunk is present. If so, check the second chunk,
|
||||||
etc. Once the first missing chunk is found, start uploading from there.
|
etc. Once the first missing chunk is found, start uploading from there.
|
||||||
|
|
||||||
That adds one extra hasKey call per upload. Probably a win in most cases.
|
That adds one extra checkPresent call per upload. Probably a win in most cases.
|
||||||
Can be improved by making special remotes open a persistent
|
Can be improved by making special remotes open a persistent
|
||||||
connection that is used for transferring all chunks, as well as for
|
connection that is used for transferring all chunks, as well as for
|
||||||
checking hasKey.
|
checking checkPresent.
|
||||||
|
|
||||||
Note that this is safe to do only as long as the Key being transferred
|
Note that this is safe to do only as long as the Key being transferred
|
||||||
cannot possibly have 2 different contents in different repos. Notably not
|
cannot possibly have 2 different contents in different repos. Notably not
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue