agentx 0.1.0.2 → 0.1.0.3
raw patch · 4 files changed
+161/−41 lines, 4 filesdep +unixdep ~basenew-component:exe:agentx_examplePVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: unix
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Network.Protocol.Snmp.AgentX: runAgent :: OID -> [MIB] -> Maybe Client -> Socket -> IO ()
+ Network.Protocol.Snmp.AgentX.Service: runAgent :: OID -> [MIB] -> Maybe Client -> Socket -> IO ()
Files
- agentx.cabal +48/−12
- src/Main.hs +82/−0
- src/Network/Protocol/Snmp/AgentX.hs +7/−12
- src/Network/Protocol/Snmp/AgentX/Service.hs +24/−17
agentx.cabal view
@@ -2,8 +2,8 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: agentx-version: 0.1.0.2-synopsis: AgentX protocol for snmp subagents+version: 0.1.0.3+synopsis: AgentX protocol for write SNMP subagents description: Native implementation agentx protocol (rfc2741) license: BSD3 license-file: LICENSE@@ -15,20 +15,29 @@ -- extra-source-files: cabal-version: >=1.10 +flag example+ description: Install a "agentx_example" executable.+ default: False+ library- exposed-modules: Network.Protocol.Snmp.AgentX, - Network.Protocol.Snmp.AgentX.MIBTree, - Network.Protocol.Snmp.AgentX.Packet, - Network.Protocol.Snmp.AgentX.Handlers,- Network.Protocol.Snmp.AgentX.Service,- Network.Protocol.Snmp.AgentX.Types- other-modules: Network.Protocol.Snmp.AgentX.MIBTree.Tree, Network.Protocol.Snmp.AgentX.MIBTree.MIBTree, Network.Protocol.Snmp.AgentX.MIBTree.Types,- Network.Protocol.Snmp.AgentX.Packet.Binary, Network.Protocol.Snmp.AgentX.Packet.Get, Network.Protocol.Snmp.AgentX.Packet.Put, - Network.Protocol.Snmp.AgentX.Packet.Types + exposed-modules: Network.Protocol.Snmp.AgentX + , Network.Protocol.Snmp.AgentX.MIBTree + , Network.Protocol.Snmp.AgentX.Packet + , Network.Protocol.Snmp.AgentX.Handlers+ , Network.Protocol.Snmp.AgentX.Service+ , Network.Protocol.Snmp.AgentX.Types+ other-modules: Network.Protocol.Snmp.AgentX.MIBTree.Tree+ , Network.Protocol.Snmp.AgentX.MIBTree.MIBTree+ , Network.Protocol.Snmp.AgentX.MIBTree.Types+ , Network.Protocol.Snmp.AgentX.Packet.Binary+ , Network.Protocol.Snmp.AgentX.Packet.Get+ , Network.Protocol.Snmp.AgentX.Packet.Put+ , Network.Protocol.Snmp.AgentX.Packet.Types -- other-extensions: - build-depends: base >=4.6 && <4.8+ build-depends: base >=4.6 && <4.9 , snmp , binary+ , unix , bytestring , bitwise , network@@ -46,6 +55,33 @@ hs-source-dirs: src ghc-options: -Wall default-language: Haskell2010++executable agentx_example+ if !flag(example)+ buildable: False+ main-is: Main.hs+ build-depends: base >=4.6 && <4.9+ , snmp+ , binary+ , unix+ , bytestring+ , bitwise+ , network+ , fclabels+ , Diff+ , mtl+ , transformers+ , time+ , data-default+ , containers+ , safe+ , pipes-network+ , pipes+ , pipes-concurrency+ hs-source-dirs: src+ ghc-options: -Wall -O2 -threaded+ default-language: Haskell2010+ source-repository head type: git
+ src/Main.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Network.Protocol.Snmp.AgentX +import qualified Data.ByteString as BS+import Data.ByteString (ByteString)+import Data.Fixed (div')+import Data.Time.Clock.POSIX (getPOSIXTime)+import Control.Applicative ((<$>))+import Control.Monad.State+import Data.IORef++++str :: ByteString -> PVal+str x = rsValue (String x)++now :: PVal+now = rdValue $ TimeTicks . flip div' 1 <$> liftIO getPOSIXTime++rws :: IORef Value -> PVal+rws io = rwValue readV commit test undo+ where+ test (String x) + | BS.length x < 10 = return NoTestError+ | otherwise = return TooBig+ test _ = return WrongType+ commit v = do+ writeIORef io v+ return NoCommitError+ undo _ = return NoUndoError+ readV = readIORef io++rwi :: IORef Value -> PVal+rwi io = rwValue readV commit test undo+ where+ test (Integer x) + | x < 5 = return NoTestError+ | otherwise = return TooBig+ test _ = return WrongType+ commit v = do+ writeIORef io v+ return NoCommitError+ undo _ = return NoUndoError+ readV = readIORef io++dynTree :: IORef Value -> Update+dynTree i = Update $ do+ Integer count <- liftIO $ readIORef i+ return $ concatMap fun [0 .. count]+ where+ fun x = [ mkObject (fromIntegral x) "trees" ("tree" ++ show x) Nothing+ , mkObjectType 0 ("tree" ++ show x) "abr" Nothing (str "abr")+ , mkObjectType 1 ("tree" ++ show x) "abrvalg" Nothing (str "abrvalg")+ ]++ver :: Maybe Context+ver = Just "version"++simpleTree :: IORef Value -> IORef Value -> [MIB]+simpleTree m i = + [ mkObject 0 "Fixmon" "about" Nothing+ , mkObjectType 0 "about" "name" Nothing $ rsValue (String "Fixmon agent")+ , mkObjectType 1 "about" "version" Nothing $ rsValue (String "0.0.1")+ , mkObjectType 1 "about" "version" ver $ rsValue (String "Alpha")+ , mkObjectType 2 "about" "comment" Nothing (rws m) + , mkObject 1 "Fixmon" "dyn" Nothing+ , mkObjectType 0 "dyn" "counter" Nothing (rwi i)+ , mkObject 1 "dyn" "trees" (Just $ dynTree i)+ ]++tree :: IO [MIB]+tree = do+ m <- newIORef (String "init")+ i <- newIORef (Integer 0)+ return $ simpleTree m i+ +main :: IO ()+main = agent "/var/agentx/master" [1,3,6,1,4,1,44729] Nothing =<< tree+
src/Network/Protocol/Snmp/AgentX.hs view
@@ -15,6 +15,7 @@ , UndoError(..) , Context , agent+, runAgent , Client -- * Usage -- ** Imports@@ -163,18 +164,12 @@ > > defPrivType DES > > defContext "" > -> Build and start example-> > cabal install example-> > .cabal-sandbox/bin/example-> > .cabal-sandbox/bin/agentx-> > "set sid SessionID 15"-> > "R ([1,3,6,1,4,1,44729,1,1,0,1],Nothing)"-> > "R ([1,3,6,1,4,1,44729,1,1,0,0],Nothing)"-> > "R ([1,3,6,1,4,1,44729,1,0],Nothing)"-> > "R ([1,3,6,1,4,1,44729,0,2],Nothing)"-> > "R ([1,3,6,1,4,1,44729,0,1],Just (Context \"version\"))"-> > "R ([1,3,6,1,4,1,44729,0,1],Nothing)"-> > "R ([1,3,6,1,4,1,44729,0,0],Nothing)"+> Build example+> > cabal install -f example+> Start SNMP server+> > sudo snmpd+> Start SNMP agent+> > .cabal-sandbox/bin/agentx_example > > Get MIB tree > > snmpwalk -r 1 -On localhost 1.3.6.1.4.1.44729
src/Network/Protocol/Snmp/AgentX/Service.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE BangPatterns #-} module Network.Protocol.Snmp.AgentX.Service ( agent +, runAgent , Client(..) , request , requestWithResponse@@ -11,7 +12,7 @@ import Network.Socket (close, Socket, socket, Family(AF_UNIX), SocketType(Stream), connect, SockAddr(SockAddrUnix)) import Network.Socket.ByteString.Lazy (recv, send)-import Control.Concurrent (killThread, threadDelay, ThreadId)+import Control.Concurrent (killThread, threadDelay, ThreadId, myThreadId) import Data.Binary (encode, decode) import Data.Monoid ((<>)) import Control.Applicative hiding (empty)@@ -29,6 +30,8 @@ import Data.Default import qualified Data.Map.Strict as Map import qualified Data.Label as DL+import System.Exit+import System.Posix.Signals import Network.Protocol.Snmp (OID) import Network.Protocol.Snmp.AgentX.Packet @@ -50,6 +53,9 @@ openSocket :: String -> IO Socket openSocket path = socket AF_UNIX Stream 0 >>= \x -> connect x (SockAddrUnix path) >> return x +-- | start agent with socket+-- exit when catch sigQUIT, sigTERM, keyboardSignal+-- show MIB tree when catch sigUSR1 runAgent :: OID -> [MIB] -> Maybe Client -> Socket -> IO () runAgent modOid tree mclient socket' = do hSetBuffering stdout LineBuffering@@ -69,18 +75,25 @@ run st $ resp >-> openSession >-> output -- start register, unregister fiber regPid <- fiber st $ resp >-> registrator >-> output- -- start server fiber+ -- start server fibers serverPid <- fiber st $ req >-> server serverPid1 <- fiber st $ req >-> server serverPid2 <- fiber st $ req >-> server -- start agent fiber agentPid <- fiber st $ resp >-> runClient (maybe def id mclient) >-> output regPidTimer <- registerTimer st- _ <- getLine :: IO String- liftIO $ putStrLn "unregister all MIB"- evalStateT unregisterFullTree =<< readIORef (mibs st)- liftIO $ threadDelay 1000000- void $ mapM (liftIO . killThread) [serverPid, serverPid1, serverPid2, sortPid, agentPid, regPid, timer, regPidTimer] -- p2,p3,p4,p5, + mainPid <- myThreadId+ let stopAgent = do+ liftIO $ putStrLn "unregister all MIB"+ evalStateT unregisterFullTree =<< readIORef (mibs st)+ liftIO $ threadDelay 1000000+ void $ mapM (liftIO . killThread) [serverPid, serverPid1, serverPid2, sortPid, agentPid, regPid, timer, regPidTimer] + throwTo mainPid ExitSuccess+ void $ installHandler keyboardSignal (Catch stopAgent) Nothing+ void $ installHandler sigTERM (Catch stopAgent) Nothing+ void $ installHandler sigQUIT (Catch stopAgent) Nothing+ void $ installHandler sigUSR1 (Catch (print =<< readIORef (mibs st))) Nothing+ forever $ threadDelay 10000000 initAgent :: OID -> [MIB] -> Socket -> IO SubAgentState initAgent modOid tree socket' = do@@ -192,8 +205,8 @@ s <- mibs <$> ask m <- liftIO $ readIORef s (toReg, toUnReg) <- liftIO $ takeMVar (DL.get MIBTree.register m)- liftIO $ mapM_ (\x -> print ("R " ++ show x)) toReg- liftIO $ mapM_ (\x -> print ("UR " ++ show x)) toUnReg+-- liftIO $ mapM_ (\x -> print ("R " ++ show x)) toReg+-- liftIO $ mapM_ (\x -> print ("UR " ++ show x)) toUnReg return $ map toRegPacket toReg <> map toUnRegPacket toUnReg where toRegPacket :: (OID, Maybe Context) -> Packet@@ -226,16 +239,10 @@ sesRef <- sessions <$> ask s <- liftIO $ readIORef sesRef case s of- Nothing -> do- liftIO $ atomicModifyIORef' sesRef (const $ (Just sid', ()))- msg+ Nothing -> liftIO $ atomicModifyIORef' sesRef (const $ (Just sid', ())) Just x | x == sid' -> return ()- | otherwise -> do- liftIO $ atomicModifyIORef' sesRef (const $ (Just sid', ()))- msg- where- msg = liftIO $ print $ "set sid " ++ show sid'+ | otherwise -> liftIO $ atomicModifyIORef' sesRef (const $ (Just sid', ())) getPid :: SubAgent PacketID