support remote config values with spaces and other characters
This commit is contained in:
parent
ceff04ff3e
commit
93c5fb5da7
3 changed files with 36 additions and 5 deletions
|
@ -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
|
||||
|
|
38
Remote.hs
38
Remote.hs
|
@ -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)
|
||||
|
|
1
test.hs
1
test.hs
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue