start to support core.symlinks=false

Utility functions to handle no symlink mode, and converted Annex.Content to
use them; still many other places to convert.

1 files changed, 39 insertions, 8 deletions

diff --git a/Backend.hs b/Backend.hs
index d5007f0f9..076f7c2ce 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -1,6 +1,6 @@
 {- git-annex key/value backends
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -10,6 +10,8 @@ module Backend (
 	orderedList,
 	genKey,
 	lookupFile,
+	isAnnexLink,
+	makeAnnexLink,
 	chooseBackend,
 	lookupBackendName,
 	maybeLookupBackendName
@@ -81,20 +83,20 @@ genKey' (b:bs) source = do
  - the symlink is looked up in git instead. However, a real symlink
  - on disk still takes precedence over what was committed to git in direct
  - mode.
+ -
+ - On a filesystem that does not support symlinks, git will instead store
+ - the symlink target in a regular file.
  -}
 lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile file = do
-	tl <- liftIO $ tryIO $ readSymbolicLink file
-	case tl of
-		Right l
-			| isLinkToAnnex l -> makekey l
-			| otherwise -> return Nothing
-		Left _ -> ifM isDirect
+	mkey <- isAnnexLink file
+	case mkey of
+		Just key -> makeret key
+		Nothing -> ifM isDirect
 			( maybe (return Nothing) makeret =<< catKeyFile file
 			, return Nothing
 			)
   where
-	makekey l = maybe (return Nothing) makeret (fileKey $ takeFileName l)
 	makeret k = let bname = keyBackendName k in
 		case maybeLookupBackendName bname of
 			Just backend -> do
@@ -105,6 +107,35 @@ lookupFile file = do
 					" (unknown backend " ++ bname ++ ")"
 				return Nothing
 
+{- Checks if a file is a symlink to a key.
+ -
+ - On a filesystem that does not support symlinks, git will instead store
+ - the symlink target in a regular file. (Only look at first 8k of file,
+ - more than enough for any symlink target.)
+ -}
+isAnnexLink :: FilePath -> Annex (Maybe Key)
+isAnnexLink file = maybe Nothing makekey <$> gettarget
+  where
+	gettarget = ifM (coreSymlinks <$> Annex.getGitConfig)
+		( liftIO $ catchMaybeIO $ readSymbolicLink file
+		, liftIO $ catchMaybeIO $ take 8192 <$> readFile file
+		)
+	makekey l
+		| isLinkToAnnex l = fileKey $ takeFileName l
+		| otherwise = Nothing
+
+{- Creates a symlink on disk.
+ -
+ - On a filesystem that does not support symlinks, writes the link target
+ - to a file. Note that git will only treat the file as a symlink if
+ - it's staged as such.
+ -}
+makeAnnexLink :: String -> FilePath -> Annex ()
+makeAnnexLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
+	( liftIO $ createSymbolicLink linktarget file
+	, liftIO $ writeFile file linktarget
+	)
+
 {- Looks up the backend that should be used for a file.
  - That can be configured on a per-file basis in the gitattributes file. -}
 chooseBackend :: FilePath -> Annex (Maybe Backend)