AMI-0.1/0000755000000000000000000000000011704736205010153 5ustar0000000000000000AMI-0.1/LICENSE0000644000000000000000000000275711704736205011173 0ustar0000000000000000Copyright (c)2012, IlyaPortnov All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of IlyaPortnov nor the names of other 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. AMI-0.1/Setup.hs0000644000000000000000000000005611704736205011610 0ustar0000000000000000import Distribution.Simple main = defaultMain AMI-0.1/test.hs0000644000000000000000000000140211704736205011463 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Control.Monad.Trans import Control.Concurrent import Network.AMI info = ConnectInfo { ciHost = "localhost", ciPort = 5038, ciUsername = "monitor", ciSecret = "PASSWORD" } main = do forkIO test threadDelay 150 test test = withAMI_MD5 info $ do handleEvent "FullyBooted" onBooted mail <- query "MailboxCount" [("Mailbox","900")] liftIO $ print mail jabber <- query "JabberSend" [("Jabber", "asterisk"), ("JID", "portnov@free-alt.ru"), ("ScreenName", "asterisk"), ("Message", "Jabber via AMI")] liftIO $ print jabber onBooted ps = liftIO $ do putStrLn "Asterisk is fully booted." print ps AMI-0.1/AMI.cabal0000644000000000000000000000210311704736205011541 0ustar0000000000000000Name: AMI Version: 0.1 Synopsis: Low-level bindings for Asterisk Manager Interface (AMI). Description: This package provides simple low-level bindings for Asterisk Manager Interface (AMI). Homepage: http://redmine.iportnov.ru/projects/ami bug-reports: http://redmine.iportnov.ru/projects/ami License: BSD3 License-file: LICENSE Author: IlyaPortnov Maintainer: portnov84@rambler.ru -- A copyright notice. -- Copyright: Category: Network Build-type: Simple Extra-source-files: test.hs Cabal-version: >=1.6 Library Exposed-modules: Network.AMI Build-depends: base >= 4 && < 5, containers, mtl, network, bytestring, pureMD5, stm -- Modules not exported by this package. -- Other-modules: -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: Source-repository head type: git location: git://home.iportnov.ru/AMI.git AMI-0.1/Network/0000755000000000000000000000000011704736204011603 5ustar0000000000000000AMI-0.1/Network/AMI.hs0000644000000000000000000002360711704736204012555 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, BangPatterns #-} module Network.AMI (-- * Usage -- $usage -- * Types Parameters, ActionType, EventType, ActionID, ResponseType, EventHandler, AMI, Action (..), Response (..), Event (..), ConnectInfo (..), -- * Functions withAMI, withAMI_MD5, query, handleEvent ) where import Control.Monad import Control.Monad.Trans import Control.Monad.Instances import Control.Monad.Reader import Control.Concurrent import Control.Concurrent.STM import qualified Control.Exception as E import qualified Data.Map as M import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as L import Data.Digest.Pure.MD5 import System.IO.Unsafe (unsafePerformIO) import Network import Network.Socket import System.IO {- $usage > import Network.AMI > > info :: ConnectInfo > info = ConnectInfo { > ciHost = "localhost" > , ciPort = 5038 > , ciUsername = "admin" > , ciSecret = "PASSWORD" } > > main :: IO () > main = withAMI_MD5 info $ do > handleEvent "FullyBooted" onBooted > mail <- query "MailboxCount" [("Mailbox","900")] > liftIO $ print mail > jabber <- query "JabberSend" [("Jabber", "asterisk"), > ("JID", "someone@example.com"), > ("ScreenName", "asterisk"), > ("Message", "Jabber via AMI")] > liftIO $ print jabber > > onBooted :: EventHandler > onBooted ps = liftIO $ do > putStrLn "Asterisk is fully booted." > print ps -} -- | Action or response or event parameters type Parameters = [(B.ByteString, B.ByteString)] type ActionType = B.ByteString type EventType = B.ByteString type ActionID = Integer type ResponseType = B.ByteString type EventHandler = Parameters -> IO () -- | Action packet (sent to Asterisk) data Action = Action ActionID ActionType Parameters deriving (Eq, Show) -- | Response packet (received from Asterisk) data Response = Response ActionID ResponseType Parameters [B.ByteString] deriving (Eq, Show) -- | Event packet (received from Asterisk) data Event = Event EventType Parameters deriving (Eq, Show) -- | AMI monad internal state data AMIState = AMIState { amiHandle :: Maybe Handle -- ^ Handle for socket of Asterisk connection , amiActionID :: ActionID -- ^ ActionID of last action , amiResponses :: M.Map ActionID (Maybe Response) -- ^ Responses for sent actions , amiEventHandlers :: M.Map EventType EventHandler -- ^ Event handlers } -- | Info needed to connect and authenticate in Asterisk data ConnectInfo = ConnectInfo { ciHost :: String -- ^ Host with Asterisk server (e.g. `localhost') , ciPort :: Int -- ^ Port of Asterisk server (usually 5038) , ciUsername :: B.ByteString -- ^ Username , ciSecret :: B.ByteString -- ^ Secret } deriving (Eq, Show) -- | The AMI monad type AMI a = ReaderT (TVar AMIState) IO a packID :: ActionID -> B.ByteString packID i = B.pack (show i) -- | Sort-of Control.Monad.State.gets getAMI :: (AMIState -> a) -> AMI a getAMI fn = do var <- ask st <- liftIO $ atomically $ readTVar var return (fn st) -- | Sort-of Control.Monad.State.put putAMI :: AMIState -> AMI () putAMI st = do var <- ask liftIO $ atomically $ writeTVar var st -- | Sort-of Control.Monad.State.modify modifyAMI :: (AMIState -> AMIState) -> AMI () modifyAMI fn = do st <- getAMI id putAMI (fn st) -- | Return next ActionID inc :: AMI ActionID inc = do st <- getAMI id let n = 1 + amiActionID st putAMI $ st {amiActionID = n} return n -- | Get connection handle getHandle :: AMI Handle getHandle = do mbh <- getAMI amiHandle case mbh of Nothing -> fail "Connection is not opened" Just h -> return h -- | Add an event handler handleEvent :: EventType -> EventHandler -> AMI () handleEvent t handler = modifyAMI add where add st = st {amiEventHandlers = M.insert t handler (amiEventHandlers st)} -- | Send an Action packet and return the response. -- -- CAUTION: the response value should be evaluated in order -- to be removed from internal responses queue. Leaving -- response value un-evaluated (e.g. unused) will cause -- memory leak. -- query :: ActionType -> Parameters -> AMI Response query t ps = do i <- inc var <- ask liftIO $ atomically $ do st <- readTVar var let resps = M.insert i Nothing (amiResponses st) writeTVar var $ st {amiResponses = resps} h <- getHandle liftIO $ sendPacket h (Action i t ps) return $ unsafePerformIO $ do st <- atomically $ readTVar var atomically $ do st <- readTVar var let resps = amiResponses st case M.lookup i resps of Just (Just a) -> do writeTVar var $ st {amiResponses = M.delete i resps} return a Just (Nothing) -> retry Nothing -> fail $ "There was no response for Action " ++ show i -- | Open a connection to Asterisk and authenticate open :: ConnectInfo -> AMI ThreadId open info = do h <- liftIO $ connectTo (ciHost info) (PortNumber $ fromIntegral $ ciPort info) t <- forkAnswersReader h modifyAMI $ \st -> st {amiHandle = Just h} s <- liftIO $ B.hGetLine h auth <- query "Login" [("Username", ciUsername info), ("Secret", ciSecret info)] case auth of Response _ "Success" _ _ -> return t _ -> fail "Authentication failed" -- | Open a connection to Asterisk and authenticate using MD5 challenge openMD5 :: ConnectInfo -> AMI ThreadId openMD5 info = do h <- liftIO $ connectTo (ciHost info) (PortNumber $ fromIntegral $ ciPort info) s <- liftIO $ B.hGetLine h t <- forkAnswersReader h modifyAMI $ \st -> st {amiHandle = Just h} chp <- query "Challenge" [("AuthType", "md5")] case chp of Response _ "Success" [("Challenge", ch)] _ -> do let key = B.pack $ show $ md5 $ L.fromChunks [ch `B.append` ciSecret info] auth <- query "Login" [("AuthType", "md5"), ("Username", ciUsername info), ("Key", key)] case auth of Response _ "Success" _ _ -> return t x -> fail $ "MD5 authentication failed: " ++ show x _ -> fail "Cannot get challenge for MD5 authentication" -- | Close Asterisk connection close :: ThreadId -> AMI () close t = do !x <- query "Logoff" [] h <- getHandle modifyAMI $ \st -> st {amiHandle = Nothing} rs <- getAMI amiResponses liftIO $ killThread t liftIO $ hClose h -- | Connect, execute acions, disconnect withAMI :: ConnectInfo -> AMI a -> IO a withAMI info ami = runAMI $ do t <- open info r <- ami close t return r -- | Connect (using MD5 challenge), execute acions, disconnect withAMI_MD5 :: ConnectInfo -> AMI a -> IO a withAMI_MD5 info ami = runAMI $ do t <- openMD5 info r <- ami close t return r -- | Send one AMI packet sendPacket :: Handle -> Action -> IO () sendPacket h p = do let s = format p `B.append` "\r\n" B.hPutStr h s B.hPutStr h "\r\n" hFlush h -- | Run AMI actions runAMI :: AMI a -> IO a runAMI ami = do var <- atomically $ newTVar (AMIState Nothing 0 M.empty M.empty) runReaderT ami var readUntilEmptyLine :: Handle -> IO B.ByteString readUntilEmptyLine h = do str <- B.hGetLine h `E.catch` \(E.SomeException _) -> return "\n" if (str == "\n") || (str == "\r") || (str == "\r\n") then return str else do next <- readUntilEmptyLine h return $ str `B.append` next forkAnswersReader :: Handle -> AMI ThreadId forkAnswersReader h = do var <- ask liftIO $ forkIO (forever $ reader h var) where reader :: Handle -> TVar AMIState -> IO () reader h var = do str <- readUntilEmptyLine h case parse str of Left err -> do putStrLn $ "Error parsing answer: " ++ err return () Right (Right p@(Response i _ _ _)) -> do atomically $ do st <- readTVar var let resps = M.insert i (Just p) (amiResponses st) writeTVar var $ st {amiResponses = resps} Right (Left p@(Event t ps)) -> do st <- atomically $ readTVar var case M.lookup t (amiEventHandlers st) of Nothing -> return () Just handler -> handler ps linesB y = h : if B.null t then [] else linesB (B.drop 2 t) where (h,t) = B.breakSubstring "\r\n" y parse :: B.ByteString -> Either String (Either Event Response) parse str = uncurry toPacket =<< (toPairs [] $ B.split '\r' str) where toPairs :: Parameters -> [B.ByteString] -> Either String (Parameters, [B.ByteString]) toPairs [] [] = Left "Empty packet" toPairs acc [] = Right (acc, []) toPairs acc (s:ss) = case B.split ':' s of [] -> return (acc, []) [n,v] -> let new = (n, B.dropWhile (== ' ') v) in toPairs (acc ++ [new]) ss x -> Right (acc, (s:ss)) toPacket :: Parameters -> [B.ByteString] -> Either String (Either Event Response) toPacket [] text = Right $ Right $ Response 0 "text" [] text toPacket ((k,v):pairs) text = case k of "Response" -> toResponse v pairs text "Event" -> toEvent v pairs _ -> Left $ "Invalid first parameter: " ++ show v getField :: B.ByteString -> Parameters -> Either String (B.ByteString, Parameters) getField x ps = go x [] ps go x acc [] = Left "No field in packet" go x acc ((k,v):rest) | x == k = Right (v, acc ++ rest) | otherwise = go x ((k,v):acc) rest toResponse name pairs text = do (i, ps) <- getField "ActionID" pairs return $ Right $ Response (read $ B.unpack i) name ps text toEvent name pairs = Right $ Left $ Event name pairs format :: Action -> B.ByteString format (Action i name ps) = formatParams $ [("Action", name), ("ActionID", packID i)] ++ ps formatParams :: Parameters -> B.ByteString formatParams pairs = B.intercalate "\r\n" $ map one pairs where one (k,v) = k `B.append` ": " `B.append` v