e213ef310f
* Fix minor FD leak in journal code. Closes: #754608 * direct: Fix handling of case where a work tree subdirectory cannot be written to due to permissions. * migrate: Avoid re-checksumming when migrating from hashE to hash backend. * uninit: Avoid failing final removal in some direct mode repositories due to file modes. * S3: Deal with AWS ACL configurations that do not allow creating or checking the location of a bucket, but only reading and writing content to it. * resolvemerge: New plumbing command that runs the automatic merge conflict resolver. * Deal with change in git 2.0 that made indirect mode merge conflict resolution leave behind old files. * sync: Fix git sync with local git remotes even when they don't have an annex.uuid set. (The assistant already did so.) * Set gcrypt-publish-participants when setting up a gcrypt repository, to avoid unncessary passphrase prompts. This is a security/usability tradeoff. To avoid exposing the gpg key ids who can decrypt the repository, users can unset gcrypt-publish-participants. * Install nautilus hooks even when ~/.local/share/nautilus/ does not yet exist, since it is not automatically created for Gnome 3 users. * Windows: Move .vbs files out of git\bin, to avoid that being in the PATH, which caused some weird breakage. (Thanks, divB) * Windows: Fix locking issue that prevented the webapp starting (since 5.20140707). # imported from the archive
97 lines
2.5 KiB
Haskell
97 lines
2.5 KiB
Haskell
{- git-annex remote log
|
|
-
|
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Logs.Remote (
|
|
remoteLog,
|
|
readRemoteLog,
|
|
configSet,
|
|
keyValToConfig,
|
|
configToKeyVal,
|
|
showConfig,
|
|
parseConfig,
|
|
|
|
prop_idempotent_configEscape,
|
|
prop_parse_show_Config,
|
|
) where
|
|
|
|
import qualified Data.Map as M
|
|
import Data.Time.Clock.POSIX
|
|
import Data.Char
|
|
|
|
import Common.Annex
|
|
import qualified Annex.Branch
|
|
import Types.Remote
|
|
import Logs
|
|
import Logs.UUIDBased
|
|
|
|
{- Adds or updates a remote's config in the log. -}
|
|
configSet :: UUID -> RemoteConfig -> Annex ()
|
|
configSet u c = do
|
|
ts <- liftIO getPOSIXTime
|
|
Annex.Branch.change remoteLog $
|
|
showLog showConfig . changeLog ts u c . parseLog parseConfig
|
|
|
|
{- Map of remotes by uuid containing key/value config maps. -}
|
|
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
|
|
readRemoteLog = simpleMap . parseLog parseConfig <$> Annex.Branch.get remoteLog
|
|
|
|
parseConfig :: String -> Maybe RemoteConfig
|
|
parseConfig = Just . keyValToConfig . words
|
|
|
|
showConfig :: RemoteConfig -> String
|
|
showConfig = unwords . configToKeyVal
|
|
|
|
{- 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 = concatMap 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
|
|
| not (null num) && ";" `isPrefixOf` r =
|
|
chr (Prelude.read num) : unescape rest
|
|
| otherwise =
|
|
'&' : unescape s
|
|
where
|
|
num = takeWhile isNumber s
|
|
r = drop (length num) s
|
|
rest = drop 1 r
|
|
|
|
{- for quickcheck -}
|
|
prop_idempotent_configEscape :: String -> Bool
|
|
prop_idempotent_configEscape s = s == (configUnEscape . configEscape) s
|
|
|
|
prop_parse_show_Config :: RemoteConfig -> Bool
|
|
prop_parse_show_Config c
|
|
-- whitespace and '=' are not supported in keys
|
|
| any (\k -> any isSpace k || elem '=' k) (M.keys c) = True
|
|
| otherwise = parseConfig (showConfig c) ~~ Just c
|
|
where
|
|
normalize v = sort . M.toList <$> v
|
|
a ~~ b = normalize a == normalize b
|