hasufell
/
ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Make readDirEntPortable more robust

This commit is contained in:
Julian Ospald 2023-02-11 18:51:34 +08:00
parent 895e4b3f18
commit 6d3e8d65e1
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
lib/GHCup/Prelude/File/Posix/Traversals.hsc
View File

@ -117,7 +117,15 @@ readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
(dt, fp) <- readDirEnt dirs
case (dt, fp) of
(DirType #{const DT_UNKNOWN}, _)
(DirType #{const DT_BLK}, _) -> pure (dt, fp)
(DirType #{const DT_CHR}, _) -> pure (dt, fp)
(DirType #{const DT_DIR}, _) -> pure (dt, fp)
(DirType #{const DT_FIFO}, _) -> pure (dt, fp)
(DirType #{const DT_LNK}, _) -> pure (dt, fp)
(DirType #{const DT_REG}, _) -> pure (dt, fp)
(DirType #{const DT_SOCK}, _) -> pure (dt, fp)
(DirType #{const DT_UNKNOWN}, _) -> pure (dt, fp)
(_, _)
| fp /= "" -> do
stat <- getSymbolicLinkStatus (basedir </> fp)
pure $ (, fp) $ if | isBlockDevice stat -> DirType #{const DT_BLK}
@ -128,5 +136,4 @@ readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
| isRegularFile stat -> DirType #{const DT_REG}
| isSocket stat -> DirType #{const DT_SOCK}
| otherwise -> DirType #{const DT_UNKNOWN}
_ -> pure (dt, fp)