summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-02-17 15:05:55 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-02-17 16:43:14 -0400
commit6d8b95d6bf0d7b5666efc02379fe55e8d02e1ebe (patch)
treeb93747a1bad6f2ca2456d4ac95d5cf177855f98d /Command
parent898a39429f750bd05898df9a4b8dae371ddc9d68 (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.hs48
-rw-r--r--Command/Fsck.hs11
-rw-r--r--Command/Indirect.hs11
-rw-r--r--Command/Sync.hs7
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