clean up remote.log handling
This commit is contained in:
parent
a3b6586902
commit
05751d55cd
6 changed files with 55 additions and 47 deletions
|
@ -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"
|
||||||
|
|
63
Remote.hs
63
Remote.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ()
|
||||||
}
|
}
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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`
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue