store trust.log and remote.log in the git-annex branch
.. and I think that's everything that will use the branch
This commit is contained in:
parent
235e2e63a1
commit
4c4ebf2d75
7 changed files with 27 additions and 64 deletions
18
Branch.hs
18
Branch.hs
|
@ -168,15 +168,6 @@ change file content = do
|
||||||
Param sha, File file]
|
Param sha, File file]
|
||||||
setCacheChanged file content
|
setCacheChanged file content
|
||||||
|
|
||||||
{- Commits any staged changes to the branch. -}
|
|
||||||
commit :: String -> Annex ()
|
|
||||||
commit message = do
|
|
||||||
state <- getState
|
|
||||||
when (branchChanged state) $ do
|
|
||||||
g <- Annex.gitRepo
|
|
||||||
withIndex $ liftIO $
|
|
||||||
GitUnionMerge.commit g message fullname [fullname]
|
|
||||||
|
|
||||||
{- Gets the content of a file on the branch, or content staged in the index
|
{- Gets the content of a file on the branch, or content staged in the index
|
||||||
- if it's newer. Returns an empty string if the file didn't exist yet. -}
|
- if it's newer. Returns an empty string if the file didn't exist yet. -}
|
||||||
get :: FilePath -> Annex String
|
get :: FilePath -> Annex String
|
||||||
|
@ -192,3 +183,12 @@ get file = do
|
||||||
where
|
where
|
||||||
cat g = Git.pipeRead g [Param "cat-file", Param "blob", catfile]
|
cat g = Git.pipeRead g [Param "cat-file", Param "blob", catfile]
|
||||||
catfile = Param $ ':':file
|
catfile = Param $ ':':file
|
||||||
|
|
||||||
|
{- Commits any staged changes to the branch. -}
|
||||||
|
commit :: String -> Annex ()
|
||||||
|
commit message = do
|
||||||
|
state <- getState
|
||||||
|
when (branchChanged state) $ do
|
||||||
|
g <- Annex.gitRepo
|
||||||
|
withIndex $ liftIO $
|
||||||
|
GitUnionMerge.commit g message fullname [fullname]
|
||||||
|
|
|
@ -103,8 +103,8 @@ startup = do
|
||||||
{- Cleanup actions. -}
|
{- Cleanup actions. -}
|
||||||
shutdown :: Annex Bool
|
shutdown :: Annex Bool
|
||||||
shutdown = do
|
shutdown = do
|
||||||
Branch.commit "update"
|
|
||||||
AnnexQueue.flush False
|
AnnexQueue.flush False
|
||||||
|
Branch.commit "update"
|
||||||
|
|
||||||
liftIO $ Git.reap
|
liftIO $ Git.reap
|
||||||
|
|
||||||
|
|
|
@ -14,11 +14,8 @@ import Data.Maybe
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
|
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Types.Remote as R
|
import qualified Types.Remote as R
|
||||||
import qualified GitRepo as Git
|
|
||||||
import Utility
|
|
||||||
import Types
|
import Types
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
import Messages
|
||||||
|
@ -62,14 +59,6 @@ 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
|
Remote.configSet u c
|
||||||
g <- Annex.gitRepo
|
|
||||||
logfile <- Remote.remoteLog
|
|
||||||
liftIO $ Git.run g "add" [File logfile]
|
|
||||||
liftIO $ Git.run g "commit"
|
|
||||||
[ Params "-q --allow-empty -m"
|
|
||||||
, Param "git annex initremote"
|
|
||||||
, File logfile
|
|
||||||
]
|
|
||||||
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 -}
|
||||||
|
|
|
@ -20,7 +20,6 @@ module Locations (
|
||||||
gitAnnexBadLocation,
|
gitAnnexBadLocation,
|
||||||
gitAnnexUnusedLog,
|
gitAnnexUnusedLog,
|
||||||
isLinkToAnnex,
|
isLinkToAnnex,
|
||||||
uuidLog,
|
|
||||||
logFile,
|
logFile,
|
||||||
logFileKey,
|
logFileKey,
|
||||||
hashDirMixed,
|
hashDirMixed,
|
||||||
|
@ -118,10 +117,6 @@ gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused")
|
||||||
isLinkToAnnex :: FilePath -> Bool
|
isLinkToAnnex :: FilePath -> Bool
|
||||||
isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
|
isLinkToAnnex s = ("/.git/" ++ objectDir) `isInfixOf` s
|
||||||
|
|
||||||
{- Filename of uuid.log. -}
|
|
||||||
uuidLog :: FilePath
|
|
||||||
uuidLog = "uuid.log"
|
|
||||||
|
|
||||||
{- The filename of the log file for a given key. -}
|
{- The filename of the log file for a given key. -}
|
||||||
logFile :: Key -> String
|
logFile :: Key -> String
|
||||||
logFile key = hashDirLower key ++ keyFile key ++ ".log"
|
logFile key = hashDirLower key ++ keyFile key ++ ".log"
|
||||||
|
|
20
Remote.hs
20
Remote.hs
|
@ -33,19 +33,17 @@ module Remote (
|
||||||
prop_idempotent_configEscape
|
prop_idempotent_configEscape
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
|
||||||
import Control.Monad (filterM)
|
import Control.Monad (filterM)
|
||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
|
||||||
|
import qualified Branch
|
||||||
import Types
|
import Types
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import UUID
|
import UUID
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Locations
|
|
||||||
import Utility
|
|
||||||
import Config
|
import Config
|
||||||
import Trust
|
import Trust
|
||||||
import LocationLog
|
import LocationLog
|
||||||
|
@ -160,29 +158,21 @@ forceTrust level remotename = do
|
||||||
s { Annex.forcetrust = (r, level):Annex.forcetrust s }
|
s { Annex.forcetrust = (r, level):Annex.forcetrust s }
|
||||||
|
|
||||||
{- Filename of remote.log. -}
|
{- Filename of remote.log. -}
|
||||||
remoteLog :: Annex FilePath
|
remoteLog :: FilePath
|
||||||
remoteLog = do
|
remoteLog = "remote.log"
|
||||||
g <- Annex.gitRepo
|
|
||||||
return $ gitStateDir g ++ "remote.log"
|
|
||||||
|
|
||||||
{- Adds or updates a remote's config in the log. -}
|
{- Adds or updates a remote's config in the log. -}
|
||||||
configSet :: UUID -> RemoteConfig -> Annex ()
|
configSet :: UUID -> RemoteConfig -> Annex ()
|
||||||
configSet u c = do
|
configSet u c = do
|
||||||
m <- readRemoteLog
|
m <- readRemoteLog
|
||||||
l <- remoteLog
|
Branch.change remoteLog $ unlines $ sort $
|
||||||
liftIO $ safeWriteFile l $ unlines $ sort $
|
|
||||||
map toline $ M.toList $ M.insert u c m
|
map toline $ M.toList $ M.insert u c m
|
||||||
where
|
where
|
||||||
toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c')
|
toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c')
|
||||||
|
|
||||||
{- Map of remotes by uuid containing key/value config maps. -}
|
{- Map of remotes by uuid containing key/value config maps. -}
|
||||||
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
|
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
|
||||||
readRemoteLog = do
|
readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
|
||||||
l <- remoteLog
|
|
||||||
s <- liftIO $ catch (readFile l) ignoreerror
|
|
||||||
return $ remoteLogParse s
|
|
||||||
where
|
|
||||||
ignoreerror _ = return ""
|
|
||||||
|
|
||||||
remoteLogParse :: String -> M.Map UUID RemoteConfig
|
remoteLogParse :: String -> M.Map UUID RemoteConfig
|
||||||
remoteLogParse s =
|
remoteLogParse s =
|
||||||
|
|
27
Trust.hs
27
Trust.hs
|
@ -18,18 +18,14 @@ import Control.Monad.State
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
import TrustLevel
|
import TrustLevel
|
||||||
import qualified GitRepo as Git
|
import qualified Branch
|
||||||
import Types
|
import Types
|
||||||
import UUID
|
import UUID
|
||||||
import Locations
|
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Utility
|
|
||||||
|
|
||||||
{- Filename of trust.log. -}
|
{- Filename of trust.log. -}
|
||||||
trustLog :: Annex FilePath
|
trustLog :: FilePath
|
||||||
trustLog = do
|
trustLog = "trust.log"
|
||||||
g <- Annex.gitRepo
|
|
||||||
return $ gitStateDir g ++ "trust.log"
|
|
||||||
|
|
||||||
{- Returns a list of UUIDs at the specified trust level. -}
|
{- Returns a list of UUIDs at the specified trust level. -}
|
||||||
trustGet :: TrustLevel -> Annex [UUID]
|
trustGet :: TrustLevel -> Annex [UUID]
|
||||||
|
@ -41,12 +37,9 @@ trustGet level = do
|
||||||
- values from forcetrust -}
|
- values from forcetrust -}
|
||||||
trustMap :: Annex (M.Map UUID TrustLevel)
|
trustMap :: Annex (M.Map UUID TrustLevel)
|
||||||
trustMap = do
|
trustMap = do
|
||||||
logfile <- trustLog
|
|
||||||
overrides <- Annex.getState Annex.forcetrust
|
overrides <- Annex.getState Annex.forcetrust
|
||||||
s <- liftIO $ catch (readFile logfile) ignoreerror
|
s <- Branch.get trustLog
|
||||||
return $ M.fromList $ trustMapParse s ++ overrides
|
return $ M.fromList $ trustMapParse s ++ overrides
|
||||||
where
|
|
||||||
ignoreerror _ = return ""
|
|
||||||
|
|
||||||
{- Trust map parser. -}
|
{- Trust map parser. -}
|
||||||
trustMapParse :: String -> [(UUID, TrustLevel)]
|
trustMapParse :: String -> [(UUID, TrustLevel)]
|
||||||
|
@ -60,7 +53,7 @@ trustMapParse s = map pair $ filter (not . null) $ lines s
|
||||||
where
|
where
|
||||||
w = words l
|
w = words l
|
||||||
|
|
||||||
{- Changes the trust level for a uuid in the trustLog, and commits it. -}
|
{- Changes the trust level for a uuid in the trustLog. -}
|
||||||
trustSet :: UUID -> TrustLevel -> Annex ()
|
trustSet :: UUID -> TrustLevel -> Annex ()
|
||||||
trustSet uuid level = do
|
trustSet uuid level = do
|
||||||
when (null uuid) $
|
when (null uuid) $
|
||||||
|
@ -68,15 +61,7 @@ trustSet uuid level = do
|
||||||
m <- trustMap
|
m <- trustMap
|
||||||
when (M.lookup uuid m /= Just level) $ do
|
when (M.lookup uuid m /= Just level) $ do
|
||||||
let m' = M.insert uuid level m
|
let m' = M.insert uuid level m
|
||||||
logfile <- trustLog
|
Branch.change trustLog (serialize m')
|
||||||
liftIO $ safeWriteFile logfile (serialize m')
|
|
||||||
g <- Annex.gitRepo
|
|
||||||
liftIO $ Git.run g "add" [File logfile]
|
|
||||||
liftIO $ Git.run g "commit"
|
|
||||||
[ Params "-q -m"
|
|
||||||
, Param "git annex trust change"
|
|
||||||
, File logfile
|
|
||||||
]
|
|
||||||
where
|
where
|
||||||
serialize m = unlines $ map showpair $ M.toList m
|
serialize m = unlines $ map showpair $ M.toList m
|
||||||
showpair (u, t) = u ++ " " ++ show t
|
showpair (u, t) = u ++ " " ++ show t
|
||||||
|
|
8
UUID.hs
8
UUID.hs
|
@ -19,7 +19,8 @@ module UUID (
|
||||||
genUUID,
|
genUUID,
|
||||||
prettyPrintUUIDs,
|
prettyPrintUUIDs,
|
||||||
describeUUID,
|
describeUUID,
|
||||||
uuidMap
|
uuidMap,
|
||||||
|
uuidLog
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
@ -35,11 +36,14 @@ import Types.UUID
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified SysConfig
|
import qualified SysConfig
|
||||||
import Config
|
import Config
|
||||||
import Locations
|
|
||||||
|
|
||||||
configkey :: String
|
configkey :: String
|
||||||
configkey = "annex.uuid"
|
configkey = "annex.uuid"
|
||||||
|
|
||||||
|
{- Filename of uuid.log. -}
|
||||||
|
uuidLog :: FilePath
|
||||||
|
uuidLog = "uuid.log"
|
||||||
|
|
||||||
{- Generates a UUID. There is a library for this, but it's not packaged,
|
{- Generates a UUID. There is a library for this, but it's not packaged,
|
||||||
- so use the command line tool. -}
|
- so use the command line tool. -}
|
||||||
genUUID :: IO UUID
|
genUUID :: IO UUID
|
||||||
|
|
Loading…
Reference in a new issue