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
let fullconfig = M.union config c
t <- findType fullconfig
liftIO $ putStrLn $ show fullconfig
showStart "initremote" name
next $ perform t u $ M.union config c

View file

@ -25,7 +25,10 @@ module Remote (
remoteLog,
readRemoteLog,
configSet,
keyValToConfig
keyValToConfig,
configToKeyVal,
prop_idempotent_configEscape
) where
import Control.Monad.State (liftIO)
@ -33,6 +36,7 @@ import Control.Monad (when, liftM, filterM)
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Char
import RemoteClass
import Types
@ -176,9 +180,37 @@ keyValToConfig ws = M.fromList $ map (/=/) ws
(/=/) s = (k, v)
where
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 toword $ sort $ M.toList m
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_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_parentDir_basics" Utility.prop_parentDir_basics
, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
, qctest "prop_cost_sane" Config.prop_cost_sane