diff options
| -rw-r--r-- | Command/InitRemote.hs | 20 | ||||
| -rw-r--r-- | Remote.hs | 67 | ||||
| -rw-r--r-- | Remote/Git.hs | 5 | ||||
| -rw-r--r-- | Remote/S3.hs | 7 | ||||
| -rw-r--r-- | RemoteClass.hs | 3 | ||||
| -rw-r--r-- | doc/internals.mdwn | 4 |
6 files changed, 57 insertions, 49 deletions
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index cf6a341c5..0d9a40cd3 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -29,12 +29,12 @@ start :: CommandStartString start params = notBareRepo $ do when (null ws) $ error "Specify a name for the remote" showStart "initremote" name - r <- Remote.configGet name - (u, c) <- case r of + m <- Remote.readRemoteLog + (u, c) <- case findByName name m of Just t -> return t Nothing -> do uuid <- liftIO $ genUUID - return $ (uuid, M.empty) + return $ (uuid, M.insert nameKey name M.empty) return $ Just $ perform name u $ M.union config c where @@ -46,3 +46,17 @@ perform :: String -> UUID -> M.Map String String -> CommandPerform perform name uuid config = do liftIO $ putStrLn $ show $ (uuid, config) return Nothing + +findByName :: String -> M.Map UUID (M.Map String String) -> Maybe (UUID, M.Map String String) +findByName n m = if null matches then Nothing else Just $ head matches + where + matches = filter (matching . snd) $ M.toList m + matching c = case M.lookup nameKey c of + Nothing -> False + Just n' + | n' == n -> True + | otherwise -> False + +{- The name of a configured remote is stored in its config using this key. -} +nameKey :: String +nameKey = "name" @@ -21,7 +21,7 @@ module Remote ( remotesWithUUID, remotesWithoutUUID, - configGet, + readRemoteLog, configSet, keyValToMap ) where @@ -71,7 +71,8 @@ genList = do if null rs then do rs' <- runGenerators - Annex.changeState $ \s -> s { Annex.remotes = rs' } + rs'' <- getConfigs rs' + Annex.changeState $ \s -> s { Annex.remotes = rs'' } return rs' else return rs @@ -132,51 +133,47 @@ remoteLog = do g <- Annex.gitRepo return $ gitStateDir g ++ "remote.log" -{- Reads the uuid and config of the specified remote from the remoteLog. -} -configGet :: String -> Annex (Maybe (UUID, M.Map String String)) -configGet n = do - rs <- readRemoteLog - let matches = filter (matchName n) rs - case matches of - [] -> return Nothing - ((u, _, c):_) -> return $ Just (u, c) - -{- Changes or adds a remote's config in the remoteLog. -} -configSet :: String -> UUID -> M.Map String String -> Annex () -configSet n u c = do - rs <- readRemoteLog - let others = filter (not . matchName n) rs - writeRemoteLog $ (u, n, c):others - -matchName :: String -> (UUID, String, M.Map String String) -> Bool -matchName n (_, n', _) = n == n' - -readRemoteLog :: Annex [(UUID, String, M.Map String String)] -readRemoteLog = do +{- Load stored config into remotes. + - + - This way, the log is read once, lazily, so if no remotes access + - their config, no work is done. + -} +getConfigs :: [Remote Annex] -> Annex [Remote Annex] +getConfigs rs = do + m <- readRemoteLog + return $ map (get m) rs + where + get m r = r { config = M.lookup (uuid r) m } + +{- Adds or updates a remote's config in the log. -} +configSet :: UUID -> M.Map String String -> Annex () +configSet u c = do + m <- readRemoteLog l <- remoteLog - s <- liftIO $ catch (readFile l) ignoreerror - return $ remoteLogParse s + liftIO $ writeFile l $ unlines $ map toline $ M.toList $ M.insert u c m where - ignoreerror _ = return [] + toline (u', c') = u' ++ " " ++ (unwords $ mapToKeyVal c') -writeRemoteLog :: [(UUID, String, M.Map String String)] -> Annex () -writeRemoteLog rs = do +{- Map of remotes by uuid containing key/value config maps. -} +readRemoteLog :: Annex (M.Map UUID (M.Map String String)) +readRemoteLog = do l <- remoteLog - liftIO $ writeFile l $ unlines $ map toline rs + s <- liftIO $ catch (readFile l) ignoreerror + return $ remoteLogParse s where - toline (u, n, c) = u ++ " " ++ n ++ (unwords $ mapToKeyVal c) + ignoreerror _ = return "" -remoteLogParse :: String -> [(UUID, String, M.Map String String)] -remoteLogParse s = catMaybes $ map parseline $ filter (not . null) $ lines s +remoteLogParse :: String -> M.Map UUID (M.Map String String) +remoteLogParse s = + M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s where parseline l - | length w > 2 = Just (u, n, c) + | length w > 2 = Just (u, c) | otherwise = Nothing where w = words l u = w !! 0 - n = w !! 1 - c = keyValToMap $ drop 2 w + c = keyValToMap $ tail w {- Given Strings like "key=value", generates a Map. -} keyValToMap :: [String] -> M.Map String String diff --git a/Remote/Git.hs b/Remote/Git.hs index 68bd172e9..b686e47af 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -12,7 +12,7 @@ module Remote.Git ( import Control.Exception.Extensible import Control.Monad.State (liftIO) -import qualified Data.Map as Map +import qualified Data.Map as M import System.Cmd.Utils import Control.Monad (filterM, liftM) @@ -68,7 +68,6 @@ genRemote r = do removeKey = dropKey r, hasKey = inAnnex r, hasKeyCheap = not (Git.repoIsUrl r), - hasConfig = False, config = Nothing, setup = \_ -> return () } @@ -77,7 +76,7 @@ genRemote r = do - returns the updated repo. -} tryGitConfigRead :: Git.Repo -> Annex Git.Repo tryGitConfigRead r - | not $ Map.null $ Git.configMap r = return r -- already read + | not $ M.null $ Git.configMap r = return r -- already read | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] | Git.repoIsUrl r = return r | otherwise = store $ safely $ Git.configRead r diff --git a/Remote/S3.hs b/Remote/S3.hs index 4aa1bc639..7971faa8f 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -12,7 +12,7 @@ import Network.AWS.S3Object import Network.AWS.S3Bucket import Network.AWS.AWSResult import qualified Data.ByteString.Lazy.Char8 as L -import qualified Data.Map as Map +import qualified Data.Map as M import Data.String.Utils import Control.Monad (filterM, liftM, when) import Control.Monad.State (liftIO) @@ -51,8 +51,8 @@ gen = do findS3Remotes :: Git.Repo -> [Git.Repo] findS3Remotes r = map construct remotepairs where - remotepairs = Map.toList $ filterremotes $ Git.configMap r - filterremotes = Map.filterWithKey (\k _ -> s3remote k) + remotepairs = M.toList $ filterremotes $ Git.configMap r + filterremotes = M.filterWithKey (\k _ -> s3remote k) construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k s3remote k = startswith "remote." k && endswith ".annex-s3-bucket" k @@ -68,7 +68,6 @@ genRemote r u = do removeKey = error "TODO", hasKey = error "TODO", hasKeyCheap = False, - hasConfig = True, config = Nothing, setup = \_ -> return () } diff --git a/RemoteClass.hs b/RemoteClass.hs index f3cc9379b..0482faac7 100644 --- a/RemoteClass.hs +++ b/RemoteClass.hs @@ -47,8 +47,7 @@ data Remote a = Remote { -- Some remotes can check hasKey without an expensive network -- operation. hasKeyCheap :: Bool, - -- a Remote may have a persistent configuration store - hasConfig :: Bool, + -- a Remote can have a persistent configuration store config :: Maybe (M.Map String String), -- initializes or changes the config of a remote setup :: M.Map String String -> a () diff --git a/doc/internals.mdwn b/doc/internals.mdwn index 629609503..2e9f25383 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -36,8 +36,8 @@ Holds persistent configuration settings for [[special_remotes]] such as Amazon S3. The file format is one line per remote, starting with the uuid of the -remote, followed by a space, the name of the remote, a space, and then -a series of key=value pairs, each separated by whitespace. +remote, followed by a space, and then a series of key=value pairs, +each separated by whitespace. ## `.git-annex/trust.log` |