diff options
| -rw-r--r-- | Remote/Helper/Export.hs | 19 | ||||
| -rw-r--r-- | Remote/S3.hs | 12 |
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 [] |