avoid false positives when detecting core.symlinks=false symlink standin files
If the file is > 8192 bytes, it's certianly not a symlink file. And if it contains nuls or newlines or whitespace, it's certianly not a link to annexed content. But it might be a tarball containing a git-annex repo.
This commit is contained in:
parent
ae341c1a37
commit
ecdfa40cbe
1 changed files with 19 additions and 5 deletions
|
@ -29,8 +29,7 @@ isAnnexLink file = maybe Nothing (fileKey . takeFileName) <$> getAnnexLinkTarget
|
|||
{- Gets the link target of a symlink.
|
||||
-
|
||||
- On a filesystem that does not support symlinks, fall back to getting the
|
||||
- link target by looking inside the file. (Only return first 8k of the
|
||||
- file, more than enough for any symlink target.)
|
||||
- link target by looking inside the file.
|
||||
-
|
||||
- Returns Nothing if the file is not a symlink, or not a link to annex
|
||||
- content.
|
||||
|
@ -38,7 +37,7 @@ isAnnexLink file = maybe Nothing (fileKey . takeFileName) <$> getAnnexLinkTarget
|
|||
getAnnexLinkTarget :: FilePath -> Annex (Maybe LinkTarget)
|
||||
getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
|
||||
( check readSymbolicLink $
|
||||
check readfilestart $
|
||||
check probefilecontent $
|
||||
return Nothing
|
||||
, check readSymbolicLink $
|
||||
return Nothing
|
||||
|
@ -52,11 +51,26 @@ getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
|
|||
| otherwise -> return Nothing
|
||||
Nothing -> fallback
|
||||
|
||||
readfilestart f = do
|
||||
probefilecontent f = do
|
||||
h <- openFile f ReadMode
|
||||
fileEncoding h
|
||||
-- The first 8k is more than enough to read; link
|
||||
-- files are small.
|
||||
s <- take 8192 <$> hGetContents h
|
||||
length s `seq` (hClose h >> return s)
|
||||
-- If we got the full 8k, the file is too large
|
||||
if length s == 8192
|
||||
then do
|
||||
hClose h
|
||||
return ""
|
||||
else do
|
||||
hClose h
|
||||
-- If there are any NUL or newline
|
||||
-- characters, or whitespace, we
|
||||
-- certianly don't have a link to a
|
||||
-- git-annex key.
|
||||
if any (`elem` s) "\0\n\r \t"
|
||||
then return ""
|
||||
else return s
|
||||
|
||||
{- Creates a link on disk.
|
||||
-
|
||||
|
|
Loading…
Reference in a new issue