refactor

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]

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
+thawContentDir file = thawPerms $ liftIO $ allowWrite $ parentDir file
-	-- 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
 
 {- Makes the directory tree to store an annexed file's content,
  - with appropriate permissions on each level. -}

Command/Unannex.hs

@@ -13,6 +13,7 @@ import Command
 import Config
 import qualified Annex
 import Annex.Content
+import Annex.Perms
 import Annex.Content.Direct
 import Annex.Version
 import qualified Git.Command

Command/Unlock.hs

@@ -9,6 +9,7 @@ module Command.Unlock where
 
 import Command
 import Annex.Content
+import Annex.Perms
 import Annex.CatFile
 import Annex.Version
 import Annex.Link