packages feed

devil (empty) → 0.1.0.0

raw patch · 5 files changed

+266/−0 lines, 5 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, directory, filepath, hinotify, process, split, text, unix, unordered-containers

Files

+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ devil.cabal view
@@ -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 <yanhaozhu@gmail.com>+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
+ example.json view
@@ -0,0 +1,12 @@+{+    "incomingFolder": "/home/zhu/apps/incoming",+    "watchItems":+    [+        {+            "binaryFileName": "rate",+            "targetFolder": "/home/zhu/apps/rate",+            "pidFile": "/home/zhu/apps/rate/rate.pid"+        }+        +    ]+}
+ main.hs view
@@ -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"