support remote config values with spaces and other characters

This commit is contained in:
Joey Hess 2011-05-16 13:07:56 -04:00
parent ceff04ff3e
commit 93c5fb5da7
3 changed files with 36 additions and 5 deletions

View file

@ -37,8 +37,6 @@ start ws = notBareRepo $ do
(u, c) <- findByName name (u, c) <- findByName name
let fullconfig = M.union config c let fullconfig = M.union config c
t <- findType fullconfig t <- findType fullconfig
liftIO $ putStrLn $ show fullconfig
showStart "initremote" name showStart "initremote" name
next $ perform t u $ M.union config c next $ perform t u $ M.union config c

View file

@ -25,7 +25,10 @@ module Remote (
remoteLog, remoteLog,
readRemoteLog, readRemoteLog,
configSet, configSet,
keyValToConfig keyValToConfig,
configToKeyVal,
prop_idempotent_configEscape
) where ) where
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
@ -33,6 +36,7 @@ import Control.Monad (when, liftM, filterM)
import Data.List import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import Data.Char
import RemoteClass import RemoteClass
import Types import Types
@ -176,9 +180,37 @@ keyValToConfig ws = M.fromList $ map (/=/) ws
(/=/) s = (k, v) (/=/) s = (k, v)
where where
k = takeWhile (/= '=') s k = takeWhile (/= '=') s
v = drop (1 + length k) s v = configUnEscape $ drop (1 + length k) s
configToKeyVal :: M.Map String String -> [String] configToKeyVal :: M.Map String String -> [String]
configToKeyVal m = map toword $ sort $ M.toList m configToKeyVal m = map toword $ sort $ M.toList m
where where
toword (k, v) = k ++ "=" ++ v toword (k, v) = k ++ "=" ++ configEscape v
configEscape :: String -> String
configEscape = concat . (map 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

@ -75,6 +75,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
, qctest "prop_idempotent_key_read_show" Key.prop_idempotent_key_read_show , qctest "prop_idempotent_key_read_show" 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_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