summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-03-09 13:43:22 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-03-09 13:43:22 -0400
commit45db841c7c5602f73796836fb9203bf0a962050d (patch)
tree9fa1bf256aa8dae9269a759d26d027f28b0cde85 /Annex
parent702c128ca0da3e20291215a8db29ffe3eb1f84ed (diff)
refactor
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs49
-rw-r--r--Annex/Perms.hs62
2 files changed, 53 insertions, 58 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index d14e87adc..9c4c1d5b8 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -41,8 +41,6 @@ module Annex.Content (
saveState,
downloadUrl,
preseedTmp,
- freezeContent,
- thawContent,
dirKeys,
withObjectLoc,
staleKeysPrune,
@@ -67,7 +65,6 @@ import Utility.CopyFile
import Utility.Metered
import Config
import Git.FilePath
-import Git.SharedRepository
import Annex.Perms
import Annex.Link
import qualified Annex.Content.Direct as Direct
@@ -917,52 +914,6 @@ preseedTmp key file = go =<< inAnnex key
)
)
-{- Normally, blocks writing to an annexed file, and modifies file
- - permissions to allow reading it.
- -
- - When core.sharedRepository is set, the write bits are not removed from
- - the file, but instead the appropriate group write bits are set. This is
- - necessary to let other users in the group lock the file.
- -}
-freezeContent :: FilePath -> Annex ()
-freezeContent file = unlessM crippledFileSystem $
- withShared go
- where
- go GroupShared = liftIO $ modifyFileMode file $
- addModes [ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]
- go AllShared = liftIO $ modifyFileMode file $
- addModes (readModes ++ writeModes)
- 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 $
- withShared go
- where
- go GroupShared = liftIO $ modifyFileMode file $
- addModes [ownerReadMode, groupReadMode]
- go AllShared = liftIO $ modifyFileMode file $
- addModes readModes
- go _ = liftIO $ modifyFileMode file $
- addModes [ownerReadMode]
-
-{- Allows writing to an annexed file that freezeContent was called on
- - before. -}
-thawContent :: FilePath -> Annex ()
-thawContent file = ifM crippledFileSystem
- -- Probably cannot change mode on crippled filesystem,
- -- but if file modes are supported, the content may be frozen
- -- so try to thaw it.
- ( void $ tryNonAsync $ withShared go
- , withShared go
- )
- where
- 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. -}
dirKeys :: (Git.Repo -> FilePath) -> Annex [Key]
diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index 3905b7af9..4d525c127 100644
--- a/Annex/Perms.hs
+++ b/Annex/Perms.hs
@@ -11,6 +11,9 @@ module Annex.Perms (
annexFileMode,
createAnnexDirectory,
noUmask,
+ freezeContent,
+ thawContent,
+ chmodContent,
createContentDir,
freezeContentDir,
thawContentDir,
@@ -77,6 +80,55 @@ createAnnexDirectory dir = walk dir [] =<< top
liftIO $ createDirectoryIfMissing True p
setAnnexDirPerm p
+{- Normally, blocks writing to an annexed file, and modifies file
+ - permissions to allow reading it.
+ -
+ - When core.sharedRepository is set, the write bits are not removed from
+ - the file, but instead the appropriate group write bits are set. This is
+ - necessary to let other users in the group lock the file.
+ -}
+freezeContent :: FilePath -> Annex ()
+freezeContent file = unlessM crippledFileSystem $
+ withShared go
+ where
+ go GroupShared = liftIO $ modifyFileMode file $
+ addModes [ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]
+ go AllShared = liftIO $ modifyFileMode file $
+ addModes (readModes ++ writeModes)
+ 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 $
+ withShared go
+ where
+ go GroupShared = liftIO $ modifyFileMode file $
+ addModes [ownerReadMode, groupReadMode]
+ go AllShared = liftIO $ modifyFileMode file $
+ addModes readModes
+ go _ = liftIO $ modifyFileMode file $
+ addModes [ownerReadMode]
+
+{- Allows writing to an annexed file that freezeContent was called on
+ - before. -}
+thawContent :: FilePath -> Annex ()
+thawContent file = thawPerms $ withShared go
+ where
+ go GroupShared = liftIO $ groupWriteRead file
+ go AllShared = liftIO $ groupWriteRead file
+ go _ = liftIO $ allowWrite file
+
+{- Runs an action that thaws a file's permissions. This will probably
+ - fail on a crippled filesystem. But, if file modes are supported on a
+ - crippled filesystem, the file may be frozen, so try to thaw it. -}
+thawPerms :: Annex () -> Annex ()
+thawPerms a = ifM crippledFileSystem
+ ( void $ tryNonAsync a
+ , a
+ )
+
{- Blocks writing to the directory an annexed file is in, to prevent the
- file accidentially being deleted. However, if core.sharedRepository
- is set, this is not done, since the group must be allowed to delete the
@@ -92,15 +144,7 @@ freezeContentDir file = unlessM crippledFileSystem $
go _ = liftIO $ preventWrite dir
thawContentDir :: FilePath -> Annex ()
-thawContentDir file = ifM crippledFileSystem
- -- Probably cannot change mode on crippled filesystem,
- -- but if file modes are supported, the directory may be frozen,
- -- so try to thaw it.
- ( void $ tryNonAsync go
- , go
- )
- where
- go = liftIO $ allowWrite $ parentDir file
+thawContentDir file = thawPerms $ liftIO $ allowWrite $ parentDir file
{- Makes the directory tree to store an annexed file's content,
- with appropriate permissions on each level. -}