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

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