summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-05-16 13:07:56 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-05-16 13:07:56 -0400
commit93c5fb5da7f085cc772e28d8ded08f4ea0b0bf15 (patch)
tree677ea95da4df9ae5347102bfb378c7e9ef221d7c
parentceff04ff3e7fff4b0ea6e8ad4334cca80d291880 (diff)
support remote config values with spaces and other characters
-rw-r--r--Command/InitRemote.hs2
-rw-r--r--Remote.hs38
-rw-r--r--test.hs1
3 files changed, 36 insertions, 5 deletions
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index ae22e3564..ad0718e38 100644
--- a/Command/InitRemote.hs
+++ b/Command/InitRemote.hs
@@ -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
diff --git a/Remote.hs b/Remote.hs
index 211168b15..7bbe91000 100644
--- a/Remote.hs
+++ b/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)
diff --git a/test.hs b/test.hs
index 73eff662b..456c09060 100644
--- a/test.hs
+++ b/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