diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-01-09 13:11:56 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-01-09 13:11:56 -0400 |
commit | 425bc1107aebdb701cdcee44da731dd918cd470d (patch) | |
tree | 25bcacb37277b70aa7bd0caaf0fe7c3edc665653 /Annex | |
parent | 20c7644a4d85434cf49840ea92fca0c723710c72 (diff) |
revert parentDir change
Reverts 2bba5bc22d049272d3328bfa6c452d3e2e50e86c
Unfortunately, this caused breakage on Windows, and possibly elsewhere,
because parentDir and takeDirectory do not behave the same when there is a
trailing directory separator.
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Content.hs | 6 | ||||
-rw-r--r-- | Annex/Content/Direct.hs | 2 | ||||
-rw-r--r-- | Annex/Direct.hs | 21 | ||||
-rw-r--r-- | Annex/Direct/Fixup.hs | 5 | ||||
-rw-r--r-- | Annex/Perms.hs | 10 | ||||
-rw-r--r-- | Annex/ReplaceFile.hs | 2 | ||||
-rw-r--r-- | Annex/Ssh.hs | 2 |
7 files changed, 23 insertions, 25 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 2d52dcefb..37090d3bb 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -261,7 +261,7 @@ finishGetViaTmp check key action = do prepTmp :: Key -> Annex FilePath prepTmp key = do tmp <- fromRepo $ gitAnnexTmpObjectLocation key - createAnnexDirectory (takeDirectory tmp) + createAnnexDirectory (parentDir tmp) return tmp {- Creates a temp file for a key, runs an action on it, and cleans up @@ -425,7 +425,7 @@ cleanObjectLoc key cleaner = do where removeparents _ 0 = noop removeparents file n = do - let dir = takeDirectory file + let dir = parentDir file maybe noop (const $ removeparents dir (n-1)) <=< catchMaybeIO $ removeDirectory dir @@ -474,7 +474,7 @@ moveBad key = do src <- calcRepo $ gitAnnexLocation key bad <- fromRepo gitAnnexBadDir let dest = bad </> takeFileName src - createAnnexDirectory (takeDirectory dest) + createAnnexDirectory (parentDir dest) cleanObjectLoc key $ liftIO $ moveFile src dest logStatus key InfoMissing diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index 43defdca3..c09a08f0d 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -247,7 +247,7 @@ sentinalStatus = maybe check return =<< Annex.getState Annex.sentinalstatus createInodeSentinalFile :: Annex () createInodeSentinalFile = unlessM (alreadyexists <||> hasobjects) $ do s <- annexSentinalFile - createAnnexDirectory (takeDirectory (sentinalFile s)) + createAnnexDirectory (parentDir (sentinalFile s)) liftIO $ writeSentinalFile s where alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 710227e7e..15eb04060 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -270,7 +270,7 @@ updateWorkTree d oldref = do - Empty work tree directories are removed, per git behavior. -} moveout_raw _ _ f = liftIO $ do nukeFile f - void $ tryIO $ removeDirectory $ takeDirectory f + void $ tryIO $ removeDirectory $ parentDir f {- If the file is already present, with the right content for the - key, it's left alone. @@ -291,7 +291,7 @@ updateWorkTree d oldref = do movein_raw item makeabs f = do preserveUnannexed item makeabs f oldref liftIO $ do - createDirectoryIfMissing True $ takeDirectory f + createDirectoryIfMissing True $ parentDir f void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f {- If the file that's being moved in is already present in the work @@ -309,14 +309,13 @@ preserveUnannexed item makeabs absf oldref = do checkdirs (DiffTree.file item) where checkdirs from = do - case parentDir (getTopFilePath from) of - Nothing -> noop - Just p -> do - let d = asTopFilePath p - let absd = makeabs d - whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $ - liftIO $ findnewname absd 0 - checkdirs d + let p = parentDir (getTopFilePath from) + let d = asTopFilePath p + unless (null p) $ do + let absd = makeabs d + whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $ + liftIO $ findnewname absd 0 + checkdirs d collidingitem f = isJust <$> catchMaybeIO (getSymbolicLinkStatus f) @@ -383,7 +382,7 @@ removeDirect k f = do ) liftIO $ do nukeFile f - void $ tryIO $ removeDirectory $ takeDirectory f + void $ tryIO $ removeDirectory $ parentDir f {- Called when a direct mode file has been changed. Its old content may be - lost. -} diff --git a/Annex/Direct/Fixup.hs b/Annex/Direct/Fixup.hs index 73cefb134..13485242a 100644 --- a/Annex/Direct/Fixup.hs +++ b/Annex/Direct/Fixup.hs @@ -10,17 +10,16 @@ module Annex.Direct.Fixup where import Git.Types import Git.Config import qualified Git.Construct as Construct +import Utility.Path import Utility.SafeCommand -import System.FilePath - {- Direct mode repos have core.bare=true, but are not really bare. - Fix up the Repo to be a non-bare repo, and arrange for git commands - run by git-annex to be passed parameters that override this setting. -} fixupDirect :: Repo -> IO Repo fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do let r' = r - { location = l { worktree = Just (takeDirectory d) } + { location = l { worktree = Just (parentDir d) } , gitGlobalOpts = gitGlobalOpts r ++ [ Param "-c" , Param $ coreBare ++ "=" ++ boolConfig False diff --git a/Annex/Perms.hs b/Annex/Perms.hs index d314e382c..3430554c7 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -71,12 +71,12 @@ annexFileMode = withShared $ return . go createAnnexDirectory :: FilePath -> Annex () createAnnexDirectory dir = traverse dir [] =<< top where - top = takeDirectory <$> fromRepo gitAnnexDir + top = parentDir <$> fromRepo gitAnnexDir traverse d below stop | d `equalFilePath` stop = done | otherwise = ifM (liftIO $ doesDirectoryExist d) ( done - , traverse (takeDirectory d) (d:below) stop + , traverse (parentDir d) (d:below) stop ) where done = forM_ below $ \p -> do @@ -92,14 +92,14 @@ freezeContentDir :: FilePath -> Annex () freezeContentDir file = unlessM crippledFileSystem $ liftIO . go =<< fromRepo getSharedRepository where - dir = takeDirectory file + dir = parentDir file go GroupShared = groupWriteRead dir go AllShared = groupWriteRead dir go _ = preventWrite dir thawContentDir :: FilePath -> Annex () thawContentDir file = unlessM crippledFileSystem $ - liftIO $ allowWrite $ takeDirectory file + liftIO $ allowWrite $ parentDir file {- Makes the directory tree to store an annexed file's content, - with appropriate permissions on each level. -} @@ -111,7 +111,7 @@ createContentDir dest = do unlessM crippledFileSystem $ liftIO $ allowWrite dir where - dir = takeDirectory dest + dir = parentDir dest {- Creates the content directory for a file if it doesn't already exist, - or thaws it if it does, then runs an action to modify the file, and diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 4bb99b370..0355ddd51 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -46,5 +46,5 @@ replaceFileFrom src dest = go `catchIO` fallback where go = moveFile src dest fallback _ = do - createDirectoryIfMissing True $ takeDirectory dest + createDirectoryIfMissing True $ parentDir dest go diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 2eb8c97dd..15b169862 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -125,7 +125,7 @@ prepSocket socketfile = do -- Cleanup at end of this run. Annex.addCleanup SshCachingCleanup sshCleanup - liftIO $ createDirectoryIfMissing True $ takeDirectory socketfile + liftIO $ createDirectoryIfMissing True $ parentDir socketfile lockFileShared $ socket2lock socketfile enumSocketFiles :: Annex [FilePath] |