diff --git a/Annex/Link.hs b/Annex/Link.hs index 24ec6c7c96..1b4aacfac6 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 058ce9f0a5..b66927435e 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__