don't show key urls in whereis for S3 with public=yes and exporttree=yes

This commit is contained in:
Joey Hess 2017-09-08 16:44:00 -04:00
parent 0228714406
commit afdff226fb
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 19 additions and 12 deletions

View file

@ -37,6 +37,11 @@ instance HasExportUnsupported (ExportActions Annex) where
, renameExport = \_ _ _ -> return False , renameExport = \_ _ _ -> return False
} }
exportTree :: RemoteConfig -> Bool
exportTree c = case M.lookup "exporttree" c of
Just "yes" -> True
_ -> False
exportIsSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool exportIsSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
exportIsSupported = \_ _ -> return True exportIsSupported = \_ _ -> return True
@ -49,17 +54,17 @@ adjustExportableRemoteType rt = rt { setup = setup' }
let cont = setup rt st mu cp c gc let cont = setup rt st mu cp c gc
ifM (exportSupported rt c gc) ifM (exportSupported rt c gc)
( case st of ( case st of
Init -> case M.lookup "exporttree" c of Init
Just "yes" | isEncrypted c -> | exportTree c && isEncrypted c ->
giveup "cannot enable both encryption and exporttree" giveup "cannot enable both encryption and exporttree"
_ -> cont | otherwise -> cont
Enable oldc Enable oldc
| M.lookup "exporttree" c /= M.lookup "exporttree" oldc -> | exportTree c /= exportTree oldc ->
giveup "cannot change exporttree of existing special remote" giveup "cannot change exporttree of existing special remote"
| otherwise -> cont | otherwise -> cont
, case M.lookup "exporttree" c of , if exportTree c
Just "yes" -> giveup "exporttree=yes is not supported by this special remote" then giveup "exporttree=yes is not supported by this special remote"
_ -> cont else cont
) )
-- | If the remote is exportSupported, and exporttree=yes, adjust the -- | If the remote is exportSupported, and exporttree=yes, adjust the

View file

@ -93,7 +93,7 @@ gen r u c gc = do
, checkPresentExport = checkPresentExportS3 this info , checkPresentExport = checkPresentExportS3 this info
, renameExport = renameExportS3 this info , renameExport = renameExportS3 this info
} }
, whereisKey = Just (getWebUrls info) , whereisKey = Just (getWebUrls info c)
, remoteFsck = Nothing , remoteFsck = Nothing
, repairRepo = Nothing , repairRepo = Nothing
, config = c , config = c
@ -695,8 +695,10 @@ s3Info c info = catMaybes
#endif #endif
showstorageclass sc = show sc showstorageclass sc = show sc
getWebUrls :: S3Info -> Key -> Annex [URLString] getWebUrls :: S3Info -> RemoteConfig -> Key -> Annex [URLString]
getWebUrls info k = case (public info, getpublicurl info) of getWebUrls info c k
(True, Just geturl) -> return [geturl k] | exportTree c = return []
_ -> return [] | otherwise = case (public info, getpublicurl info) of
(True, Just geturl) -> return [geturl k]
_ -> return []