better memoize core.sharedrepository handling
It was memoized, but that was not used consistently. Move it to Types.GitConfig so it will auto-memoize.
This commit is contained in:
parent
b47c9fd587
commit
167539a354
4 changed files with 21 additions and 25 deletions
3
Annex.hs
3
Annex.hs
|
@ -42,7 +42,6 @@ import Annex.Fixup
|
|||
import Git.CatFile
|
||||
import Git.CheckAttr
|
||||
import Git.CheckIgnore
|
||||
import Git.SharedRepository
|
||||
import qualified Git.Hook
|
||||
import qualified Git.Queue
|
||||
import Types.Key
|
||||
|
@ -115,7 +114,6 @@ data AnnexState = AnnexState
|
|||
, uuidmap :: Maybe UUIDMap
|
||||
, preferredcontentmap :: Maybe (FileMatcherMap Annex)
|
||||
, requiredcontentmap :: Maybe (FileMatcherMap Annex)
|
||||
, shared :: Maybe SharedRepository
|
||||
, forcetrust :: TrustMap
|
||||
, trustmap :: Maybe TrustMap
|
||||
, groupmap :: Maybe GroupMap
|
||||
|
@ -161,7 +159,6 @@ newState c r = AnnexState
|
|||
, uuidmap = Nothing
|
||||
, preferredcontentmap = Nothing
|
||||
, requiredcontentmap = Nothing
|
||||
, shared = Nothing
|
||||
, forcetrust = M.empty
|
||||
, trustmap = Nothing
|
||||
, groupmap = Nothing
|
||||
|
|
|
@ -614,39 +614,39 @@ preseedTmp key file = go =<< inAnnex key
|
|||
- allow reading it, per core.sharedRepository setting. -}
|
||||
freezeContent :: FilePath -> Annex ()
|
||||
freezeContent file = unlessM crippledFileSystem $
|
||||
liftIO . go =<< fromRepo getSharedRepository
|
||||
withShared go
|
||||
where
|
||||
go GroupShared = modifyFileMode file $
|
||||
go GroupShared = liftIO $ modifyFileMode file $
|
||||
removeModes writeModes .
|
||||
addModes [ownerReadMode, groupReadMode]
|
||||
go AllShared = modifyFileMode file $
|
||||
go AllShared = liftIO $ modifyFileMode file $
|
||||
removeModes writeModes .
|
||||
addModes readModes
|
||||
go _ = modifyFileMode file $
|
||||
go _ = liftIO $ modifyFileMode file $
|
||||
removeModes writeModes .
|
||||
addModes [ownerReadMode]
|
||||
|
||||
{- Adjusts read mode of annexed file per core.sharedRepository setting. -}
|
||||
chmodContent :: FilePath -> Annex ()
|
||||
chmodContent file = unlessM crippledFileSystem $
|
||||
liftIO . go =<< fromRepo getSharedRepository
|
||||
withShared go
|
||||
where
|
||||
go GroupShared = modifyFileMode file $
|
||||
go GroupShared = liftIO $ modifyFileMode file $
|
||||
addModes [ownerReadMode, groupReadMode]
|
||||
go AllShared = modifyFileMode file $
|
||||
go AllShared = liftIO $ modifyFileMode file $
|
||||
addModes readModes
|
||||
go _ = modifyFileMode file $
|
||||
go _ = liftIO $ modifyFileMode file $
|
||||
addModes [ownerReadMode]
|
||||
|
||||
{- Allows writing to an annexed file that freezeContent was called on
|
||||
- before. -}
|
||||
thawContent :: FilePath -> Annex ()
|
||||
thawContent file = unlessM crippledFileSystem $
|
||||
liftIO . go =<< fromRepo getSharedRepository
|
||||
withShared go
|
||||
where
|
||||
go GroupShared = groupWriteRead file
|
||||
go AllShared = groupWriteRead file
|
||||
go _ = allowWrite file
|
||||
go GroupShared = liftIO $ groupWriteRead file
|
||||
go AllShared = liftIO $ groupWriteRead file
|
||||
go _ = liftIO $ allowWrite file
|
||||
|
||||
{- Finds files directly inside a directory like gitAnnexBadDir
|
||||
- (not in subdirectories) and returns the corresponding keys. -}
|
||||
|
|
|
@ -15,6 +15,7 @@ module Annex.Perms (
|
|||
freezeContentDir,
|
||||
thawContentDir,
|
||||
modifyContent,
|
||||
withShared,
|
||||
) where
|
||||
|
||||
import Common.Annex
|
||||
|
@ -26,12 +27,7 @@ import Config
|
|||
import System.Posix.Types
|
||||
|
||||
withShared :: (SharedRepository -> Annex a) -> Annex a
|
||||
withShared a = maybe startup a =<< Annex.getState Annex.shared
|
||||
where
|
||||
startup = do
|
||||
shared <- fromRepo getSharedRepository
|
||||
Annex.changeState $ \s -> s { Annex.shared = Just shared }
|
||||
a shared
|
||||
withShared a = a =<< coreSharedRepository <$> Annex.getGitConfig
|
||||
|
||||
setAnnexFilePerm :: FilePath -> Annex ()
|
||||
setAnnexFilePerm = setAnnexPerm False
|
||||
|
@ -90,12 +86,12 @@ createAnnexDirectory dir = walk dir [] =<< top
|
|||
-}
|
||||
freezeContentDir :: FilePath -> Annex ()
|
||||
freezeContentDir file = unlessM crippledFileSystem $
|
||||
liftIO . go =<< fromRepo getSharedRepository
|
||||
withShared go
|
||||
where
|
||||
dir = parentDir file
|
||||
go GroupShared = groupWriteRead dir
|
||||
go AllShared = groupWriteRead dir
|
||||
go _ = preventWrite dir
|
||||
go GroupShared = liftIO $ groupWriteRead dir
|
||||
go AllShared = liftIO $ groupWriteRead dir
|
||||
go _ = liftIO $ preventWrite dir
|
||||
|
||||
thawContentDir :: FilePath -> Annex ()
|
||||
thawContentDir file = unlessM crippledFileSystem $
|
||||
|
|
|
@ -16,6 +16,7 @@ import Common
|
|||
import qualified Git
|
||||
import qualified Git.Config
|
||||
import qualified Git.Construct
|
||||
import Git.SharedRepository
|
||||
import Utility.DataUnits
|
||||
import Config.Cost
|
||||
import Types.Distribution
|
||||
|
@ -58,6 +59,7 @@ data GitConfig = GitConfig
|
|||
, annexStartupScan :: Bool
|
||||
, annexHardLink :: Bool
|
||||
, coreSymlinks :: Bool
|
||||
, coreSharedRepository :: SharedRepository
|
||||
, gcryptId :: Maybe String
|
||||
, annexDifferences :: Differences
|
||||
, annexUsedRefSpec :: Maybe RefSpec
|
||||
|
@ -97,6 +99,7 @@ extractGitConfig r = GitConfig
|
|||
, annexStartupScan = getbool (annex "startupscan") True
|
||||
, annexHardLink = getbool (annex "hardlink") False
|
||||
, coreSymlinks = getbool "core.symlinks" True
|
||||
, coreSharedRepository = getSharedRepository r
|
||||
, gcryptId = getmaybe "core.gcrypt-id"
|
||||
, annexDifferences = getDifferences r
|
||||
, annexUsedRefSpec = either (const Nothing) Just . parseRefSpec
|
||||
|
|
Loading…
Reference in a new issue