clean up remote.log handling

This commit is contained in:
Joey Hess 2011-03-29 13:49:54 -04:00
parent a3b6586902
commit 05751d55cd
6 changed files with 55 additions and 47 deletions

View file

@ -29,12 +29,12 @@ start :: CommandStartString
start params = notBareRepo $ do start params = notBareRepo $ do
when (null ws) $ error "Specify a name for the remote" when (null ws) $ error "Specify a name for the remote"
showStart "initremote" name showStart "initremote" name
r <- Remote.configGet name m <- Remote.readRemoteLog
(u, c) <- case r of (u, c) <- case findByName name m of
Just t -> return t Just t -> return t
Nothing -> do Nothing -> do
uuid <- liftIO $ genUUID uuid <- liftIO $ genUUID
return $ (uuid, M.empty) return $ (uuid, M.insert nameKey name M.empty)
return $ Just $ perform name u $ M.union config c return $ Just $ perform name u $ M.union config c
where where
@ -46,3 +46,17 @@ perform :: String -> UUID -> M.Map String String -> CommandPerform
perform name uuid config = do perform name uuid config = do
liftIO $ putStrLn $ show $ (uuid, config) liftIO $ putStrLn $ show $ (uuid, config)
return Nothing 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"

View file

@ -21,7 +21,7 @@ module Remote (
remotesWithUUID, remotesWithUUID,
remotesWithoutUUID, remotesWithoutUUID,
configGet, readRemoteLog,
configSet, configSet,
keyValToMap keyValToMap
) where ) where
@ -71,7 +71,8 @@ genList = do
if null rs if null rs
then do then do
rs' <- runGenerators rs' <- runGenerators
Annex.changeState $ \s -> s { Annex.remotes = rs' } rs'' <- getConfigs rs'
Annex.changeState $ \s -> s { Annex.remotes = rs'' }
return rs' return rs'
else return rs else return rs
@ -132,51 +133,47 @@ remoteLog = do
g <- Annex.gitRepo g <- Annex.gitRepo
return $ gitStateDir g ++ "remote.log" return $ gitStateDir g ++ "remote.log"
{- Reads the uuid and config of the specified remote from the remoteLog. -} {- Load stored config into remotes.
configGet :: String -> Annex (Maybe (UUID, M.Map String String)) -
configGet n = do - This way, the log is read once, lazily, so if no remotes access
rs <- readRemoteLog - their config, no work is done.
let matches = filter (matchName n) rs -}
case matches of getConfigs :: [Remote Annex] -> Annex [Remote Annex]
[] -> return Nothing getConfigs rs = do
((u, _, c):_) -> return $ Just (u, c) 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. -} {- Adds or updates a remote's config in the log. -}
configSet :: String -> UUID -> M.Map String String -> Annex () configSet :: UUID -> M.Map String String -> Annex ()
configSet n u c = do configSet u c = do
rs <- readRemoteLog m <- readRemoteLog
let others = filter (not . matchName n) rs l <- remoteLog
writeRemoteLog $ (u, n, c):others 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 {- Map of remotes by uuid containing key/value config maps. -}
matchName n (_, n', _) = n == n' readRemoteLog :: Annex (M.Map UUID (M.Map String String))
readRemoteLog :: Annex [(UUID, String, M.Map String String)]
readRemoteLog = do readRemoteLog = do
l <- remoteLog l <- remoteLog
s <- liftIO $ catch (readFile l) ignoreerror s <- liftIO $ catch (readFile l) ignoreerror
return $ remoteLogParse s return $ remoteLogParse s
where where
ignoreerror _ = return [] ignoreerror _ = return ""
writeRemoteLog :: [(UUID, String, M.Map String String)] -> Annex () remoteLogParse :: String -> M.Map UUID (M.Map String String)
writeRemoteLog rs = do remoteLogParse s =
l <- remoteLog M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s
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
where where
parseline l parseline l
| length w > 2 = Just (u, n, c) | length w > 2 = Just (u, c)
| otherwise = Nothing | otherwise = Nothing
where where
w = words l w = words l
u = w !! 0 u = w !! 0
n = w !! 1 c = keyValToMap $ tail w
c = keyValToMap $ drop 2 w
{- Given Strings like "key=value", generates a Map. -} {- Given Strings like "key=value", generates a Map. -}
keyValToMap :: [String] -> M.Map String String keyValToMap :: [String] -> M.Map String String

View file

@ -12,7 +12,7 @@ module Remote.Git (
import Control.Exception.Extensible import Control.Exception.Extensible
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import qualified Data.Map as Map import qualified Data.Map as M
import System.Cmd.Utils import System.Cmd.Utils
import Control.Monad (filterM, liftM) import Control.Monad (filterM, liftM)
@ -68,7 +68,6 @@ genRemote r = do
removeKey = dropKey r, removeKey = dropKey r,
hasKey = inAnnex r, hasKey = inAnnex r,
hasKeyCheap = not (Git.repoIsUrl r), hasKeyCheap = not (Git.repoIsUrl r),
hasConfig = False,
config = Nothing, config = Nothing,
setup = \_ -> return () setup = \_ -> return ()
} }
@ -77,7 +76,7 @@ genRemote r = do
- returns the updated repo. -} - returns the updated repo. -}
tryGitConfigRead :: Git.Repo -> Annex Git.Repo tryGitConfigRead :: Git.Repo -> Annex Git.Repo
tryGitConfigRead r 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.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
| Git.repoIsUrl r = return r | Git.repoIsUrl r = return r
| otherwise = store $ safely $ Git.configRead r | otherwise = store $ safely $ Git.configRead r

View file

@ -12,7 +12,7 @@ import Network.AWS.S3Object
import Network.AWS.S3Bucket import Network.AWS.S3Bucket
import Network.AWS.AWSResult import Network.AWS.AWSResult
import qualified Data.ByteString.Lazy.Char8 as L 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 Data.String.Utils
import Control.Monad (filterM, liftM, when) import Control.Monad (filterM, liftM, when)
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
@ -51,8 +51,8 @@ gen = do
findS3Remotes :: Git.Repo -> [Git.Repo] findS3Remotes :: Git.Repo -> [Git.Repo]
findS3Remotes r = map construct remotepairs findS3Remotes r = map construct remotepairs
where where
remotepairs = Map.toList $ filterremotes $ Git.configMap r remotepairs = M.toList $ filterremotes $ Git.configMap r
filterremotes = Map.filterWithKey (\k _ -> s3remote k) filterremotes = M.filterWithKey (\k _ -> s3remote k)
construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k
s3remote k = startswith "remote." k && endswith ".annex-s3-bucket" k s3remote k = startswith "remote." k && endswith ".annex-s3-bucket" k
@ -68,7 +68,6 @@ genRemote r u = do
removeKey = error "TODO", removeKey = error "TODO",
hasKey = error "TODO", hasKey = error "TODO",
hasKeyCheap = False, hasKeyCheap = False,
hasConfig = True,
config = Nothing, config = Nothing,
setup = \_ -> return () setup = \_ -> return ()
} }

View file

@ -47,8 +47,7 @@ data Remote a = Remote {
-- Some remotes can check hasKey without an expensive network -- Some remotes can check hasKey without an expensive network
-- operation. -- operation.
hasKeyCheap :: Bool, hasKeyCheap :: Bool,
-- a Remote may have a persistent configuration store -- a Remote can have a persistent configuration store
hasConfig :: Bool,
config :: Maybe (M.Map String String), config :: Maybe (M.Map String String),
-- initializes or changes the config of a remote -- initializes or changes the config of a remote
setup :: M.Map String String -> a () setup :: M.Map String String -> a ()

View file

@ -36,8 +36,8 @@ Holds persistent configuration settings for [[special_remotes]] such as
Amazon S3. Amazon S3.
The file format is one line per remote, starting with the uuid of the 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 remote, followed by a space, and then a series of key=value pairs,
a series of key=value pairs, each separated by whitespace. each separated by whitespace.
## `.git-annex/trust.log` ## `.git-annex/trust.log`