prep for enabling remotre gcrypt repos in webapp

This commit is contained in:
Joey Hess 2013-09-26 17:26:13 -04:00
parent 588494cbce
commit 735ed3b822
5 changed files with 83 additions and 48 deletions

View file

@ -24,6 +24,7 @@ import Logs.Trust
import Logs.Group
import Config
import Git.Config
import Git.Remote
import Assistant.Sync
import Config.Cost
import qualified Git
@ -156,8 +157,9 @@ repoList reposelector
else return l
unconfigured = liftAnnex $ do
m <- readRemoteLog
g <- gitRepo
map snd . catMaybes . filter selectedremote
. map (findinfo m)
. map (findinfo m g)
<$> (trustExclude DeadTrusted $ M.keys m)
selectedrepo r
| Remote.readonly r = False
@ -167,7 +169,7 @@ repoList reposelector
selectedremote (Just (iscloud, _))
| onlyCloud reposelector = iscloud
| otherwise = True
findinfo m u = case M.lookup "type" =<< M.lookup u m of
findinfo m g u = case getconfig "type" of
Just "rsync" -> val True EnableRsyncR
Just "directory" -> val False EnableDirectoryR
#ifdef WITH_S3
@ -177,8 +179,16 @@ repoList reposelector
#ifdef WITH_WEBDAV
Just "webdav" -> val True EnableWebDAVR
#endif
Just "gcrypt" ->
-- Skip gcrypt repos on removable drives;
-- handled separately.
case getconfig "gitrepo" of
Just rr | remoteLocationIsUrl (parseRemoteLocation rr g) ->
val True EnableGCryptR
_ -> Nothing
_ -> Nothing
where
getconfig k = M.lookup k =<< M.lookup u m
val iscloud r = Just (iscloud, (u, DisabledRepoActions $ r u))
list l = liftAnnex $ do
let l' = nubBy (\x y -> fst x == fst y) l