From b98b69e8c6d9b873a864b79cff857882f67ee576 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 21 Apr 2012 16:59:49 -0400 Subject: honor core.sharedRepository when making all the other files in the annex Lock files, directories, etc. --- Annex/Branch.hs | 2 ++ Annex/Content.hs | 22 ++++++++++++------ Annex/Journal.hs | 41 +++++++++++++++------------------ Annex/LockPool.hs | 5 ++++- Annex/Perms.hs | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++ Annex/Ssh.hs | 5 ++++- Remote/Helper/Hooks.hs | 5 ++++- Utility/FileMode.hs | 11 +++++++++ 8 files changed, 119 insertions(+), 33 deletions(-) create mode 100644 Annex/Perms.hs diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 52089ac97..e5976c2c0 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -36,6 +36,7 @@ import qualified Git.UnionMerge import Git.HashObject import qualified Git.Index import Annex.CatFile +import Annex.Perms {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref @@ -308,6 +309,7 @@ setIndexSha :: Git.Ref -> Annex () setIndexSha ref = do lock <- fromRepo gitAnnexIndexLock liftIO $ writeFile lock $ show ref ++ "\n" + setAnnexPerm lock {- Checks if there are uncommitted changes in the branch's index or journal. -} unCommitted :: Annex Bool diff --git a/Annex/Content.hs b/Annex/Content.hs index b216b861d..7022364d0 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -46,6 +46,7 @@ import Utility.CopyFile import Config import Annex.Exception import Git.SharedRepository +import Annex.Perms {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool @@ -141,7 +142,7 @@ getViaTmp key action = do prepTmp :: Key -> Annex FilePath prepTmp key = do tmp <- fromRepo $ gitAnnexTmpLocation key - liftIO $ createDirectoryIfMissing True (parentDir tmp) + createAnnexDirectory (parentDir tmp) return tmp {- Like getViaTmp, but does not check that there is enough disk space @@ -216,14 +217,11 @@ checkDiskSpace destination key alreadythere = do moveAnnex :: Key -> FilePath -> Annex () moveAnnex key src = do dest <- inRepo $ gitAnnexLocation key - let dir = parentDir dest ifM (liftIO $ doesFileExist dest) ( liftIO $ removeFile src , do - liftIO $ do - createDirectoryIfMissing True dir - allowWrite dir -- in case the directory already exists - moveFile src dest + createContentDir dest + liftIO $ moveFile src dest freezeContent dest freezeContentDir dest ) @@ -268,8 +266,8 @@ moveBad key = do src <- inRepo $ gitAnnexLocation key bad <- fromRepo gitAnnexBadDir let dest = bad takeFileName src + createAnnexDirectory (parentDir dest) liftIO $ do - createDirectoryIfMissing True (parentDir dest) allowWrite (parentDir src) moveFile src dest cleanObjectLoc key @@ -367,3 +365,13 @@ freezeContentDir file = liftIO . go =<< fromRepo getSharedRepository go AllShared = groupWriteRead dir go _ = preventWrite dir +{- Makes the directory tree to store an annexed file's content, + - with appropriate permissions on each level. -} +createContentDir :: FilePath -> Annex () +createContentDir dest = do + unlessM (liftIO $ doesDirectoryExist dir) $ + createAnnexDirectory dir + -- might have already existed with restricted perms + liftIO $ allowWrite dir + where + dir = parentDir dest diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 34c4d98c8..ff103180e 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -16,6 +16,7 @@ import System.IO.Binary import Common.Annex import Annex.Exception import qualified Git +import Annex.Perms {- Records content for a file in the branch to the journal. - @@ -23,22 +24,20 @@ import qualified Git - avoids git needing to rewrite the index after every change. -} setJournalFile :: FilePath -> String -> Annex () setJournalFile file content = do - g <- gitRepo - liftIO $ doRedo (write g) $ do - createDirectoryIfMissing True $ gitAnnexJournalDir g - createDirectoryIfMissing True $ gitAnnexTmpDir g - where - -- journal file is written atomically - write g = do - let jfile = journalFile g file - let tmpfile = gitAnnexTmpDir g takeFileName jfile - writeBinaryFile tmpfile content - moveFile tmpfile jfile + createAnnexDirectory =<< fromRepo gitAnnexJournalDir + createAnnexDirectory =<< fromRepo gitAnnexTmpDir + -- journal file is written atomically + jfile <- fromRepo $ journalFile file + tmp <- fromRepo gitAnnexTmpDir + let tmpfile = tmp takeFileName jfile + liftIO $ do + writeBinaryFile tmpfile content + moveFile tmpfile jfile {- Gets any journalled content for a file in the branch. -} getJournalFile :: FilePath -> Annex (Maybe String) getJournalFile file = inRepo $ \g -> catchMaybeIO $ - readFileStrict $ journalFile g file + readFileStrict $ journalFile file g {- List of files that have updated content in the journal. -} getJournalledFiles :: Annex [FilePath] @@ -62,8 +61,8 @@ journalDirty = not . null <$> getJournalFiles - used in the branch is not necessary, and all the files are put directly - in the journal directory. -} -journalFile :: Git.Repo -> FilePath -> FilePath -journalFile repo file = gitAnnexJournalDir repo concatMap mangle file +journalFile :: FilePath -> Git.Repo -> FilePath +journalFile file repo = gitAnnexJournalDir repo concatMap mangle file where mangle '/' = "_" mangle '_' = "__" @@ -79,16 +78,12 @@ fileJournal = replace "//" "_" . replace "_" "/" lockJournal :: Annex a -> Annex a lockJournal a = do file <- fromRepo gitAnnexJournalLock - bracketIO (lock file) unlock a + createAnnexDirectory $ takeDirectory file + mode <- annexFileMode + bracketIO (lock file mode) unlock a where - lock file = do - l <- doRedo (createFile file stdFileMode) $ - createDirectoryIfMissing True $ takeDirectory file + lock file mode = do + l <- noUmask mode $ createFile file mode waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0) return l unlock = closeFd - -{- Runs an action, catching failure and running something to fix it up, and - - retrying if necessary. -} -doRedo :: IO a -> IO b -> IO a -doRedo a b = catchIO a $ const $ b >> a diff --git a/Annex/LockPool.hs b/Annex/LockPool.hs index 3fede5739..3eb1363ee 100644 --- a/Annex/LockPool.hs +++ b/Annex/LockPool.hs @@ -12,6 +12,7 @@ import System.Posix.Types (Fd) import Common.Annex import Annex +import Annex.Perms {- Create a specified lock file, and takes a shared lock. -} lockFile :: FilePath -> Annex () @@ -19,7 +20,9 @@ lockFile file = go =<< fromPool file where go (Just _) = return () -- already locked go Nothing = do - fd <- liftIO $ openFd file ReadOnly (Just stdFileMode) defaultFileFlags + mode <- annexFileMode + fd <- liftIO $ noUmask mode $ + openFd file ReadOnly (Just mode) defaultFileFlags liftIO $ waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0) changePool $ M.insert file fd diff --git a/Annex/Perms.hs b/Annex/Perms.hs new file mode 100644 index 000000000..2b54077ca --- /dev/null +++ b/Annex/Perms.hs @@ -0,0 +1,61 @@ +{- git-annex file permissions + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Perms ( + setAnnexPerm, + annexFileMode, + createAnnexDirectory, + noUmask, +) where + +import Common.Annex +import Utility.FileMode +import Git.SharedRepository + +import System.Posix.Types + +{- Sets appropriate file mode for a file or directory in the annex, + - other than the content files and content directory. Normally, + - use the default mode, but with core.sharedRepository set, + - allow the group to write, etc. -} +setAnnexPerm :: FilePath -> Annex () +setAnnexPerm file = liftIO . go =<< fromRepo getSharedRepository + where + go GroupShared = groupWriteRead file + go AllShared = modifyFileMode file $ addModes $ + [ ownerWriteMode, groupWriteMode ] ++ readModes + go _ = return () + +{- Gets the appropriate mode to use for creating a file in the annex + - (other than content files, which are locked down more). -} +annexFileMode :: Annex FileMode +annexFileMode = go <$> fromRepo getSharedRepository + where + go GroupShared = sharedmode + go AllShared = combineModes (sharedmode:readModes) + go _ = stdFileMode + sharedmode = combineModes + [ ownerWriteMode, groupWriteMode + , ownerReadMode, groupReadMode + ] + +{- Creates a directory inside the gitAnnexDir, including any parent + - directories. Makes directories with appropriate permissions. -} +createAnnexDirectory :: FilePath -> Annex () +createAnnexDirectory dir = traverse dir [] =<< top + where + top = parentDir <$> fromRepo gitAnnexDir + traverse d below stop + | d `equalFilePath` stop = done + | otherwise = ifM (liftIO $ doesDirectoryExist d) + ( done + , traverse (parentDir d) (d:below) stop + ) + where + done = forM_ below $ \p -> do + liftIO $ createDirectory p + setAnnexPerm p diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index e6cd6a926..c9e6e2951 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -17,6 +17,7 @@ import Annex.LockPool import qualified Git import Config import qualified Build.SysConfig as SysConfig +import Annex.Perms {- Generates parameters to ssh to a given host (or user@host) on a given - port, with connection caching. -} @@ -74,7 +75,9 @@ sshCleanup = do -- be stopped. let lockfile = socket2lock socketfile unlockFile lockfile - fd <- liftIO $ openFd lockfile ReadWrite (Just stdFileMode) defaultFileFlags + mode <- annexFileMode + fd <- liftIO $ noUmask mode $ + openFd lockfile ReadWrite (Just mode) defaultFileFlags v <- liftIO $ tryIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) case v of diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 2864a8ed5..de731bd6e 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -14,6 +14,7 @@ import Types.Remote import qualified Annex import Annex.LockPool import Config +import Annex.Perms {- Modifies a remote's access functions to first run the - annex-start-command hook, and trigger annex-stop-command on shutdown. @@ -75,7 +76,9 @@ runHooks r starthook stophook a = do -- succeeds, we're the only process using this remote, -- so can stop it. unlockFile lck - fd <- liftIO $ openFd lck ReadWrite (Just stdFileMode) defaultFileFlags + mode <- annexFileMode + fd <- liftIO $ noUmask mode $ + openFd lck ReadWrite (Just mode) defaultFileFlags v <- liftIO $ tryIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) case v of diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index f3db70923..c0f2ad589 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -75,6 +75,17 @@ isExecutable mode = combineModes ebits `intersectFileModes` mode /= 0 where ebits = [ownerExecuteMode, groupExecuteMode, otherExecuteMode] +{- Runs an action without that pesky umask influencing it, unless the + - passed FileMode is the standard one. -} +noUmask :: FileMode -> IO a -> IO a +noUmask mode a + | mode == stdFileMode = a + | otherwise = bracket setup cleanup go + where + setup = setFileCreationMask nullFileMode + cleanup = setFileCreationMask + go _ = a + combineModes :: [FileMode] -> FileMode combineModes [] = undefined combineModes [m] = m -- cgit v1.2.3