summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Content.hs104
-rw-r--r--Command/Fsck.hs7
-rw-r--r--Command/Unannex.hs6
-rw-r--r--Command/Unlock.hs2
-rw-r--r--Git/SharedRepository.hs27
-rw-r--r--Utility/FileMode.hs60
-rw-r--r--debian/changelog1
7 files changed, 155 insertions, 52 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 932f1b755..616e4128a 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -23,10 +23,11 @@ module Annex.Content (
saveState,
downloadUrl,
preseedTmp,
+ freezeContent,
+ thawContent,
+ freezeContentDir,
) where
-import Control.Exception (bracket_)
-import System.Posix.Types
import System.IO.Unsafe (unsafeInterleaveIO)
import Common.Annex
@@ -44,6 +45,7 @@ import Utility.DataUnits
import Utility.CopyFile
import Config
import Annex.Exception
+import Git.SharedRepository
{- Checks if a given key's content is currently present. -}
inAnnex :: Key -> Annex Bool
@@ -57,8 +59,10 @@ inAnnex' a key = do
{- A safer check; the key's content must not only be present, but
- is not in the process of being removed. -}
inAnnexSafe :: Key -> Annex (Maybe Bool)
-inAnnexSafe = inAnnex' $ \f -> openForLock f False >>= check
+inAnnexSafe = inAnnex' $ \f -> openforlock f >>= check
where
+ openforlock f = catchMaybeIO $
+ openFd f ReadOnly Nothing defaultFileFlags
check Nothing = return is_missing
check (Just h) = do
v <- getLock h (ReadLock, AbsoluteSeek, 0, 0)
@@ -75,30 +79,27 @@ inAnnexSafe = inAnnex' $ \f -> openForLock f False >>= check
lockContent :: Key -> Annex a -> Annex a
lockContent key a = do
file <- inRepo $ gitAnnexLocation key
- bracketIO (openForLock file True >>= lock) unlock a
+ bracketIO (openforlock file >>= lock) unlock a
where
+ {- Since files are stored with the write bit disabled, have
+ - to fiddle with permissions to open for an exclusive lock. -}
+ openforlock f = catchMaybeIO $ ifM (doesFileExist f)
+ ( withModifiedFileMode f
+ (\cur -> cur `unionFileModes` ownerWriteMode)
+ open
+ , open
+ )
+ where
+ open = openFd f ReadWrite Nothing defaultFileFlags
lock Nothing = return Nothing
- lock (Just l) = do
- v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
+ lock (Just fd) = do
+ v <- tryIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
case v of
Left _ -> error "content is locked"
- Right _ -> return $ Just l
+ Right _ -> return $ Just fd
unlock Nothing = return ()
unlock (Just l) = closeFd l
-openForLock :: FilePath -> Bool -> IO (Maybe Fd)
-openForLock file writelock = bracket_ prep cleanup go
- where
- go = catchMaybeIO $ openFd file mode Nothing defaultFileFlags
- mode = if writelock then ReadWrite else ReadOnly
- {- Since files are stored with the write bit disabled,
- - have to fiddle with permissions to open for an
- - exclusive lock. -}
- forwritelock a =
- when writelock $ whenM (doesFileExist file) a
- prep = forwritelock $ allowWrite file
- cleanup = forwritelock $ preventWrite file
-
{- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do
@@ -132,7 +133,7 @@ getViaTmp key action = do
else return 0
ifM (checkDiskSpace Nothing key alreadythere)
( do
- when e $ liftIO $ allowWrite tmp
+ when e $ thawContent tmp
getViaTmpUnchecked key action
, return False
)
@@ -216,14 +217,15 @@ moveAnnex :: Key -> FilePath -> Annex ()
moveAnnex key src = do
dest <- inRepo $ gitAnnexLocation key
let dir = parentDir dest
- liftIO $ ifM (doesFileExist dest)
- ( removeFile src
+ ifM (liftIO $ doesFileExist dest)
+ ( liftIO $ removeFile src
, do
- createDirectoryIfMissing True dir
- allowWrite dir -- in case the directory already exists
- moveFile src dest
- preventWrite dest
- preventWrite dir
+ liftIO $ do
+ createDirectoryIfMissing True dir
+ allowWrite dir -- in case the directory already exists
+ moveFile src dest
+ freezeContent dest
+ freezeContentDir dest
)
withObjectLoc :: Key -> ((FilePath, FilePath) -> Annex a) -> Annex a
@@ -254,10 +256,9 @@ removeAnnex key = withObjectLoc key $ \(dir, file) -> do
{- Moves a key's file out of .git/annex/objects/ -}
fromAnnex :: Key -> FilePath -> Annex ()
fromAnnex key dest = withObjectLoc key $ \(dir, file) -> do
- liftIO $ do
- allowWrite dir
- allowWrite file
- moveFile file dest
+ liftIO $ allowWrite dir
+ thawContent file
+ liftIO $ moveFile file dest
cleanObjectLoc key
{- Moves a key out of .git/annex/objects/ into .git/annex/bad, and
@@ -321,7 +322,7 @@ preseedTmp key file = go =<< inAnnex key
go False = return False
go True = do
ok <- copy
- when ok $ liftIO $ allowWrite file
+ when ok $ thawContent file
return ok
copy = ifM (liftIO $ doesFileExist file)
( return True
@@ -329,3 +330,40 @@ preseedTmp key file = go =<< inAnnex key
s <- inRepo $ gitAnnexLocation key
liftIO $ copyFileExternal s file
)
+
+{- Blocks writing to an annexed file. The file is made unwritable
+ - to avoid accidental edits. core.sharedRepository may change
+ - who can read it. -}
+freezeContent :: FilePath -> Annex ()
+freezeContent file = liftIO . go =<< fromRepo getSharedRepository
+ where
+ go GroupShared = do
+ preventWrite file
+ groupRead file
+ go AllShared = do
+ preventWrite file
+ allRead file
+ go _ = preventWrite file
+
+{- Allows writing to an annexed file that freezeContent was called on
+ - before. -}
+thawContent :: FilePath -> Annex ()
+thawContent file = liftIO . go =<< fromRepo getSharedRepository
+ where
+ go GroupShared = groupWriteRead file
+ go AllShared = groupWriteRead file
+ go _ = allowWrite file
+
+{- 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
+ - file.
+ -}
+freezeContentDir :: FilePath -> Annex ()
+freezeContentDir file = liftIO . go =<< fromRepo getSharedRepository
+ where
+ dir = parentDir file
+ go GroupShared = groupWriteRead dir
+ go AllShared = groupWriteRead dir
+ go _ = preventWrite dir
+
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index dac3bfac9..c60101fc7 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -166,10 +166,9 @@ verifyLocationLog key desc = do
-- Since we're checking that a key's file is present, throw
-- in a permission fixup here too.
when present $ do
- f <- inRepo $ gitAnnexLocation key
- liftIO $ do
- preventWrite f
- preventWrite (parentDir f)
+ file <- inRepo $ gitAnnexLocation key
+ freezeContent file
+ freezeContentDir file
u <- getUUID
verifyLocationLog' key desc present u (logChange key u)
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index 1e7313711..bf931adfd 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -10,7 +10,6 @@ module Command.Unannex where
import Common.Annex
import Command
import qualified Annex
-import Utility.FileMode
import Logs.Location
import Annex.Content
import qualified Git.Command
@@ -51,9 +50,8 @@ cleanup file key = do
( do
-- fast mode: hard link to content in annex
src <- inRepo $ gitAnnexLocation key
- liftIO $ do
- createLink src file
- allowWrite file
+ liftIO $ createLink src file
+ thawContent file
, do
fromAnnex key file
logStatus key InfoMissing
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index aeb270516..3ac50a0eb 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -46,6 +46,6 @@ perform dest key = do
liftIO $ do
removeFile dest
moveFile tmpdest dest
- allowWrite dest
+ thawContent dest
next $ return True
else error "copy failed!"
diff --git a/Git/SharedRepository.hs b/Git/SharedRepository.hs
new file mode 100644
index 000000000..f3efa8fde
--- /dev/null
+++ b/Git/SharedRepository.hs
@@ -0,0 +1,27 @@
+{- git core.sharedRepository handling
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.SharedRepository where
+
+import Data.Char
+
+import Common
+import Git
+import qualified Git.Config
+
+data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
+
+getSharedRepository :: Repo -> SharedRepository
+getSharedRepository r =
+ case map toLower $ Git.Config.get "core.sharedrepository" "" r of
+ "1" -> GroupShared
+ "group" -> GroupShared
+ "true" -> GroupShared
+ "all" -> AllShared
+ "world" -> AllShared
+ "everybody" -> AllShared
+ v -> maybe UnShared UmaskShared (readish v)
diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
index 4992690c6..98c7124c2 100644
--- a/Utility/FileMode.hs
+++ b/Utility/FileMode.hs
@@ -1,6 +1,6 @@
{- File mode utilities.
-
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -9,16 +9,36 @@ module Utility.FileMode where
import Common
+import Control.Exception (bracket)
import System.Posix.Types
import Foreign (complement)
+combineModes :: [FileMode] -> FileMode
+combineModes [] = undefined
+combineModes [m] = m
+combineModes (m:ms) = foldl unionFileModes m ms
+
+{- Applies a conversion function to a file's mode. -}
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
modifyFileMode f convert = do
+ _ <- modifyFileMode' f convert
+ return ()
+modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
+modifyFileMode' f convert = do
s <- getFileStatus f
- let cur = fileMode s
- let new = convert cur
- when (new /= cur) $
+ let old = fileMode s
+ let new = convert old
+ when (new /= old) $
setFileMode f new
+ return old
+
+{- Runs an action after changing a file's mode, then restores the old mode. -}
+withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
+withModifiedFileMode file convert a = bracket setup cleanup go
+ where
+ setup = modifyFileMode' file convert
+ cleanup oldmode = modifyFileMode file (const oldmode)
+ go _ = a
{- Removes a FileMode from a file.
- For example, call with otherWriteMode to chmod o-w -}
@@ -28,23 +48,43 @@ unsetFileMode f m = modifyFileMode f $
{- Removes the write bits from a file. -}
preventWrite :: FilePath -> IO ()
-preventWrite f = unsetFileMode f writebits
+preventWrite f = unsetFileMode f $ combineModes writebits
where
- writebits = foldl unionFileModes ownerWriteMode
- [groupWriteMode, otherWriteMode]
+ writebits = [ownerWriteMode, groupWriteMode, otherWriteMode]
{- Turns a file's write bit back on. -}
allowWrite :: FilePath -> IO ()
allowWrite f = modifyFileMode f $
\cur -> cur `unionFileModes` ownerWriteMode
+{- Allows owner and group to read and write to a file. -}
+groupWriteRead :: FilePath -> IO ()
+groupWriteRead f = modifyFileMode f $ \cur -> combineModes
+ [ cur
+ , ownerWriteMode, groupWriteMode
+ , ownerReadMode, groupReadMode
+ ]
+
+{- Allows group to read a file. -}
+groupRead :: FilePath -> IO ()
+groupRead f = modifyFileMode f $ \cur -> combineModes
+ [ cur
+ , ownerReadMode, groupReadMode
+ ]
+
+{- Allows all to read a file. -}
+allRead :: FilePath -> IO ()
+allRead f = modifyFileMode f $ \cur -> combineModes
+ [ cur
+ , ownerReadMode, groupReadMode, otherReadMode
+ ]
+
{- Checks if a file mode indicates it's a symlink. -}
isSymLink :: FileMode -> Bool
isSymLink mode = symbolicLinkMode `intersectFileModes` mode == symbolicLinkMode
{- Checks if a file has any executable bits set. -}
isExecutable :: FileMode -> Bool
-isExecutable mode = ebits `intersectFileModes` mode /= 0
+isExecutable mode = combineModes ebits `intersectFileModes` mode /= 0
where
- ebits = ownerExecuteMode `unionFileModes`
- groupExecuteMode `unionFileModes` otherExecuteMode
+ ebits = [ownerExecuteMode, groupExecuteMode, otherExecuteMode]
diff --git a/debian/changelog b/debian/changelog
index eeb4bdfe4..3c56fda51 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,7 @@ git-annex (3.20120419) UNRELEASED; urgency=low
* Fix use of annex.diskreserve config setting.
* Directory special remotes now check annex.diskreserve.
+ * Support git's core.sharedRepository configuration.
-- Joey Hess <joeyh@debian.org> Fri, 20 Apr 2012 16:14:08 -0400
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-28 15:44:49 +0000