Merge remote-tracking branch 'gnu/windows' into windows

2 files changed, 23 insertions, 21 deletions

diff --git a/Annex/Link.hs b/Annex/Link.hs
index 24ec6c7c9..1b4aacfac 100644
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -28,25 +28,27 @@ isAnnexLink file = maybe Nothing (fileKey . takeFileName) <$> getAnnexLinkTarget
 
 {- Gets the link target of a symlink.
  -
- - On a filesystem that does not support symlinks, get the link
- - target by looking inside the file. (Only return at first 8k of the file,
- - more than enough for any symlink target.)
+ - On a filesystem that does not support symlinks, fall back to getting the
+ - link target by looking inside the file. (Only return at first 8k of the
+ - file, more than enough for any symlink target.)
  -
  - Returns Nothing if the file is not a symlink, or not a link to annex
  - content.
  -}
 getAnnexLinkTarget :: FilePath -> Annex (Maybe LinkTarget)
-getAnnexLinkTarget file = do
-	v <- ifM (coreSymlinks <$> Annex.getGitConfig)
-		( liftIO $ catchMaybeIO $ readSymbolicLink file
-		, liftIO $ catchMaybeIO $ readfilestart file
-		)
-	case v of
-		Nothing -> return Nothing
-		Just l
-			| isLinkToAnnex l -> return v
-			| otherwise -> return Nothing
+getAnnexLinkTarget file =
+	check readSymbolicLink $
+		check readfilestart $
+			return Nothing
   where
+	check getlinktarget fallback = do
+		v <- liftIO $ catchMaybeIO $ getlinktarget file
+		case v of
+			Just l
+				| isLinkToAnnex l -> return v
+				| otherwise -> return Nothing
+			Nothing -> fallback
+
 	readfilestart f = do
 		h <- openFile f ReadMode
 		fileEncoding h
diff --git a/Init.hs b/Init.hs
index 058ce9f0a..b66927435 100755
--- a/Init.hs
+++ b/Init.hs
@@ -151,6 +151,14 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
 	warning "Detected a crippled filesystem."
 	setCrippledFileSystem True
 
+	{- Normally git disables core.symlinks itself when the filesystem does
+ 	 - not support them, but in Cygwin, git does support symlinks, while
+ 	 - git-annex, not linking with Cygwin, does not. -}
+	whenM (coreSymlinks <$> Annex.getGitConfig) $ do
+		warning "Disabling core.symlinks."
+		setConfig (ConfigKey "core.symlinks")
+			(Git.Config.boolConfig False)
+
 	unlessM isDirect $ do
 		warning "Enabling direct mode."
 		top <- fromRepo Git.repoPath
@@ -161,14 +169,6 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do
 		setDirect True
 	setVersion directModeVersion
 
-	{- Normally git disables core.symlinks itself when the filesystem does
- 	 - not support them, but in Cygwin, git does support symlinks, while
- 	 - git-annex, not linking with Cygwin, does not. -}
-	whenM (coreSymlinks <$> Annex.getGitConfig) $ do
-		warning "Disabling core.symlinks."
-		setConfig (ConfigKey "core.symlinks")
-			(Git.Config.boolConfig False)
-
 probeFifoSupport :: Annex Bool
 probeFifoSupport = do
 #ifdef __WINDOWS__