diff options
author | Joey Hess <joey@kitenet.net> | 2013-02-17 15:05:55 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-02-17 16:43:14 -0400 |
commit | 6d8b95d6bf0d7b5666efc02379fe55e8d02e1ebe (patch) | |
tree | b93747a1bad6f2ca2456d4ac95d5cf177855f98d /Command | |
parent | 898a39429f750bd05898df9a4b8dae371ddc9d68 (diff) |
fully support core.symlinks=false in all relevant symlink handling code
Refactored annex link code into nice clean new library.
Audited and dealt with calls to createSymbolicLink.
Remaining calls are all safe, because:
Annex/Link.hs: ( liftIO $ createSymbolicLink linktarget file
only when core.symlinks=true
Assistant/WebApp/Configurators/Local.hs: createSymbolicLink link link
test if symlinks can be made
Command/Fix.hs: liftIO $ createSymbolicLink link file
command only works in indirect mode
Command/FromKey.hs: liftIO $ createSymbolicLink link file
command only works in indirect mode
Command/Indirect.hs: liftIO $ createSymbolicLink l f
refuses to run if core.symlinks=false
Init.hs: createSymbolicLink f f2
test if symlinks can be made
Remote/Directory.hs: go [file] = catchBoolIO $ createSymbolicLink file f >> return True
fast key linking; catches failure to make symlink and falls back to copy
Remote/Git.hs: liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
ditto
Upgrade/V1.hs: liftIO $ createSymbolicLink link f
v1 repos could not be on a filesystem w/o symlinks
Audited and dealt with calls to readSymbolicLink.
Remaining calls are all safe, because:
Annex/Link.hs: ( liftIO $ catchMaybeIO $ readSymbolicLink file
only when core.symlinks=true
Assistant/Threads/Watcher.hs: ifM ((==) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file))
code that fixes real symlinks when inotify sees them
It's ok to not fix psdueo-symlinks.
Assistant/Threads/Watcher.hs: mlink <- liftIO (catchMaybeIO $ readSymbolicLink file)
ditto
Command/Fix.hs: stopUnless ((/=) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file)) $ do
command only works in indirect mode
Upgrade/V1.hs: getsymlink = takeFileName <$> readSymbolicLink file
v1 repos could not be on a filesystem w/o symlinks
Audited and dealt with calls to isSymbolicLink.
(Typically used with getSymbolicLinkStatus, but that is just used because
getFileStatus is not as robust; it also works on pseudolinks.)
Remaining calls are all safe, because:
Assistant/Threads/SanityChecker.hs: | isSymbolicLink s -> addsymlink file ms
only handles staging of symlinks that were somehow not staged
(might need to be updated to support pseudolinks, but this is
only a belt-and-suspenders check anyway, and I've never seen the code run)
Command/Add.hs: if isSymbolicLink s || not (isRegularFile s)
avoids adding symlinks to the annex, so not relevant
Command/Indirect.hs: | isSymbolicLink s -> void $ flip whenAnnexed f $
only allowed on systems that support symlinks
Command/Indirect.hs: whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do
ditto
Seek.hs:notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
used to find unlocked files, only relevant in indirect mode
Utility/FSEvents.hs: | Files.isSymbolicLink s = runhook addSymlinkHook $ Just s
Utility/FSEvents.hs: | Files.isSymbolicLink s ->
Utility/INotify.hs: | Files.isSymbolicLink s ->
Utility/INotify.hs: checkfiletype Files.isSymbolicLink addSymlinkHook f
Utility/Kqueue.hs: | Files.isSymbolicLink s = callhook addSymlinkHook (Just s) change
all above are lower-level, not relevant
Audited and dealt with calls to isSymLink.
Remaining calls are all safe, because:
Annex/Direct.hs: | isSymLink (getmode item) =
This is looking at git diff-tree objects, not files on disk
Command/Unused.hs: | isSymLink (LsTree.mode l) = do
This is looking at git ls-tree, not file on disk
Utility/FileMode.hs:isSymLink :: FileMode -> Bool
Utility/FileMode.hs:isSymLink = checkMode symbolicLinkMode
low-level
Done!!
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 48 | ||||
-rw-r--r-- | Command/Fsck.hs | 11 | ||||
-rw-r--r-- | Command/Indirect.hs | 11 | ||||
-rw-r--r-- | Command/Sync.hs | 7 |
4 files changed, 44 insertions, 33 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index 9cd5ec87b..7ebf979cd 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -12,22 +12,20 @@ module Command.Add where import Common.Annex import Annex.Exception import Command -import qualified Annex -import qualified Annex.Queue import Types.KeySource import Backend import Logs.Location import Annex.Content import Annex.Content.Direct import Annex.Perms +import Annex.Link +import qualified Annex +import qualified Annex.Queue #ifndef WITH_ANDROID import Utility.Touch #endif import Utility.FileMode import Config -import qualified Git.HashObject -import qualified Git.UpdateIndex -import Git.Types import Utility.InodeCache def :: [Command] @@ -159,7 +157,7 @@ undo file key e = do link :: FilePath -> Key -> Bool -> Annex String link file key hascontent = handle (undo file key) $ do l <- calcGitLink file key - liftIO $ createSymbolicLink l file + makeAnnexLink l file #ifndef WITH_ANDROID when hascontent $ do @@ -173,23 +171,35 @@ link file key hascontent = handle (undo file key) $ do return l {- Note: Several other commands call this, and expect it to - - create the symlink and add it. -} + - create the link and add it. + - + - In direct mode, when we have the content of the file, it's left as-is, + - and we just stage a symlink to git. + - + - Otherwise, as long as the filesystem supports symlinks, we use + - git add, rather than directly staging the symlink to git. + - Using git add is best because it allows the queuing to work + - and is faster (staging the symlink runs hash-object commands each time). + - Also, using git add allows it to skip gitignored files, unless forced + - to include them. + -} cleanup :: FilePath -> Key -> Bool -> CommandCleanup cleanup file key hascontent = do when hascontent $ logStatus key InfoPresent ifM (isDirect <&&> pure hascontent) - ( do - l <- calcGitLink file key - sha <- inRepo $ Git.HashObject.hashObject BlobObject l - Annex.Queue.addUpdateIndex =<< - inRepo (Git.UpdateIndex.stageSymlink file sha) - , do - _ <- link file key hascontent - params <- ifM (Annex.getState Annex.force) - ( return [Param "-f"] - , return [] - ) - Annex.Queue.addCommand "add" (params++[Param "--"]) [file] + ( stageSymlink file =<< hashSymlink =<< calcGitLink file key + , ifM (coreSymlinks <$> Annex.getGitConfig) + ( do + _ <- link file key hascontent + params <- ifM (Annex.getState Annex.force) + ( return [Param "-f"] + , return [] + ) + Annex.Queue.addCommand "add" (params++[Param "--"]) [file] + , do + l <- link file key hascontent + addAnnexLink l file + ) ) return True diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 666245517..b662ee578 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -10,7 +10,6 @@ module Command.Fsck where import Common.Annex import Command import qualified Annex -import qualified Annex.Queue import qualified Remote import qualified Types.Backend import qualified Types.Key @@ -18,6 +17,7 @@ import qualified Backend import Annex.Content import Annex.Content.Direct import Annex.Perms +import Annex.Link import Logs.Location import Logs.Trust import Annex.UUID @@ -182,14 +182,14 @@ performBare key backend = check check :: [Annex Bool] -> Annex Bool check cs = all id <$> sequence cs -{- Checks that the file's symlink points correctly to the content. +{- Checks that the file's link points correctly to the content. - - - In direct mode, there is only a symlink when the content is not present. + - In direct mode, there is only a link when the content is not present. -} fixLink :: Key -> FilePath -> Annex Bool fixLink key file = do want <- calcGitLink file key - have <- liftIO $ catchMaybeIO $ readSymbolicLink file + have <- getAnnexLinkTarget file maybe noop (go want) have return True where @@ -210,8 +210,7 @@ fixLink key file = do showNote "fixing link" liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ removeFile file - liftIO $ createSymbolicLink want file - Annex.Queue.addCommand "add" [Param "--force", Param "--"] [file] + addAnnexLink want file {- Checks that the location log reflects the current status of the key, - in this repository only. -} diff --git a/Command/Indirect.hs b/Command/Indirect.hs index 90e0b6eaf..ac97be753 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -13,6 +13,7 @@ import qualified Git import qualified Git.Command import qualified Git.LsFiles import Config +import qualified Annex import Annex.Direct import Annex.Content import Annex.CatFile @@ -27,10 +28,12 @@ seek = [withNothing start] start :: CommandStart start = ifM isDirect - ( ifM probeCrippledFileSystem - ( error "This repository seems to be on a crippled filesystem, you must use direct mode." - , next perform - ) + ( do + unlessM (coreSymlinks <$> Annex.getGitConfig) $ + error "Git is configured to not use symlinks, so you must use direct mode." + whenM probeCrippledFileSystem $ + error "This repository seems to be on a crippled filesystem, you must use direct mode." + next perform , stop ) diff --git a/Command/Sync.hs b/Command/Sync.hs index 6d3a76659..cd0398ffa 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -17,6 +17,7 @@ import qualified Annex.Queue import Annex.Content import Annex.Direct import Annex.CatFile +import Annex.Link import qualified Git.Command import qualified Git.LsFiles as LsFiles import qualified Git.Merge @@ -263,10 +264,8 @@ resolveMerge' u makelink (Just key) = do let dest = mergeFile file key l <- calcGitLink dest key - liftIO $ do - nukeFile dest - createSymbolicLink l dest - Annex.Queue.addCommand "add" [Param "--force", Param "--"] [dest] + liftIO $ nukeFile dest + addAnnexLink l dest whenM (isDirect) $ toDirect key dest makelink _ = noop |