LogFollower.hs

{-# LANGUAGE ScopedTypeVariables #-}

module LogFollower where

import           Control.Concurrent (threadDelay)
import           Control.Exception
import           Data.ByteString.Char8 as BS
import           Data.ByteString.Lazy  as BL
import           Data.IORef
import           Data.Function(fix)
import           Data.Monoid
import qualified System.IO as IO
import           System.IO.Error (isDoesNotExistError)

import           System.IO.Streams (InputStream)
import qualified System.IO.Streams as Streams

import qualified System.Linux.Inotify as IN

follow :: FilePath -> Int -> IO (InputStream BS.ByteString)
follow fp bufferSize = do
    infd <- IN.init
    let openFile = do
          mh <- do
                   -- WARNING:   There is a race condition below,  namely
                   -- there is some risk that we open the file,  the file
                   -- is moved or unlinked and a new file is created
                   -- with the same path, and then we start watching
                   -- the new file.   So we end up reading from one 
                   -- inode and watching another for modifications.

                   h <- IO.openFile fp IO.ReadMode
                   wd <- IN.addWatch infd fp
                              (mconcat [IN.in_MOVE_SELF, IN.in_MODIFY])
                   return $! Just $! (h,wd)
                `catch` \(err :: IOError) ->
                   if isDoesNotExistError err
                   then return Nothing
                   else throwIO err
          case mh of
            Nothing -> threadDelay 1000000 >> openFile
            Just h  -> return h
    hwdRef <- newIORef =<< openFile
    Streams.makeInputStream $ fix $ \getBuffer -> do
      (h,wd) <- readIORef hwdRef
      buffer <- BS.hGet h bufferSize
      if not (BS.null buffer)
      then return $! Just buffer
      else fix $ \getEvent -> do
        event <- IN.getEvent infd
        if IN.wd event == wd
        then if IN.hasOverlap (IN.mask event) (IN.in_MODIFY)
             then fix $ \clearEvents -> do
                    mEvent <- IN.peekEventFromBuffer infd
                    case mEvent of
                      Just event |    (IN.wd event /= wd)
                                   || IN.hasOverlap (IN.mask event)
                                                    (IN.in_MODIFY)  -> do
                         _ <- IN.getEventFromBuffer infd
                         clearEvents
                      _ -> getBuffer
             else if IN.hasOverlap (IN.mask event)
                                   (IN.in_MOVE_SELF <> IN.in_IGNORED)
                  then do
                    IO.hClose h
                    IN.rmWatch infd wd
                    writeIORef hwdRef =<< openFile
                    getBuffer
                  else getEvent
        -- FIXME: handle IN.in_Q_OVERFLOW
        else getEvent