ztail 1.0.2 → 1.1
raw patch · 6 files changed
+338/−184 lines, 6 filesdep +containersdep +filepathdep ~hinotify
Dependencies added: containers, filepath
Dependency ranges changed: hinotify
Files
- LICENSE +26/−0
- Main.hs +128/−86
- TailHandle.hs +148/−81
- TailTypes.hs +29/−13
- Util.hs +2/−0
- ztail.cabal +5/−4
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2004-2012, Dylan Simon+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
Main.hs view
@@ -8,7 +8,7 @@ import qualified System.IO.Error import qualified Control.Concurrent import qualified Control.Exception-import qualified Data.IORef+import Data.IORef import qualified Text.Regex #ifdef INOTIFY import qualified System.INotify as INotify@@ -20,30 +20,34 @@ import Tail import TailHandle -data Options = Options{- optionTails :: [Tail],- optionTail :: Tail,- optionMatch :: TailMatch-}+data Options = Options+ { optionTails :: [Tail]+ , optionTail :: Tail+ , optionMatch :: TailMatch+ } -defaultTail = Tail{- tailTarg = undefined, -- read "-",- tailPollInterval = read "5",- tailReopenInterval = read "0",+defaultTail = Tail+ { tailTarg = undefined -- read "-"+ , tailPollInterval = 5+ , tailReopenInterval = 0 #ifdef INOTIFY- tailPollINotify = True,- tailReopenINotify = False,+ , tailPollINotify = True+ , tailReopenINotify = False #endif- tailBegin = False,- tailTimeFmt = "%c",- tailMatches = []-}+ , tailBegin = False+ , tailFileTail = True+ , tailDirTail = False+ , tailDirList = False+ , tailDirRecursive = False+ , tailTimeFmt = "%c"+ , tailMatches = []+ } -defaultOptions = Options{- optionTails = [],- optionTail = defaultTail,- optionMatch = MatchAll-}+defaultOptions = Options+ { optionTails = []+ , optionTail = defaultTail+ , optionMatch = MatchAll+ } set_opt :: (Tail -> Tail) -> Options -> Options set_opt p o = o{ optionTail = p $ optionTail o }@@ -58,7 +62,7 @@ prog_header = "Usage: ztail [OPTIONS] FILE ...\n\ Follow the specified files (ala tail -f). FILE may be a path, '-' for stdin,\n\ or '&N' for file descriptor N. OPTIONS apply only to the following FILE\n\-(except for -irt), and match options (-amn) apply to all following actions\n\+except those marked *, and match options (-amn) apply to all following actions\n\ (-hcdse). Actions involving TEXT can contain the following \\-escapes:\n\ \\0 current file \\@ current time (from -t)\n\ \\_ current line \\` \\' pre- and post-matching text\n\@@ -67,89 +71,122 @@ prog_usage = GetOpt.usageInfo prog_header prog_options prog_options :: [GetOpt.OptDescr (Options -> Options)]-prog_options = [- GetOpt.Option "b" ["begin"]- (GetOpt.NoArg (set_opt $ \p -> p{ tailBegin = True }))- ("start reading at the beginning of the file (rather than only new lines at the end)"),- GetOpt.Option "i" ["interval"]- (GetOpt.ReqArg (\i -> set_opt $ \p -> p{ tailPollInterval = read i }) "INT")- ("poll for data every INT seconds [" ++ show (tailPollInterval defaultTail) ++ "] on all following files"),- GetOpt.Option "r" ["reopen"]- (GetOpt.OptArg (\i -> set_opt $ \p -> p{ tailReopenInterval = maybe (tailPollInterval p) read i }) "INT")- ("check file name (like tail -F) every INT seconds or every poll"),- GetOpt.Option "t" ["timefmt"]- (GetOpt.ReqArg (\t -> set_opt $ \p -> p{ tailTimeFmt = t }) "FMT")- ("set time format for \\@ substitution (in strftime(3)) [" ++ tailTimeFmt defaultTail ++ "]"),- GetOpt.Option "T" ["timestamp"]- (GetOpt.OptArg (maybe id $ \t -> add_action (ActionSubst "\\@ \\_") . set_opt (\p -> p{ tailTimeFmt = t })) "FMT")- ("timestamp with FMT; equivalent to: [-t FMT] -h '\\@ '"),+prog_options = + [ GetOpt.Option "i" ["interval"]+ (GetOpt.ReqArg (\i -> set_opt $ \p -> p+ { tailPollInterval = read i #ifdef INOTIFY- GetOpt.Option "I" ["inotify"]- (GetOpt.NoArg (set_opt $ \p -> p{ tailPollINotify = True, tailPollInterval = read "0" }))- ("use inotify to poll for new data (only for regular files)"),- GetOpt.Option "R" ["ireopen"]- (GetOpt.NoArg (set_opt $ \p -> p{ tailReopenINotify = True }))- ("use inotify to monitor file renames (only for preexisting, leaf files)"),+ , tailPollINotify = False #endif+ }) "INT")+ ("*poll for data every INT seconds [" ++ show (tailPollInterval defaultTail) ++ "]")+ , GetOpt.Option "r" ["reopen"]+ (GetOpt.OptArg (\i -> set_opt $ \p -> p+ { tailReopenInterval = maybe (tailPollInterval p) read i+#ifdef INOTIFY+ , tailReopenINotify = False+#endif+ }) "INT")+ ("*check file name (like tail -F) every INT seconds or every poll [" ++ show (tailReopenInterval defaultTail) ++ "]")+#ifdef INOTIFY+ , GetOpt.Option "I" ["inotify"]+ (GetOpt.OptArg (\i -> set_opt $ \p -> p+ { tailPollINotify = True+ , tailPollInterval = maybe 0 read i }) "INT")+ ("*use inotify to poll for new data (and also poll every INT)")+ , GetOpt.Option "R" ["ireopen"]+ (GetOpt.NoArg (set_opt $ \p -> p+ { tailReopenINotify = True }))+ ("*use inotify to monitor file renames (only for preexisting, leaf files)")+#endif+ , GetOpt.Option "b" ["begin"]+ (GetOpt.NoArg (set_opt $ \p -> p+ { tailBegin = True }))+ (" start reading at the beginning of the file (rather than only new lines at the end)")+ , GetOpt.Option "l" ["dirlist"]+ (GetOpt.NoArg (set_opt $ \p -> p+ { tailDirList = True }))+ (" watch the contents of a directory, reporting when files are added or removed")+ , GetOpt.Option "D" ["dirtail"]+ (GetOpt.NoArg (set_opt $ \p -> p+ { tailDirTail = True }))+ (" tail all the files in a directory")+ , GetOpt.Option "A" ["recursive"]+ (GetOpt.NoArg (set_opt $ \p -> p+ { tailDirRecursive = True }))+ (" apply the above directory modifiers recursively") - GetOpt.Option "a" ["all"]+ , GetOpt.Option "t" ["timefmt"]+ (GetOpt.ReqArg (\t -> set_opt $ \p -> p+ { tailTimeFmt = t }) "FMT")+ ("*set time format for \\@ substitution (in strftime(3)) [" ++ tailTimeFmt defaultTail ++ "]")+ , GetOpt.Option "T" ["timestamp"]+ (GetOpt.OptArg (maybe id $ \t -> add_action (ActionSubst "\\@ \\_") . set_opt (\p -> p+ { tailTimeFmt = t })) "FMT")+ (" timestamp with FMT; equivalent to: [-t FMT] -h '\\@ '")++ , GetOpt.Option "a" ["all"] (GetOpt.NoArg (set_match MatchAll))- ("perform following action for every line from this FILE (default)"),- GetOpt.Option "m" ["match"]+ (" perform following action for every line from this FILE (default)")+ , GetOpt.Option "m" ["match"] (GetOpt.ReqArg (\m -> set_match $ MatchRegex $ Text.Regex.mkRegexWithOpts m False True) "REGEX")- ("perform following action for each line matching REGEX"),- GetOpt.Option "M" ["imatch"]+ (" perform following action for each line matching REGEX")+ , GetOpt.Option "M" ["imatch"] (GetOpt.ReqArg (\m -> set_match $ MatchRegex $ Text.Regex.mkRegexWithOpts m False False) "REGEX")- ("perform following action for each line matching REGEX (case-insensitive)"),- GetOpt.Option "n" ["no-match"]+ (" perform following action for each line matching REGEX (case-insensitive)")+ , GetOpt.Option "n" ["no-match"] (GetOpt.ReqArg (\m -> set_match $ MatchNotRegex $ Text.Regex.mkRegexWithOpts m False True) "REGEX")- ("perform following action for each line not matching REGEX"),- GetOpt.Option "N" ["no-imatch"]+ (" perform following action for each line not matching REGEX")+ , GetOpt.Option "N" ["no-imatch"] (GetOpt.ReqArg (\m -> set_match $ MatchNotRegex $ Text.Regex.mkRegexWithOpts m False False) "REGEX")- ("perform following action for each line not matching REGEX (case-insensitive)"),+ (" perform following action for each line not matching REGEX (case-insensitive)") - GetOpt.Option "h" ["header"]+ , GetOpt.Option "h" ["header"] (GetOpt.ReqArg (\h -> add_action $ ActionSubst (h ++ "\\_")) "TEXT")- ("display TEXT header before (matching) lines (same as -s 'TEXT\\_')"),- GetOpt.Option "c" ["color"]+ (" display TEXT header before (matching) lines (same as -s 'TEXT\\_')")+ , GetOpt.Option "c" ["color"] (GetOpt.ReqArg (\c -> add_action $ ActionColor $ parseColor c) "COLOR")- ("display (matching) lines in COLOR (valid colors are: normal, bo,ul,bl,rev, nobo,noul..., black,red,green,yellow,blue,magenta,cyan,white, /black,/red,...)"),- GetOpt.Option "d" ["hide"]+ (" display (matching) lines in COLOR (valid colors are: normal, bo,ul,bl,rev, nobo,noul..., black,red,green,yellow,blue,magenta,cyan,white, /black,/red,...)")+ , GetOpt.Option "d" ["hide"] (GetOpt.NoArg (add_action ActionHide))- ("hide (matching) lines"),- GetOpt.Option "s" ["substitute"]+ (" hide (matching) lines")+ , GetOpt.Option "s" ["substitute"] (GetOpt.ReqArg (\s -> add_action $ ActionSubst s) "TEXT")- ("substitute (matching) lines with TEXT"),- GetOpt.Option "e" ["execute"]+ (" substitute (matching) lines with TEXT")+ , GetOpt.Option "e" ["execute"] (GetOpt.ReqArg (\e -> add_action $ ActionExecute e) "PROG")- ("execute PROG for every (matching) line")+ (" execute PROG for every (matching) line") ]-prog_arg a Options{ optionTails = l, optionTail = t } =- Options{- optionTails = t{- tailTarg = read a,- tailMatches = reverse (tailMatches t)- } : l,- optionTail = t{- tailBegin = False,- tailMatches = []- },- optionMatch = MatchAll+prog_arg a Options{ optionTails = l, optionTail = t } = Options+ { optionTails = t+ { tailTarg = read a+ , tailMatches = reverse (tailMatches t)+ } : l+ , optionTail = t+ { tailBegin = False+ , tailMatches = []+ , tailDirList = False+ , tailDirTail = False+ , tailDirRecursive = False+ }+ , optionMatch = MatchAll } run :: [Tail] -> IO (Control.Concurrent.MVar ExitCode) run tails = do emv <- Control.Concurrent.newEmptyMVar let exit = Control.Concurrent.putMVar emv- let exit0 = exit ExitSuccess- let exit1 = exit (ExitFailure 1)+ exit0 = exit ExitSuccess+ exit1 = exit (ExitFailure 1) installHandler sigINT (CatchOnce exit0) Nothing lockv <- Control.Concurrent.newQSem 0 let lock = Control.Exception.bracket_ (Control.Concurrent.waitQSem lockv) (Control.Concurrent.signalQSem lockv)- let unlock = Control.Exception.bracket_ (Control.Concurrent.signalQSem lockv) (Control.Concurrent.waitQSem lockv)+ unlock = Control.Exception.bracket_ (Control.Concurrent.signalQSem lockv) (Control.Concurrent.waitQSem lockv)+ incr r = atomicModifyIORef r (\i -> (succ i, ())) - count <- Data.IORef.newIORef (length tails)+ count <- newIORef (length tails)+ errors <- newIORef 0 #ifdef INOTIFY inotify <- catchWhen ((GHC.IO.Exception.UnsupportedOperation ==) . System.IO.Error.ioeGetErrorType)@@ -159,19 +196,24 @@ let error t e = case Control.Exception.fromException e of Just Control.Exception.UserInterrupt -> exit0- _ -> tailErrMsg t (show e) >> exit1- runt = runTail TailRuntime+ _ -> tailErrMsg t (show e) >> incr errors+ tr = TailRuntime { trText = tailText+ , trAddTail = (incr count >>) . runt , trUnlock = unlock #ifdef INOTIFY , trINotify = inotify #endif }- mapM_ (\t -> Control.Concurrent.forkIO $ lock $ Control.Exception.handle (error t) $ do- runt t- i <- Data.IORef.atomicModifyIORef count (\i -> (pred i, i))- when (i == 1) exit0)- tails+ runt t = void $ Control.Concurrent.forkIO $ lock $ do+ Control.Exception.handle (error t) $ runTail tr t+ i <- atomicModifyIORef count (\i -> (pred i, i))+ when (i == 1) $ do+ e <- readIORef errors+ if e > 0+ then exit1+ else exit0+ mapM_ runt tails Control.Concurrent.signalQSem lockv return emv
TailHandle.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface #-} module TailHandle ( runTail ) where@@ -6,9 +6,12 @@ import Control.Monad import System.Posix.Types import System.Posix.Files+import System.Posix.Directory import System.Posix.IO import System.IO.Error-import Data.Maybe (fromJust)+import Data.List (genericTake, genericLength)+import Data.Maybe+import qualified Data.Set as Set import GHC.IO.Handle (SeekMode(AbsoluteSeek)) import Control.Concurrent import qualified Control.Exception@@ -17,29 +20,39 @@ import qualified System.INotify as INotify #endif import Data.IORef+import Foreign.Ptr (Ptr)+import Foreign.C.Types (CInt(..))+import Foreign.C.Error (throwErrnoIfNull)+import qualified Unsafe.Coerce+import System.FilePath ((</>)) import Util import TailTypes -data TailHandle = TailHandle{- thTail :: Tail,- thRuntime :: TailRuntime,- thPoll :: ThreadId,- thReopen :: Maybe ThreadId,- thFd :: Maybe Fd,- thPos :: FileOffset,- thIno :: Maybe FileID,- thBuf :: String,- thAgain :: Bool,+data TailHandle = TailHandle+ { thTail :: Tail+ , thRuntime :: TailRuntime+ , thPoll :: ThreadId+ , thReopen :: Maybe ThreadId+ , thFd :: Maybe Fd+ , thPos :: FileOffset -- or -1 for blocking fd+ , thIno :: Maybe FileID+ , thBuf :: String+ , thDirStream :: Maybe DirStream+ , thDirList :: Set.Set FilePath+ , thAgain :: Bool #ifdef INOTIFY- thPollWatch :: Maybe INotify.WatchDescriptor,- thReopenWatch :: Maybe INotify.WatchDescriptor,+ , thPollWatch :: Maybe INotify.WatchDescriptor+ , thReopenWatch :: Maybe INotify.WatchDescriptor #endif- thSigPending :: IORef (Maybe TailSignal),- thSigHandler :: IO () -> IO ()-}+ } -data TailSignal = PollSignal | ReopenSignal deriving (Show, Data.Typeable.Typeable, Eq, Ord)+data TailSignal + = SignalPoll + | SignalReopen + | SignalInsert String Bool+ | SignalDelete String+ deriving (Show, Data.Typeable.Typeable, Eq, Ord) instance Control.Exception.Exception TailSignal thErrMsg = tailErrMsg . thTail@@ -78,20 +91,31 @@ inotifyTail :: TailHandle -> IO TailHandle #ifdef INOTIFY-inotifyTail th@TailHandle{ - thRuntime = TailRuntime{ trINotify = Just inotify },- thPoll = tid,- thTail = Tail{- tailTarg = TailPath path,- tailPollINotify = ipoll,- tailReopenINotify = ireopen+inotifyTail th@TailHandle+ { thRuntime = TailRuntime{ trINotify = Just inotify }+ , thPoll = tid+ , thPos = pos+ , thTail = Tail+ { tailTarg = TailPath path+ , tailPollINotify = ipoll+ , tailReopenINotify = ireopen } } = do- poll <- justWhen ipoll $- INotify.addWatch inotify [INotify.Modify] path - (\_ -> Control.Exception.throwTo tid PollSignal)- reopen <- justWhen ireopen $- INotify.addWatch inotify [INotify.MoveSelf] path - (\_ -> Control.Exception.throwTo tid ReopenSignal)+ let sig (INotify.Modified {}) = Just SignalPoll+ sig (INotify.MovedSelf {}) = Just SignalReopen+ sig (INotify.MovedOut { INotify.filePath = f }) | notdot f = Just $ SignalDelete f+ sig (INotify.MovedIn { INotify.filePath = f }) | notdot f = Just $ SignalInsert f False+ sig (INotify.Created { INotify.filePath = f }) | notdot f = Just $ SignalInsert f True+ sig (INotify.Deleted { INotify.filePath = f }) | notdot f = Just $ SignalDelete f+ sig _ = Nothing+ notdot "" = False+ notdot ('.':_) = False+ notdot _ = True+ add l = INotify.addWatch inotify l path (whenJust (Control.Exception.throwTo tid) . sig)+ poll <- justWhen (ipoll && pos >= 0) $+ if isJust (thDirStream th)+ then add [INotify.OnlyDir, INotify.Move, INotify.Create, INotify.Delete]+ else add [INotify.Modify]+ reopen <- justWhen ireopen $ add [INotify.MoveSelf, INotify.DeleteSelf] return th{ thPollWatch = poll, thReopenWatch = reopen@@ -99,6 +123,27 @@ #endif inotifyTail th = return th +foreign import ccall unsafe fdopendir :: CInt -> IO (Ptr ())+fdOpenDirStream :: Fd -> IO DirStream+fdOpenDirStream (Fd d) = (Unsafe.Coerce.unsafeCoerce :: Ptr () -> DirStream) =.< throwErrnoIfNull "fdOpenDirStream" (fdopendir d)++readDirStreamAll :: DirStream -> IO [FilePath]+readDirStreamAll d = readDirStream d >>= c where+ c [] = return []+ c ('.':_) = readDirStreamAll d+ c f = (f :) =.< readDirStreamAll d++subTail :: TailHandle -> Bool -> FilePath -> IO ()+subTail th@TailHandle{ thRuntime = tr, thTail = t@Tail{ tailTarg = TailPath p } } new f | tailDirTail t || tailDirList t =+ trAddTail tr t+ { tailTarg = TailPath (p </> f)+ , tailFileTail = tailDirTail t+ , tailDirList = tailDirList t && tailDirRecursive t+ , tailDirTail = tailDirTail t && tailDirRecursive t+ , tailBegin = tailBegin t || new+ }+subTail _ _ _ = nop+ openTail :: TailHandle -> IO TailHandle openTail th@TailHandle{ thFd = Nothing } = get (tailTarg (thTail th)) where get (TailFd fd) = got (Just fd)@@ -110,16 +155,23 @@ got Nothing = thErrMsg th "No such file or directory" >. th{ thPos = 0 } got (Just fd) = do setFdOption fd NonBlockingRead True- go fd =<< getFdStatus fd+ inotifyTail =<< go fd =<< getFdStatus fd go fd stat- | isBlockDevice stat || isDirectory stat || isSymbolicLink stat =- closeFd fd >> bad "unsupported file type" | isRegularFile stat =- inotifyTail th' >>= seekTail (if pos < 0 then max 0 $ sz + 1 + pos else min sz pos)- | otherwise =+ seekTail (if pos < 0 then max 0 $ sz + 1 + pos else min sz pos) th'+ | isNamedPipe stat || isSocket stat || isCharacterDevice stat = return th'{ thPos = -1 }+ | isDirectory stat && (tailDirList (thTail th) || tailDirTail (thTail th)) = do+ ds <- fdOpenDirStream fd+ dl <- readDirStreamAll ds+ let nl = genericTake (if pos < 0 then genericLength dl + 1 + pos else pos) dl+ th'' = th'{ thDirStream = Just ds, thDirList = Set.fromList nl }+ mapM_ (subTail th'' False) nl+ return th''+ | otherwise =+ closeFd fd >> thErrMsg th "Unsupported file type" >. th where- th' = th{ thFd = Just fd, thIno = Just (fileID stat), thAgain = True }+ th' = th{ thFd = Just fd, thIno = Just (fileID stat), thAgain = True, thPos = 0 } sz = fileSize stat pos = thPos th openTail _ = bad "open on opened tail"@@ -143,8 +195,23 @@ bufsiz :: ByteCount bufsiz = 8192 +insertMsg :: String -> String+insertMsg = ('+':)++deleteMsg :: String -> String+deleteMsg = ('-':)+ readTail :: TailHandle -> IO (TailHandle, [String]) readTail th@TailHandle{ thFd = Nothing } = return (noRead th)+readTail th@TailHandle{ thDirStream = Just ds } = do+ dl <- rewindDirStream ds >> readDirStreamAll ds+ let df f (n, o, s) + | Set.member f o = (n, Set.delete f o, s)+ | otherwise = (f : n, o, Set.insert f s)+ (nl, os, ds) = foldr df ([], thDirList th, thDirList th) dl+ mapM_ (subTail th True) nl+ return (th{ thDirList = Set.difference ds os, thAgain = False },+ guard (tailDirList (thTail th)) >> map insertMsg nl ++ map deleteMsg (Set.toList os)) readTail th@TailHandle{ thFd = Just fd, thPos = pos } = if pos == -1 then catchWhen isEOFError readsock $ do@@ -188,63 +255,59 @@ waitTail :: TailHandle -> IO () waitTail TailHandle{ thFd = Nothing } = pause waitTail TailHandle{ thFd = Just fd, thPos = -1 } = threadWaitRead fd-waitTail TailHandle{ thTail = t, thAgain = again } = do- if again- then yield - else if i == 0- then pause- else threadDelay i- where - i = fromInterval (tailPollInterval t)+waitTail TailHandle{ thAgain = True } = yield+waitTail TailHandle{ thTail = Tail{ tailPollInterval = i } }+ | i == 0 = pause+ | otherwise = threadDelay (fromInterval i) reopenThread :: Int -> ThreadId -> IO () reopenThread ri tid = forever $ do threadDelay ri- Control.Exception.throwTo tid ReopenSignal+ Control.Exception.throwTo tid SignalReopen newTail :: TailRuntime -> Tail -> IO TailHandle newTail tr tail = do tid <- myThreadId rid <- justWhen (ri /= 0) $ forkIO (reopenThread ri tid)- sigpend <- newIORef Nothing- return TailHandle{- thTail = tail,- thRuntime = tr,- thPoll = tid,- thReopen = rid,- thFd = Nothing,- thPos = if tailBegin tail then 0 else -1,- thIno = Nothing,- thBuf = [],- thAgain = True,+ return TailHandle+ { thTail = tail+ , thRuntime = tr+ , thPoll = tid+ , thReopen = rid+ , thFd = Nothing+ , thPos = if tailBegin tail then 0 else -1+ , thIno = Nothing+ , thBuf = []+ , thDirStream = Nothing+ , thDirList = Set.empty+ , thAgain = True #ifdef INOTIFY- thPollWatch = Nothing,- thReopenWatch = Nothing,+ , thPollWatch = Nothing+ , thReopenWatch = Nothing #endif- thSigPending = sigpend,- thSigHandler = Control.Exception.handle (\s ->- modifyIORef sigpend (max (Just s)))- }+ } where ri = fromInterval (tailReopenInterval tail) runTail :: TailRuntime -> Tail -> IO ()-runTail tr tail = Control.Exception.block $- newTail tr tail >>=- openTail >>= go >>= - \TailHandle{ thReopen = wid } -> whenJust killThread wid- where- catch th ReopenSignal = reopenTail th -- >>= wait- catch th PollSignal = return th- wait th = do- sig <- readIORef (thSigPending th)- writeIORef (thSigPending th) Nothing- maybe - (Control.Exception.catch- (trUnlock tr $ waitTail th >. th) - (catch th))- (catch th)- sig+runTail tr tail = Control.Exception.mask $ \unmask ->+ let+ catch th SignalReopen = reopenTail th -- >>= wait+ catch th SignalPoll = return th{ thAgain = True }+ catch th@TailHandle{ thDirStream = Just _, thDirList = l, thTail = t } (SignalInsert f new) = do+ subTail th new f+ if tailDirList t+ then proc th' [insertMsg f]+ else return th'+ where th' = th{ thDirList = Set.insert f l }+ catch th@TailHandle{ thDirStream = Just _, thDirList = l, thTail = t } (SignalDelete f) = + if tailDirList t + then proc th' [deleteMsg f]+ else return th'+ where th' = th{ thDirList = Set.delete f l }+ wait th = Control.Exception.catch+ (trUnlock tr $ unmask $ waitTail th >. th) + (catch th >=> wait) poll th | thReopen th == Nothing && (thFd th == Nothing@@ -257,6 +320,10 @@ )) = return th | otherwise = wait th >>= go- go th = readTail th >>= proc >>= poll- proc (th, s) = mapM_ (thSigHandler th . fun) s >. th+ go th = readTail th >>= uncurry proc >>= poll+ proc th s = mapM_ fun s >. th fun = (trText tr) tail+ in+ newTail tr tail >>=+ openTail >>= go >>= + \TailHandle{ thReopen = wid } -> whenJust killThread wid
TailTypes.hs view
@@ -19,12 +19,21 @@ import Display -newtype Interval = Interval Int+newtype Interval = Interval { fromInterval :: Int } deriving (Eq, Ord) instance Show Interval where- show (Interval x) = show (fromIntegral x / 1000000.0)+ show (Interval x) + | x `mod` 1000000 == 0 = show (x `div` 1000000)+ | otherwise = show (fromIntegral x / 1000000.0) instance Read Interval where readsPrec n s = map (\(x,s) -> (Interval $ floor (1000000.0 * x), s)) $ readsPrec n s-fromInterval (Interval x) = x+instance Num Interval where+ Interval x + Interval y = Interval (x + y)+ Interval x * Interval y = Interval (x * y)+ Interval x - Interval y = Interval (x - y)+ negate (Interval x) = Interval (negate x)+ abs (Interval x) = Interval (abs x)+ signum (Interval x) = Interval (signum x)+ fromInteger n = Interval (fromInteger $ 1000000 * n) data TailTarget = TailPath !FilePath | TailFd !System.Posix.Types.Fd instance Show TailTarget where@@ -48,26 +57,33 @@ | ActionExecute !String type TailMatches = [(TailMatch, TailAction)] -data Tail = Tail{- tailTarg :: TailTarget,- tailPollInterval :: !Interval,- tailReopenInterval :: !Interval,+data Tail = Tail+ { tailTarg :: TailTarget+ , tailPollInterval :: !Interval+ , tailReopenInterval :: !Interval #ifdef INOTIFY- tailPollINotify :: !Bool,- tailReopenINotify :: !Bool,+ , tailPollINotify :: !Bool+ , tailReopenINotify :: !Bool #endif- tailBegin :: !Bool,- tailTimeFmt :: !String,- tailMatches :: !TailMatches-}+ , tailBegin :: !Bool -- start at beginning of file+ , tailFileTail :: !Bool -- enable this tail for non-directories (almost always True)+ , tailDirTail :: !Bool -- tail immediate children+ , tailDirList :: !Bool -- enable this tail for directory content+ , tailDirRecursive :: !Bool -- tail children recursively+ , tailTimeFmt :: !String+ , tailMatches :: !TailMatches+ } +tailName :: Tail -> String tailName = show . tailTarg +tailErrMsg :: Tail -> String -> IO () tailErrMsg t msg = errMsg ("ztail " ++ tailName t ++ ": " ++ msg) data TailRuntime = TailRuntime { trUnlock :: forall a. IO a -> IO a+ , trAddTail :: Tail -> IO () , trText :: Tail -> String -> IO () #ifdef INOTIFY , trINotify :: Maybe INotify.INotify
Util.hs view
@@ -47,9 +47,11 @@ nop :: Monad m => m () nop = return () +-- Data.Foldable.mapM_ whenJust :: Monad m => (a -> m ()) -> Maybe a -> m () whenJust = maybe nop +-- (>.) . guard justIf :: Bool -> a -> Maybe a justIf False = const Nothing justIf True = Just
ztail.cabal view
@@ -1,8 +1,9 @@ Name: ztail-Version: 1.0.2+Version: 1.1 Author: Dylan Simon Maintainer: dylan@dylex.net License: BSD3+License-File: LICENSE Synopsis: Multi-file, colored, filtered log tailer. Description: An even more improved version of xtail/tail -f, including inotify support, full regex-based filtering, substitution, and colorization. Category: System,Console@@ -13,7 +14,7 @@ Source-Repository head Type: darcs- Location: http://dylex.net/src/ztail+ Location: http://hub.darcs.net/dylex/ztail Flag INotify Description: Enable inotify support@@ -22,7 +23,7 @@ Executable ztail Main-is: Main.hs Other-Modules: Util, Display, TailTypes, TailHandle, Tail- Build-Depends: base == 4.*, regex-compat, unix, time, old-locale, process, array+ Build-Depends: base == 4.*, regex-compat, unix, time, old-locale, process, array, containers, filepath if flag(inotify)- Build-Depends: hinotify == 0.3.2+ Build-Depends: hinotify >= 0.3.6 CPP-Options: -DINOTIFY