diff options
Diffstat (limited to 'Annex/Content.hs')
| -rw-r--r-- | Annex/Content.hs | 22 |
1 files changed, 15 insertions, 7 deletions
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 |