don't show key urls in whereis for S3 with public=yes and exporttree=yes
This commit is contained in:
parent
0228714406
commit
afdff226fb
2 changed files with 19 additions and 12 deletions
|
@ -37,6 +37,11 @@ instance HasExportUnsupported (ExportActions Annex) where
|
|||
, renameExport = \_ _ _ -> return False
|
||||
}
|
||||
|
||||
exportTree :: RemoteConfig -> Bool
|
||||
exportTree c = case M.lookup "exporttree" c of
|
||||
Just "yes" -> True
|
||||
_ -> False
|
||||
|
||||
exportIsSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
|
||||
exportIsSupported = \_ _ -> return True
|
||||
|
||||
|
@ -49,17 +54,17 @@ adjustExportableRemoteType rt = rt { setup = setup' }
|
|||
let cont = setup rt st mu cp c gc
|
||||
ifM (exportSupported rt c gc)
|
||||
( case st of
|
||||
Init -> case M.lookup "exporttree" c of
|
||||
Just "yes" | isEncrypted c ->
|
||||
Init
|
||||
| exportTree c && isEncrypted c ->
|
||||
giveup "cannot enable both encryption and exporttree"
|
||||
_ -> cont
|
||||
| otherwise -> cont
|
||||
Enable oldc
|
||||
| M.lookup "exporttree" c /= M.lookup "exporttree" oldc ->
|
||||
| exportTree c /= exportTree oldc ->
|
||||
giveup "cannot change exporttree of existing special remote"
|
||||
| otherwise -> cont
|
||||
, case M.lookup "exporttree" c of
|
||||
Just "yes" -> giveup "exporttree=yes is not supported by this special remote"
|
||||
_ -> cont
|
||||
, if exportTree c
|
||||
then giveup "exporttree=yes is not supported by this special remote"
|
||||
else cont
|
||||
)
|
||||
|
||||
-- | If the remote is exportSupported, and exporttree=yes, adjust the
|
||||
|
|
12
Remote/S3.hs
12
Remote/S3.hs
|
@ -93,7 +93,7 @@ gen r u c gc = do
|
|||
, checkPresentExport = checkPresentExportS3 this info
|
||||
, renameExport = renameExportS3 this info
|
||||
}
|
||||
, whereisKey = Just (getWebUrls info)
|
||||
, whereisKey = Just (getWebUrls info c)
|
||||
, remoteFsck = Nothing
|
||||
, repairRepo = Nothing
|
||||
, config = c
|
||||
|
@ -695,8 +695,10 @@ s3Info c info = catMaybes
|
|||
#endif
|
||||
showstorageclass sc = show sc
|
||||
|
||||
getWebUrls :: S3Info -> Key -> Annex [URLString]
|
||||
getWebUrls info k = case (public info, getpublicurl info) of
|
||||
(True, Just geturl) -> return [geturl k]
|
||||
_ -> return []
|
||||
getWebUrls :: S3Info -> RemoteConfig -> Key -> Annex [URLString]
|
||||
getWebUrls info c k
|
||||
| exportTree c = return []
|
||||
| otherwise = case (public info, getpublicurl info) of
|
||||
(True, Just geturl) -> return [geturl k]
|
||||
_ -> return []
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue