From 05751d55cd8002e6a2a2afc520622fb6697472e3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Mar 2011 13:49:54 -0400 Subject: [PATCH] clean up remote.log handling --- Command/InitRemote.hs | 20 +++++++++++--- Remote.hs | 63 +++++++++++++++++++++---------------------- Remote/Git.hs | 5 ++-- Remote/S3.hs | 7 +++-- RemoteClass.hs | 3 +-- doc/internals.mdwn | 4 +-- 6 files changed, 55 insertions(+), 47 deletions(-) diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index cf6a341c53..0d9a40cd33 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" diff --git a/Remote.hs b/Remote.hs index 71bc08c8ae..f79b512625 100644 --- a/Remote.hs +++ b/Remote.hs @@ -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) +{- 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 } -{- 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 +{- 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 + liftIO $ writeFile l $ unlines $ map toline $ M.toList $ M.insert u c m + where + toline (u', c') = u' ++ " " ++ (unwords $ mapToKeyVal c') -matchName :: String -> (UUID, String, M.Map String String) -> Bool -matchName n (_, n', _) = n == n' - -readRemoteLog :: Annex [(UUID, String, M.Map String String)] +{- Map of remotes by uuid containing key/value config maps. -} +readRemoteLog :: Annex (M.Map UUID (M.Map String String)) readRemoteLog = do l <- remoteLog s <- liftIO $ catch (readFile l) ignoreerror return $ remoteLogParse s where - ignoreerror _ = return [] + ignoreerror _ = return "" -writeRemoteLog :: [(UUID, String, M.Map String String)] -> Annex () -writeRemoteLog rs = do - l <- remoteLog - liftIO $ writeFile l $ unlines $ map toline rs - where - toline (u, n, c) = u ++ " " ++ n ++ (unwords $ mapToKeyVal c) - -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 68bd172e91..b686e47af5 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 4aa1bc639b..7971faa8fb 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 f3cc9379b0..0482faac70 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 6296095035..2e9f253831 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`