diff options
| -rw-r--r-- | Command/InitRemote.hs | 9 | ||||
| -rw-r--r-- | Remote.hs | 85 | ||||
| -rw-r--r-- | RemoteLog.hs | 97 | ||||
| -rw-r--r-- | test.hs | 3 |
4 files changed, 106 insertions, 88 deletions
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index a3054630c..15962ad99 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -15,6 +15,7 @@ import Data.String.Utils import Command import qualified Remote +import qualified RemoteLog import qualified Types.Remote as R import Types import UUID @@ -42,7 +43,7 @@ start ws = do where name = head ws - config = Remote.keyValToConfig $ tail ws + config = RemoteLog.keyValToConfig $ tail ws needname = do let err s = error $ "Specify a name for the remote. " ++ s names <- remoteNames @@ -58,13 +59,13 @@ perform t u c = do cleanup :: UUID -> R.RemoteConfig -> CommandCleanup cleanup u c = do - Remote.configSet u c + RemoteLog.configSet u c return True {- Look up existing remote's UUID and config by name, or generate a new one -} findByName :: String -> Annex (UUID, R.RemoteConfig) findByName name = do - m <- Remote.readRemoteLog + m <- RemoteLog.readRemoteLog maybe generate return $ findByName' name m where generate = do @@ -83,7 +84,7 @@ findByName' n m = if null matches then Nothing else Just $ head matches remoteNames :: Annex [String] remoteNames = do - m <- Remote.readRemoteLog + m <- RemoteLog.readRemoteLog return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m {- find the specified remote type -} @@ -17,7 +17,6 @@ module Remote ( keyPossibilities, keyPossibilitiesTrusted, - forceTrust, remoteTypes, genList, byName, @@ -27,24 +26,14 @@ module Remote ( prettyPrintUUIDs, showTriedRemotes, showLocations, - - remoteLog, - readRemoteLog, - configSet, - keyValToConfig, - configToKeyVal, - - prop_idempotent_configEscape + forceTrust ) where import Control.Monad (filterM, liftM2) import Data.List import qualified Data.Map as M -import Data.Maybe -import Data.Char import Data.String.Utils -import qualified Branch import Types import Types.Remote import UUID @@ -53,6 +42,7 @@ import Config import Trust import LocationLog import Messages +import RemoteLog import qualified Remote.Git import qualified Remote.S3 @@ -215,74 +205,3 @@ forceTrust level remotename = do r <- nameToUUID remotename Annex.changeState $ \s -> s { Annex.forcetrust = (r, level):Annex.forcetrust s } - -{- Filename of remote.log. -} -remoteLog :: FilePath -remoteLog = "remote.log" - -{- Adds or updates a remote's config in the log. -} -configSet :: UUID -> RemoteConfig -> Annex () -configSet u c = do - m <- readRemoteLog - Branch.change remoteLog $ unlines $ sort $ - map toline $ M.toList $ M.insert u c m - where - toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c') - -{- Map of remotes by uuid containing key/value config maps. -} -readRemoteLog :: Annex (M.Map UUID RemoteConfig) -readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog - -remoteLogParse :: String -> M.Map UUID RemoteConfig -remoteLogParse s = - M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s - where - parseline l - | length w > 2 = Just (u, c) - | otherwise = Nothing - where - w = words l - u = w !! 0 - c = keyValToConfig $ tail w - -{- Given Strings like "key=value", generates a RemoteConfig. -} -keyValToConfig :: [String] -> RemoteConfig -keyValToConfig ws = M.fromList $ map (/=/) ws - where - (/=/) s = (k, v) - where - k = takeWhile (/= '=') s - v = configUnEscape $ drop (1 + length k) s - -configToKeyVal :: M.Map String String -> [String] -configToKeyVal m = map toword $ sort $ M.toList m - where - toword (k, v) = k ++ "=" ++ configEscape v - -configEscape :: String -> String -configEscape = (>>= escape) - where - escape c - | isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";" - | otherwise = [c] - -configUnEscape :: String -> String -configUnEscape = unescape - where - unescape [] = [] - unescape (c:rest) - | c == '&' = entity rest - | otherwise = c : unescape rest - entity s = if ok - then chr (read num) : unescape rest - else '&' : unescape s - where - num = takeWhile isNumber s - r = drop (length num) s - rest = drop 1 r - ok = not (null num) && - not (null r) && r !! 0 == ';' - -{- for quickcheck -} -prop_idempotent_configEscape :: String -> Bool -prop_idempotent_configEscape s = s == (configUnEscape $ configEscape s) diff --git a/RemoteLog.hs b/RemoteLog.hs new file mode 100644 index 000000000..c2065db9d --- /dev/null +++ b/RemoteLog.hs @@ -0,0 +1,97 @@ +{- git-annex remote log + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module RemoteLog ( + remoteLog, + readRemoteLog, + configSet, + keyValToConfig, + configToKeyVal, + + prop_idempotent_configEscape +) where + +import Data.List +import qualified Data.Map as M +import Data.Maybe +import Data.Char + +import qualified Branch +import Types +import Types.Remote +import UUID + +{- Filename of remote.log. -} +remoteLog :: FilePath +remoteLog = "remote.log" + +{- Adds or updates a remote's config in the log. -} +configSet :: UUID -> RemoteConfig -> Annex () +configSet u c = do + m <- readRemoteLog + Branch.change remoteLog $ unlines $ sort $ + map toline $ M.toList $ M.insert u c m + where + toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c') + +{- Map of remotes by uuid containing key/value config maps. -} +readRemoteLog :: Annex (M.Map UUID RemoteConfig) +readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog + +remoteLogParse :: String -> M.Map UUID RemoteConfig +remoteLogParse s = + M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s + where + parseline l + | length w > 2 = Just (u, c) + | otherwise = Nothing + where + w = words l + u = w !! 0 + c = keyValToConfig $ tail w + +{- Given Strings like "key=value", generates a RemoteConfig. -} +keyValToConfig :: [String] -> RemoteConfig +keyValToConfig ws = M.fromList $ map (/=/) ws + where + (/=/) s = (k, v) + where + k = takeWhile (/= '=') s + v = configUnEscape $ drop (1 + length k) s + +configToKeyVal :: M.Map String String -> [String] +configToKeyVal m = map toword $ sort $ M.toList m + where + toword (k, v) = k ++ "=" ++ configEscape v + +configEscape :: String -> String +configEscape = (>>= escape) + where + escape c + | isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";" + | otherwise = [c] + +configUnEscape :: String -> String +configUnEscape = unescape + where + unescape [] = [] + unescape (c:rest) + | c == '&' = entity rest + | otherwise = c : unescape rest + entity s = if ok + then chr (read num) : unescape rest + else '&' : unescape s + where + num = takeWhile isNumber s + r = drop (length num) s + rest = drop 1 r + ok = not (null num) && + not (null r) && r !! 0 == ';' + +{- for quickcheck -} +prop_idempotent_configEscape :: String -> Bool +prop_idempotent_configEscape s = s == (configUnEscape $ configEscape s) @@ -36,6 +36,7 @@ import qualified LocationLog import qualified UUID import qualified Trust import qualified Remote +import qualified RemoteLog import qualified Content import qualified Command.DropUnused import qualified Types.Key @@ -73,7 +74,7 @@ quickcheck = TestLabel "quickcheck" $ TestList , qctest "prop_idempotent_key_read_show" Types.Key.prop_idempotent_key_read_show , qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape , qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword - , qctest "prop_idempotent_configEscape" Remote.prop_idempotent_configEscape + , qctest "prop_idempotent_configEscape" RemoteLog.prop_idempotent_configEscape , qctest "prop_parentDir_basics" Utility.prop_parentDir_basics , qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics , qctest "prop_cost_sane" Config.prop_cost_sane |