audit2.hs

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE BangPatterns #-}


import System.PosixCompat.Files
import System.PosixCompat.Types (DeviceID)
import Control.Exception (bracket_, evaluate, catch, handle, try, IOException)

import Control.Concurrent
import Control.Concurrent.Chan
import Control.Concurrent.MVar

import System.Directory

import Control.Monad
import System.FilePath

import qualified Data.HashSet as Set

import Data.Maybe
import Data.List

import Debug.Trace

data FileType = File !Int | Directory | Other

getFT dev f = do
  s <- getSymbolicLinkStatus f
  return
    if | deviceID s == dev && isRegularFile s -> File (fromIntegral $ fileID s)
       | deviceID s == dev && isDirectory   s -> Directory
       | otherwise                            -> Other

walkDirectories :: Set.HashSet Int -> DeviceID -> FilePath -> IO ()
walkDirectories inodes dev = go
  where
    go :: FilePath -> IO ()
    go !f = do
      e <- try $ getFT dev f
      case e of
        Left (_ :: IOException) -> return ()
        Right (File inum)          -> processInum inodes inum f
        Right Other             -> return ()
        Right Directory         -> do
          fs <- listDirectory f
          forM_ fs  (\(!f') -> go $! f </> f')

processInum inodes inum path = do
     when (inum `Set.member` inodes) $ do
              putStrLn path

buildInodesSet = do
  file <- readFile "/type_errors.log"
  return $ Set.fromList $ map entry2Inode $ lines file
  where
    entry2Inode :: String -> Int
    entry2Inode v = read . takeWhile (/= ':') . fromJust $ stripPrefix "u64s 5 type error " v

main = do
  let path = "/"
  inodes    <- buildInodesSet
  dev       <- deviceID <$> getFileStatus path


  walkDirectories inodes dev path