blob: f9c7997e417d9930ffb7acc62ebbe3e2f2888049 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
{- git-annex remote log
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module RemoteLog (
remoteLog,
readRemoteLog,
configSet,
keyValToConfig,
configToKeyVal,
prop_idempotent_configEscape
) where
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Char
import Control.Applicative
import qualified Branch
import Types
import Types.Remote
import UUID
{- Filename of remote.log. -}
remoteLog :: FilePath
remoteLog = "remote.log"
{- Adds or updates a remote's config in the log. -}
configSet :: UUID -> RemoteConfig -> Annex ()
configSet u c = Branch.change remoteLog $
serialize . M.insert u c . remoteLogParse
where
serialize = unlines . sort . map toline . M.toList
toline (u', c') = u' ++ " " ++ unwords (configToKeyVal c')
{- Map of remotes by uuid containing key/value config maps. -}
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
readRemoteLog = remoteLogParse <$> Branch.get remoteLog
remoteLogParse :: String -> M.Map UUID RemoteConfig
remoteLogParse s =
M.fromList $ mapMaybe parseline $ filter (not . null) $ lines s
where
parseline l
| length w > 2 = Just (u, c)
| otherwise = Nothing
where
w = words l
u = head w
c = keyValToConfig $ tail w
{- Given Strings like "key=value", generates a RemoteConfig. -}
keyValToConfig :: [String] -> RemoteConfig
keyValToConfig ws = M.fromList $ map (/=/) ws
where
(/=/) s = (k, v)
where
k = takeWhile (/= '=') 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 ++ "=" ++ configEscape v
configEscape :: String -> String
configEscape = (>>= 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) && head r == ';'
{- for quickcheck -}
prop_idempotent_configEscape :: String -> Bool
prop_idempotent_configEscape s = s == (configUnEscape . configEscape) s
|
