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

This commit is contained in:
Joey Hess 2013-05-14 14:21:49 -05:00
commit 15af92291f
2 changed files with 23 additions and 21 deletions

View file

@ -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

16
Init.hs
View file

@ -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__