diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +The MIT License (MIT) + +Copyright (c) 2013 Yanhao Zhu. + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/devil.cabal b/devil.cabal new file mode 100644 --- /dev/null +++ b/devil.cabal @@ -0,0 +1,37 @@ +name: devil +version: 0.1.0.0 +synopsis: A small tool to make it easier to update program managed by Angel. +description: @Devil@ is a small tool to make it easier to update programs managed + by Angel (the excellent process monitor/management tool). Angel + starts processes. Devil kills running processes when an update is detected. +homepage: https://github.com/luanzhu/devil +license: MIT +license-file: LICENSE +author: Yanhao Zhu +maintainer: Yanhao Zhu +copyright: Copyright (c) 2013 Yanhao Zhu. +stability: Experimental +category: System +build-type: Simple +cabal-version: >=1.8 + +extra-source-files: example.json + +source-repository head + type: git + location: https://github.com/luanzhu/devil.git + +executable devil + main-is: main.hs + ghc-options: -Wall + build-depends: base ==4.5.* + , hinotify >= 0.3.6 + , directory >= 1.1 + , aeson >= 0.6.2.0 + , text >= 0.11.2.0 + , bytestring >= 0.9.2.1 + , filepath >= 1.1.0.2 + , split >= 0.2.2 + , process >= 1.1.0.1 + , unix >= 2.5.0.0 + , unordered-containers >= 0.2.3.3 diff --git a/example.json b/example.json new file mode 100644 --- /dev/null +++ b/example.json @@ -0,0 +1,12 @@ +{ + "incomingFolder": "/home/zhu/apps/incoming", + "watchItems": + [ + { + "binaryFileName": "rate", + "targetFolder": "/home/zhu/apps/rate", + "pidFile": "/home/zhu/apps/rate/rate.pid" + } + + ] +} diff --git a/main.hs b/main.hs new file mode 100644 --- /dev/null +++ b/main.hs @@ -0,0 +1,194 @@ +import Prelude hiding (readFile) +import Data.ByteString.Lazy (readFile) +import Data.Text (pack) +import Data.Text.Lazy (strip, unpack) +import Data.Text.Lazy.Encoding (decodeUtf8) +import Data.Aeson (FromJSON, Value(..), parseJSON, (.:), decode) +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (mzero) +import Data.List (find) +import System.FilePath.Posix (combine, splitFileName) +import System.Directory (getDirectoryContents) +import Data.List.Split (splitOn, splitOneOf) +import System.Process (createProcess, proc, waitForProcess, readProcessWithExitCode) +import System.Exit (ExitCode(..)) +import System.Posix.Files (setFileMode, fileMode, getFileStatus) +import System.INotify (initINotify, addWatch, Event(..), EventVariety(..), removeWatch) +import System.Environment (getArgs) + +cpCommandPath :: String +cpCommandPath = "/bin/cp" + +-- | The configuration for each binary to be monitored. +data Item = Item { + binaryFileName :: String, + targetFolder :: String, + pidFile :: String +} deriving (Show) + +-- | The top-level configuration item, which contains a folder to monitor and a list of items to watch for. +data Configuration = Configuration { + incomingFolder :: String, + watchItems :: [Item] +} deriving (Show) + +-- | Data.Aeson required decode function to parse for an Item. +-- Here is an example: +-- { +-- "binaryFileName": "rate", +-- "targetFolder": "/home/zhu/yesod-app", +-- "pidFile": "/home/zhu/yesod-app/app.pid" +-- } +instance FromJSON Item where + parseJSON (Object o) = Item <$> + o .: pack "binaryFileName" <*> + o .: pack "targetFolder" <*> + o .: pack "pidFile" + parseJSON _ = mzero + +-- | Data.Aeson required decode function to parse for the top-level configuration. +-- An example of complete configuration: +-- { +-- "incomingFolder": "/home/zhu/app-incoming", +-- "watchItems": +-- [ +-- { +-- "binaryFileName": "rate", +-- "targetFolder": "/home/zhu/yesod-app", +-- "pidFile": "/home/zhu/yesod-app/app.pid" +-- } +-- ] +-- } +instance FromJSON Configuration where + parseJSON (Object o) = Configuration <$> + o .: pack "incomingFolder" <*> + o .: pack "watchItems" + parseJSON _ = mzero + +-- | Use INotify to monitor uploading folder. When a new or modified file was detected, it will call fileUpdated. +watchForUpdatedFiles :: Configuration -> IO () +watchForUpdatedFiles config = do + inotify <- initINotify + wd <- addWatch + inotify + [Close] + (incomingFolder config) + (fileUpdated config) + putStrLn $ "Watching incoming folder [" ++ incomingFolder config ++ "]. Hit enter to terminate." + _ <- getLine + removeWatch wd + +-- | This function will be called whenever a file was updated in the upcoming folder. If the file updated matches a watch item's binary file name, the following will happen: +-- (1), the updated file will be copied to the watch item's target folder and set to executable; +-- (2), all the watch item's current running process(es) will be killed. +fileUpdated :: Configuration -> Event -> IO () +fileUpdated Configuration { incomingFolder=incomingDir, watchItems=items } Closed { isDirectory = False, maybeFilePath = Just path, wasWriteable = True} = do + putStrLn "****************File Change Detected****************" + let i' = find (\Item { binaryFileName = p} -> p == path) items + case i' of + Just Item { binaryFileName = bFileNameOnly, targetFolder = tFolder, pidFile = pFile} -> do + putStrLn $ "Changes to [" ++ bFileNameOnly ++ "] was detected." + let sourceFilePath = combine incomingDir bFileNameOnly + targetFilePath = combine tFolder bFileNameOnly + + --get the original file mode + status <- getFileStatus targetFilePath + let mode = fileMode status + + (copyCode, stdoutString, stderrString) <- readProcessWithExitCode cpCommandPath ["-f", sourceFilePath, targetFilePath] "" + case copyCode of + ExitSuccess -> do + putStrLn $ "Copied from [" ++ sourceFilePath ++ "] to [" ++ targetFilePath ++ "]." + setFileMode targetFilePath mode + putStrLn $ "Restore file mode for [" ++ targetFilePath ++ "]." + + pids <- getPIDs pFile + case length pids of + 0 -> + putStrLn "No PID was found. Process is not running?" + _ -> do + putStrLn $ "Process IDs to be killed: " ++ show pids + let args = "-9" : pids + (_,_,_,handle) <- createProcess $ proc "kill" args + exitCode <- waitForProcess handle + case exitCode of + ExitSuccess -> + putStrLn "Process(es) killed!" + ExitFailure c -> + putStrLn $ "Cannot kill one or more processes, exit code:" ++ show c ++ "." + ExitFailure n -> do + putStrLn $ "Cannot copy from [" ++ sourceFilePath ++ "] to [" ++ targetFilePath ++ "]." + putStrLn $ "/bin/cp exit code: " ++ show n + putStrLn $ " stdout: " ++ stdoutString + putStrLn $ " stderr: " ++ stderrString + putStrLn "Cannot continue, target is NOT updated. NO process was killed!" + + -- The updated file in the upcoming folder is not related to any watch item + Nothing -> return () +fileUpdated _ _ = return () + +-- | Get one or more process IDs from a file. Angel PID file name convention is used. +-- For example, give a process ID file "/home/zhu/yesod-app/app.pid", the following files will be checked: +-- /home/zhu/yesod-app/app.pid +-- /home/zhu/yesod-app/app-?.pid (where ? is a number) +getPIDs :: String -> IO [String] +getPIDs fileName = do + let (dir, path) = splitFileName fileName + files <- getDirectoryContents dir + let pidFiles = map (combine dir) $ filter (isPIDFile path) files + --print pidFiles + pids' <- mapM readFile pidFiles + let pids = map (unpack.strip.decodeUtf8) pids' + return pids + +-- | Is fileName a possible PID file based on Angel convention? +-- For example: +-- isPIDFile "app.pid" "app.pid" => true +-- isPIDFile "app.pid" "app-1.pid" => true +-- isPIDFile "app.pid" "app-12.pid" => true +-- isPIDFile "app.pid" "anything-else.txt" => false +isPIDFile :: String -> String -> Bool +isPIDFile fileName pathCandi = + let [name, ext] = splitOn "." fileName + parts = splitOneOf ".-" pathCandi + in case parts of + [name1, ext1] -> name1 == name && ext1 == ext + [name2, num, ext2] -> name2 == name && ext2 == ext && isInteger num + _ -> False + +isInteger :: String -> Bool +isInteger s = case reads s :: [(Integer, String)] of + [(_, "")] -> True + _ -> False + +-- | Read the configuration file into a Configuration object +getConfiguration :: String -> IO (Maybe Configuration) +getConfiguration configFileName = do + putStrLn $ "Trying to load configuration from " ++ configFileName + content <- readFile configFileName + let r = decode content :: Maybe Configuration + return r + +-- | Load configuration and set up to watch upcoming folder based on the configuration. +-- Q1. How to run this program? +-- A1. This program is designed to work with screen. To start it in a named but detached screen session: +-- screen -S devil -d -m ./devil configure.json +-- Q2. How to reconnect it with screen? +-- A2. screen -S devil -r +-- Q3. How to detach from screen? +-- A3. ctrl+a d +main :: IO () +main = do + args <- getArgs + case length args of + 1 -> do + config' <- getConfiguration $ head args + case config' of + Nothing -> + putStrLn "Invalid configure json file!" + Just config -> do + print config + watchForUpdatedFiles config + _ -> do + putStrLn "Wrong number of argument." + putStrLn "Usage: devil configure.json"