factor out RemoteLog

This commit is contained in:
Joey Hess 2011-07-05 20:16:57 -04:00
parent 9f1577f746
commit 6040d8aed1
4 changed files with 106 additions and 88 deletions

View file

@ -15,6 +15,7 @@ import Data.String.Utils
import Command import Command
import qualified Remote import qualified Remote
import qualified RemoteLog
import qualified Types.Remote as R import qualified Types.Remote as R
import Types import Types
import UUID import UUID
@ -42,7 +43,7 @@ start ws = do
where where
name = head ws name = head ws
config = Remote.keyValToConfig $ tail ws config = RemoteLog.keyValToConfig $ tail ws
needname = do needname = do
let err s = error $ "Specify a name for the remote. " ++ s let err s = error $ "Specify a name for the remote. " ++ s
names <- remoteNames names <- remoteNames
@ -58,13 +59,13 @@ perform t u c = do
cleanup :: UUID -> R.RemoteConfig -> CommandCleanup cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
cleanup u c = do cleanup u c = do
Remote.configSet u c RemoteLog.configSet u c
return True return True
{- Look up existing remote's UUID and config by name, or generate a new one -} {- Look up existing remote's UUID and config by name, or generate a new one -}
findByName :: String -> Annex (UUID, R.RemoteConfig) findByName :: String -> Annex (UUID, R.RemoteConfig)
findByName name = do findByName name = do
m <- Remote.readRemoteLog m <- RemoteLog.readRemoteLog
maybe generate return $ findByName' name m maybe generate return $ findByName' name m
where where
generate = do generate = do
@ -83,7 +84,7 @@ findByName' n m = if null matches then Nothing else Just $ head matches
remoteNames :: Annex [String] remoteNames :: Annex [String]
remoteNames = do remoteNames = do
m <- Remote.readRemoteLog m <- RemoteLog.readRemoteLog
return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m
{- find the specified remote type -} {- find the specified remote type -}

View file

@ -17,7 +17,6 @@ module Remote (
keyPossibilities, keyPossibilities,
keyPossibilitiesTrusted, keyPossibilitiesTrusted,
forceTrust,
remoteTypes, remoteTypes,
genList, genList,
byName, byName,
@ -27,24 +26,14 @@ module Remote (
prettyPrintUUIDs, prettyPrintUUIDs,
showTriedRemotes, showTriedRemotes,
showLocations, showLocations,
forceTrust
remoteLog,
readRemoteLog,
configSet,
keyValToConfig,
configToKeyVal,
prop_idempotent_configEscape
) where ) where
import Control.Monad (filterM, liftM2) import Control.Monad (filterM, liftM2)
import Data.List import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe
import Data.Char
import Data.String.Utils import Data.String.Utils
import qualified Branch
import Types import Types
import Types.Remote import Types.Remote
import UUID import UUID
@ -53,6 +42,7 @@ import Config
import Trust import Trust
import LocationLog import LocationLog
import Messages import Messages
import RemoteLog
import qualified Remote.Git import qualified Remote.Git
import qualified Remote.S3 import qualified Remote.S3
@ -215,74 +205,3 @@ forceTrust level remotename = do
r <- nameToUUID remotename r <- nameToUUID remotename
Annex.changeState $ \s -> Annex.changeState $ \s ->
s { Annex.forcetrust = (r, level):Annex.forcetrust 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)

97
RemoteLog.hs Normal file
View file

@ -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)

View file

@ -36,6 +36,7 @@ import qualified LocationLog
import qualified UUID import qualified UUID
import qualified Trust import qualified Trust
import qualified Remote import qualified Remote
import qualified RemoteLog
import qualified Content import qualified Content
import qualified Command.DropUnused import qualified Command.DropUnused
import qualified Types.Key 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_key_read_show" Types.Key.prop_idempotent_key_read_show
, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape , qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword , 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_parentDir_basics" Utility.prop_parentDir_basics
, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics , qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
, qctest "prop_cost_sane" Config.prop_cost_sane , qctest "prop_cost_sane" Config.prop_cost_sane