Merge remote-tracking branch 'gnu/windows' into windows
This commit is contained in:
commit
15af92291f
2 changed files with 23 additions and 21 deletions
|
@ -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
16
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__
|
||||
|
|
Loading…
Reference in a new issue