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

2 files changed, 19 insertions, 12 deletions

diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
index dacf05845..517b4333f 100644
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@@ -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
diff --git a/Remote/S3.hs b/Remote/S3.hs
index f80a08bb2..c7b72def5 100644
--- a/Remote/S3.hs
+++ b/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 []