factor out RemoteLog
This commit is contained in:
parent
9f1577f746
commit
6040d8aed1
4 changed files with 106 additions and 88 deletions
|
@ -15,6 +15,7 @@ import Data.String.Utils
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified RemoteLog
|
||||||
import qualified Types.Remote as R
|
import qualified Types.Remote as R
|
||||||
import Types
|
import Types
|
||||||
import UUID
|
import UUID
|
||||||
|
@ -42,7 +43,7 @@ start ws = do
|
||||||
|
|
||||||
where
|
where
|
||||||
name = head ws
|
name = head ws
|
||||||
config = Remote.keyValToConfig $ tail ws
|
config = RemoteLog.keyValToConfig $ tail ws
|
||||||
needname = do
|
needname = do
|
||||||
let err s = error $ "Specify a name for the remote. " ++ s
|
let err s = error $ "Specify a name for the remote. " ++ s
|
||||||
names <- remoteNames
|
names <- remoteNames
|
||||||
|
@ -58,13 +59,13 @@ perform t u c = do
|
||||||
|
|
||||||
cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
|
cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
|
||||||
cleanup u c = do
|
cleanup u c = do
|
||||||
Remote.configSet u c
|
RemoteLog.configSet u c
|
||||||
return True
|
return True
|
||||||
|
|
||||||
{- Look up existing remote's UUID and config by name, or generate a new one -}
|
{- Look up existing remote's UUID and config by name, or generate a new one -}
|
||||||
findByName :: String -> Annex (UUID, R.RemoteConfig)
|
findByName :: String -> Annex (UUID, R.RemoteConfig)
|
||||||
findByName name = do
|
findByName name = do
|
||||||
m <- Remote.readRemoteLog
|
m <- RemoteLog.readRemoteLog
|
||||||
maybe generate return $ findByName' name m
|
maybe generate return $ findByName' name m
|
||||||
where
|
where
|
||||||
generate = do
|
generate = do
|
||||||
|
@ -83,7 +84,7 @@ findByName' n m = if null matches then Nothing else Just $ head matches
|
||||||
|
|
||||||
remoteNames :: Annex [String]
|
remoteNames :: Annex [String]
|
||||||
remoteNames = do
|
remoteNames = do
|
||||||
m <- Remote.readRemoteLog
|
m <- RemoteLog.readRemoteLog
|
||||||
return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m
|
return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m
|
||||||
|
|
||||||
{- find the specified remote type -}
|
{- find the specified remote type -}
|
||||||
|
|
85
Remote.hs
85
Remote.hs
|
@ -17,7 +17,6 @@ module Remote (
|
||||||
|
|
||||||
keyPossibilities,
|
keyPossibilities,
|
||||||
keyPossibilitiesTrusted,
|
keyPossibilitiesTrusted,
|
||||||
forceTrust,
|
|
||||||
remoteTypes,
|
remoteTypes,
|
||||||
genList,
|
genList,
|
||||||
byName,
|
byName,
|
||||||
|
@ -27,24 +26,14 @@ module Remote (
|
||||||
prettyPrintUUIDs,
|
prettyPrintUUIDs,
|
||||||
showTriedRemotes,
|
showTriedRemotes,
|
||||||
showLocations,
|
showLocations,
|
||||||
|
forceTrust
|
||||||
remoteLog,
|
|
||||||
readRemoteLog,
|
|
||||||
configSet,
|
|
||||||
keyValToConfig,
|
|
||||||
configToKeyVal,
|
|
||||||
|
|
||||||
prop_idempotent_configEscape
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (filterM, liftM2)
|
import Control.Monad (filterM, liftM2)
|
||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
|
||||||
import Data.Char
|
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
|
|
||||||
import qualified Branch
|
|
||||||
import Types
|
import Types
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import UUID
|
import UUID
|
||||||
|
@ -53,6 +42,7 @@ import Config
|
||||||
import Trust
|
import Trust
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Messages
|
import Messages
|
||||||
|
import RemoteLog
|
||||||
|
|
||||||
import qualified Remote.Git
|
import qualified Remote.Git
|
||||||
import qualified Remote.S3
|
import qualified Remote.S3
|
||||||
|
@ -215,74 +205,3 @@ forceTrust level remotename = do
|
||||||
r <- nameToUUID remotename
|
r <- nameToUUID remotename
|
||||||
Annex.changeState $ \s ->
|
Annex.changeState $ \s ->
|
||||||
s { Annex.forcetrust = (r, level):Annex.forcetrust s }
|
s { Annex.forcetrust = (r, level):Annex.forcetrust s }
|
||||||
|
|
||||||
{- 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 = do
|
|
||||||
m <- readRemoteLog
|
|
||||||
Branch.change remoteLog $ unlines $ sort $
|
|
||||||
map toline $ M.toList $ M.insert u c m
|
|
||||||
where
|
|
||||||
toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c')
|
|
||||||
|
|
||||||
{- Map of remotes by uuid containing key/value config maps. -}
|
|
||||||
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
|
|
||||||
readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
|
|
||||||
|
|
||||||
remoteLogParse :: String -> M.Map UUID RemoteConfig
|
|
||||||
remoteLogParse s =
|
|
||||||
M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s
|
|
||||||
where
|
|
||||||
parseline l
|
|
||||||
| length w > 2 = Just (u, c)
|
|
||||||
| otherwise = Nothing
|
|
||||||
where
|
|
||||||
w = words l
|
|
||||||
u = w !! 0
|
|
||||||
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) && r !! 0 == ';'
|
|
||||||
|
|
||||||
{- for quickcheck -}
|
|
||||||
prop_idempotent_configEscape :: String -> Bool
|
|
||||||
prop_idempotent_configEscape s = s == (configUnEscape $ configEscape s)
|
|
||||||
|
|
97
RemoteLog.hs
Normal file
97
RemoteLog.hs
Normal file
|
@ -0,0 +1,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 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 = do
|
||||||
|
m <- readRemoteLog
|
||||||
|
Branch.change remoteLog $ unlines $ sort $
|
||||||
|
map toline $ M.toList $ M.insert u c m
|
||||||
|
where
|
||||||
|
toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c')
|
||||||
|
|
||||||
|
{- Map of remotes by uuid containing key/value config maps. -}
|
||||||
|
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
|
||||||
|
readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
|
||||||
|
|
||||||
|
remoteLogParse :: String -> M.Map UUID RemoteConfig
|
||||||
|
remoteLogParse s =
|
||||||
|
M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s
|
||||||
|
where
|
||||||
|
parseline l
|
||||||
|
| length w > 2 = Just (u, c)
|
||||||
|
| otherwise = Nothing
|
||||||
|
where
|
||||||
|
w = words l
|
||||||
|
u = w !! 0
|
||||||
|
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) && r !! 0 == ';'
|
||||||
|
|
||||||
|
{- for quickcheck -}
|
||||||
|
prop_idempotent_configEscape :: String -> Bool
|
||||||
|
prop_idempotent_configEscape s = s == (configUnEscape $ configEscape s)
|
3
test.hs
3
test.hs
|
@ -36,6 +36,7 @@ import qualified LocationLog
|
||||||
import qualified UUID
|
import qualified UUID
|
||||||
import qualified Trust
|
import qualified Trust
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified RemoteLog
|
||||||
import qualified Content
|
import qualified Content
|
||||||
import qualified Command.DropUnused
|
import qualified Command.DropUnused
|
||||||
import qualified Types.Key
|
import qualified Types.Key
|
||||||
|
@ -73,7 +74,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
|
||||||
, qctest "prop_idempotent_key_read_show" Types.Key.prop_idempotent_key_read_show
|
, qctest "prop_idempotent_key_read_show" Types.Key.prop_idempotent_key_read_show
|
||||||
, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
|
, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
|
||||||
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
|
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
|
||||||
, qctest "prop_idempotent_configEscape" Remote.prop_idempotent_configEscape
|
, qctest "prop_idempotent_configEscape" RemoteLog.prop_idempotent_configEscape
|
||||||
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
|
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
|
||||||
, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
|
, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
|
||||||
, qctest "prop_cost_sane" Config.prop_cost_sane
|
, qctest "prop_cost_sane" Config.prop_cost_sane
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue