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
|
, 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
|
||||||
|
|
12
Remote/S3.hs
12
Remote/S3.hs
|
@ -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 []
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue