diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -3,6 +3,7 @@ import System.Environment (getArgs) import System.Console.GetOpt +import System.Posix.Daemon import Data.List import Control.Monad import Filesystem.Path.CurrentOS hiding (concat, null) @@ -20,47 +21,69 @@ data Options = Options { optShowVersion :: Bool , optCommands :: [String] - , optPatterns :: [String] + , optPatterns :: [String] , optDirectory :: FilePath + , optIsDaemon :: Bool + , optDaemonCmd :: String } deriving (Show, Eq) defaultOptions :: Options defaultOptions = Options { optShowVersion = False - , optCommands = [] - , optPatterns = [] - , optDirectory = fromText $ T.pack "." + , optCommands = [] + , optPatterns = [] + , optDirectory = fromText $ T.pack "." + , optIsDaemon = False + , optDaemonCmd = "start" } options :: [OptDescr (Options -> Options)] options = [ Option "v" ["version"] (NoArg (\opts -> opts { optShowVersion = True })) - "show version info" + "Show version info." , Option "c" ["command"] - (ReqArg (\c opts -> opts { optCommands = optCommands opts ++ [c] }) "COMMAND") - "add command to run on file event" + (ReqArg (\c opts -> opts { optCommands = optCommands opts ++ [c] }) "command") + "Add command to run on file event." , Option "p" ["pattern"] - (ReqArg (\e opts -> opts { optPatterns = optPatterns opts ++ [e] }) "PATTERN") - "add pattern to match on file path" + (ReqArg (\e opts -> opts { optPatterns = optPatterns opts ++ [e] }) "pattern") + "Add pattern to match on file path." , Option "d" ["directory"] - (ReqArg (\d opts -> opts { optDirectory = decodeString d }) "DIRECTORY") - "set directory to watch for changes (default is ./)" + (ReqArg (\d opts -> opts { optDirectory = decodeString d }) "directory") + "Set directory to watch for changes (default is ./)." + , Option "b" ["daemon"] + (ReqArg (\s opts -> opts { optIsDaemon = True, optDaemonCmd = s }) "start|stop") + "Attempt to run in the background as a daemon. When a previous daemon is running from your working directory this option will kill that process." ] header :: String -header = "Usage: sos [v] -c command -p pattern" +header = "Usage: sos [vb] -c command -p pattern" version :: String -version = intercalate "\n" [ "\nSteel Overseer 0.2.0.0" - , " by Schell Scivally" - , "" - ] +version = "\nSteel Overseer 1.0.0.0\n" startWithOpts :: Options -> IO () startWithOpts opts = do let Options{..} = opts haveOptions = not (null optPatterns) patternsValid = and $ fmap (not . null) optPatterns + daemonValid = optDaemonCmd == "start" || optDaemonCmd == "stop" when optShowVersion $ putStrLn version unless patternsValid $ error "One or more patterns are empty." - when (haveOptions && patternsValid) $ steelOverseer optDirectory optCommands optPatterns - + unless daemonValid $ error "The argument to -b,--daemon must be one of start or stop." + didKill <- if optIsDaemon && optDaemonCmd == "stop" + then do shouldKillPrev <- isRunning pIdFile + if shouldKillPrev + then do putStrLn "Killing previous steeloverseer daemon..." + killAndWait pIdFile + putStrLn "Done." + else putStrLn "There is no previous daemon to kill." + return shouldKillPrev + else return False + let runSteelOverseer = steelOverseer optDirectory optCommands optPatterns optIsDaemon + when (haveOptions && patternsValid && daemonValid) $ + if not optIsDaemon + then runSteelOverseer + else unless didKill $ do + putStrLn "Running in the background as a daemon, logging output to sos.log." + runDetached (Just pIdFile) (ToFile logFile) runSteelOverseer + + diff --git a/src/SOS.hs b/src/SOS.hs --- a/src/SOS.hs +++ b/src/SOS.hs @@ -1,49 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} module SOS where -import ANSIColors -import System.FSNotify -import System.Process -import System.Exit -import Control.Monad -import Control.Concurrent -import Data.Maybe -import Text.Regex.TDFA - -import Filesystem.Path.CurrentOS as OS -import Data.Text as T -import Data.List as L - -import System.IO ( Handle ) - -import Prelude hiding ( FilePath ) - -type RunningProcess = IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) +import ANSIColors +import System.FSNotify +import System.Process +import System.Exit +import System.Posix.Signals +import System.Posix.Daemon +import Control.Monad +import Control.Concurrent +import Data.Maybe +import Text.Regex.TDFA +import Filesystem.Path.CurrentOS as OS +import Prelude hiding ( FilePath ) +import qualified Data.Text as T +import qualified Prelude --- | A tuple to hold our changed file events, +-- | A structure to hold our changed file events, -- list of commands to run and possibly the currently running process, -- in case it's one that hasn't terminated. -type SOSState = ([Event], [String], Maybe ProcessHandle) +data SOSState = SOSIdle + | SOSPending { accumulatedEvents :: [Event] } + | SOSRunning { runningProccess :: ProcessHandle + , pendingCommands :: [String] + } -steelOverseer :: FilePath -> [String] -> [String] -> IO () -steelOverseer dir cmds exts = do - putStrLn "Hit enter to quit.\n" +pIdFile :: Prelude.FilePath +pIdFile = "sos.pid" + +logFile :: Prelude.FilePath +logFile = "sos.log" + +steelOverseer :: FilePath -> [String] -> [String] -> Bool -> IO () +steelOverseer dir cmds exts isDaemon = do + unless isDaemon $ putStrLn "Hit enter to quit.\n" wm <- startManager mvar <- newEmptyMVar + let predicate = actionPredicateForRegexes exts - action = performCommand mvar cmds in - watchTree wm dir predicate action + action = performCommand mvar cmds + watchTree wm dir predicate action - _ <- getLine + unless isDaemon $ do + _ <- getLine + cleanup wm mvar + + when isDaemon $ do + -- Install a sigkill handler to cleanup when the daemon is killed. + _ <- installHandler sigQUIT (Catch $ cleanup wm mvar) Nothing + forever $ threadDelay 1000000 +cleanup :: WatchManager -> MVar SOSState -> IO () +cleanup wm mvar = do + putStrLn "Cleaning up." mState <- tryTakeMVar mvar - case mState of - Just (_, _, Just pid) -> terminatePID pid + Just (SOSRunning pid _) -> terminatePID pid _ -> return () - stopManager wm + isDaemon <- isRunning pIdFile + when isDaemon $ brutalKill pIdFile + actionPredicateForRegexes :: [String] -> Event -> Bool actionPredicateForRegexes ptns event = or (fmap (filepath =~) ptns :: [Bool]) where filepath = case toText $ eventPath event of @@ -59,27 +78,27 @@ performCommand :: MVar SOSState -> [String] -> Event -> IO () performCommand mvar cmds event = do cyanPrint event - mEvProc <- tryTakeMVar mvar - eventsAndProcess <- case mEvProc of + mSosState <- tryTakeMVar mvar + sosState <- case mSosState of Nothing -> do -- This is the first file to change and there is no running process. startWriteProcess mvar cmds 1000000 - return ([event], cmds, Nothing) + return $ SOSPending [event] - Just ([], _, Just pid) -> do + Just (SOSRunning pid _) -> do -- There is a hanging process. mExCode <- getProcessExitCode pid when (isNothing mExCode) $ terminatePID pid startWriteProcess mvar cmds 1000000 - return ([event], cmds, Nothing) + return $ SOSPending [event] - Just (events, leftoverCmds, Nothing) -> + Just (SOSPending events) -> -- SOS is waiting the 1sec delay for events before running the process. - return (event:events, leftoverCmds, Nothing) + return $ SOSPending $ event:events - Just enp -> return enp + Just state -> return state - putMVar mvar eventsAndProcess + putMVar mvar sosState startWriteProcess :: MVar SOSState -> [String] -> Int -> IO () startWriteProcess mvar [] _ = do @@ -92,10 +111,11 @@ pId <- runCommand cmd mEvProcCurrent <- tryTakeMVar mvar case mEvProcCurrent of - Nothing -> putMVar mvar ([], cmds, Just pId) + -- This shouldn't ever happen. + Nothing -> putMVar mvar $ SOSRunning pId cmds - Just (_, _, _) -> void $ forkIO $ do - putMVar mvar ([], cmds, Just pId) + Just _ -> void $ forkIO $ do + putMVar mvar $ SOSRunning pId cmds exitCode <- waitForProcess pId case exitCode of ExitSuccess -> do diff --git a/steeloverseer.cabal b/steeloverseer.cabal --- a/steeloverseer.cabal +++ b/steeloverseer.cabal @@ -1,21 +1,21 @@ --- Initial steeloverseer.cabal generated by cabal init. For further +-- Initial steeloverseer.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ name: steeloverseer -version: 0.2.0.0 -synopsis: A file watcher. -description: A command line tool that responds to filesystem events. Users can provide regular expressions to match on filepaths and shell commands to execute in serial when matches are found. Displays text using a subset of available primary colors. +version: 0.5.0.0 +synopsis: A file watcher. +description: A command line tool that responds to filesystem events. Allows the user to automatically execute commands after files are added or updated. Watches files using regular expressions. Can be invoked interactively or as a daemon. license: BSD3 license-file: LICENSE author: Schell Scivally maintainer: efsubenovex@gmail.com -stability: alpha +stability: stable bug-reports: https://github.com/schell/steeloverseer/issues homepage: https://github.com/schell/steeloverseer category: Development build-type: Simple cabal-version: >=1.8 --- source + source-repository head type: git location: git://github.com/schell/steeloverseer.git @@ -31,7 +31,9 @@ process >= 1.1.0.2, text >=0.11.2.3, time >=1.4, - pipes >=3.2, stm >=2.4, - regex-tdfa >=1.1.8 - + regex-tdfa >=1.1.8, + daemons >=0.2.1, + unix >=2.6.0.1 + +