snmp (empty) → 0.1.0.0
raw patch · 10 files changed
+1759/−0 lines, 10 filesdep +asn1-encodingdep +asn1-parsedep +asn1-typessetup-changed
Dependencies added: asn1-encoding, asn1-parse, asn1-types, async, base, binary, bytestring, cipher-aes, cipher-des, containers, crypto-cipher-types, cryptohash, mtl, network, network-info, random, securemem, text, time
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- snmp.cabal +44/−0
- src/Network/Protocol/Snmp.hs +1044/−0
- src/Network/Snmp/Client.hs +53/−0
- src/Network/Snmp/Client/Internal.hs +67/−0
- src/Network/Snmp/Client/Types.hs +51/−0
- src/Network/Snmp/Client/Version2.hs +100/−0
- src/Network/Snmp/Client/Version3.hs +259/−0
- src/Network/Snmp/Example.hs +109/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Alexey Smirnov++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 Alexey Smirnov 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ snmp.cabal view
@@ -0,0 +1,44 @@+name: snmp+version: 0.1.0.0+synopsis: API for write snmp client.+description: API for write snmp client. +license: BSD3+license-file: LICENSE+author: Alexey Smirnov+maintainer: Alexey Smirnov <chemistmail@gmail.com>+-- copyright: +category: Network+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++source-repository head+ type: git+ location: git@github.com:chemist/snmp.git++library+ exposed-modules: Network.Protocol.Snmp, Network.Snmp.Client, Network.Snmp.Example+ other-modules: Network.Snmp.Client.Internal, Network.Snmp.Client.Types, Network.Snmp.Client.Version2, Network.Snmp.Client.Version3 + -- other-extensions: + build-depends: base >=4.7 && <4.8, + asn1-encoding, + asn1-types, + asn1-parse, + bytestring, + network, + mtl, + text, + time, + containers, + async, + binary, + network-info, + cryptohash, + cipher-des, + crypto-cipher-types, + securemem, + random, + cipher-aes+ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010
+ src/Network/Protocol/Snmp.hs view
@@ -0,0 +1,1044 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleInstances #-}+module Network.Protocol.Snmp (+-- * snmp types+ Value(..)+, OID+, OIDS+-- * top level types+, V2+, V3+, Version(..)+, Packet+-- ** header+, Header +-- *** header snmpV2+, Community(..)+-- *** header snmpV3+, ID(..)+, MaxSize(..)+, Flag(..)+, SecurityModel(..)+, SecurityParameter(..)+, Reportable+, PrivAuth(..)+, EngineBootId+, PrivacyParameter+, EngineTime+, EngineId+-- ** PDU+, PDU (CryptedPDU)+-- *** PDU universal+, Request(..)+, RequestId+, ErrorStatus+, ErrorIndex+, Suite(..)+, Coupla(..)+-- *** PDU snmpV3+, ContextEngineID(..)+, ContextName(..)+-- * pack, unpack Packet+, Pack(..)+-- * some classes and helpers +-- *** universal, for work with both versions+, HasItem(..)+-- *** v2 only, for work with Header V2+, HasV2(..)+-- *** v3 only, for work with Header V3, PDU V3+, HasV3(..)+-- *** create new Packet+, Construct(..)+-- ** helpers for work with Packet+-- *** universal+, getVersion+, getRequest+, setRequest+, getRid+, setRid+, getSuite+, setSuite+, getErrorStatus+, setErrorStatus+-- *** v2 only+, setCommunityP+-- *** v3 only+, setIDP+, setMaxSizeP+, setUserNameP+, getAuthenticationParametersP+, setAuthenticationParametersP+, setReportableP+, setPrivAuthP+, getEngineIdP+, setEngineIdP+, getEngineBootsP+, setEngineBootsP+, getEngineTimeP+, setEngineTimeP+, getPrivParametersP+, setPrivParametersP+-- * authentication+, passwordToKey+, signPacket+, AuthType(..)+, PrivType(..)+, Password+, Key+, cleanPass+-- * priv+, Salt+, Raw+, Encrypted+, Rand32+, Rand64+, desEncrypt+, desDecrypt+, aesEncrypt+, aesDecrypt+, toSalt+-- * exceptions+, ClientException(..) +-- * usage example+-- $example+)+where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Word (Word8, Word32, Word64)+import Data.Bits (testBit, complement, shiftL, (.|.), (.&.), setBit, shiftR, zeroBits, xor, clearBit)+import Data.ASN1.Types (ASN1Object(..), ASN1(..), OID, ASN1ConstructionType(..), ASN1Class(..))+import Data.ASN1.Parse (getNext, getObject, runParseASN1, runParseASN1State, ParseASN1, getNextContainer, onNextContainer, getMany)+import Data.ASN1.BinaryEncoding (DER(..))+import Data.ASN1.Encoding (encodeASN1', decodeASN1')+import Control.Applicative ((<$>), (<*>), (*>), (<*))+import Data.Monoid (Monoid, (<>))+import Control.Exception (Exception, throw)+import Data.Typeable (Typeable)+import qualified Crypto.Hash.MD5 as Md5+import qualified Crypto.Hash.SHA1 as Sha+import qualified Crypto.MAC.HMAC as HMAC+import qualified Crypto.Cipher.Types as Priv+import qualified Crypto.Cipher.DES as Priv+import qualified Crypto.Cipher.AES as Priv+import Data.Int++-- $example+--+-- Here example for snmpV2 +--+-- @+-- import Network.Protocol.Snmp+-- import Control.Applicative+-- import Network.Socket.ByteString (recv, sendAll)+-- import Network.Socket hiding (recv, sendAll)+--+-- -- create new empty packet+-- v2 :: Packet+-- v2 = initial Version2+-- +-- community = Community "hello"+--+-- oi = Coupla [1,3,6,1,2,1,1,4,0] Zero+--+-- -- set community, oid+-- packet :: Community -> Coupla -> Packet+-- packet community oi = +-- setCommunityP community . setSuite (Suite [oi]) $ v2+-- +-- -- here must be code for create udp socket+-- makeSocket :: Hostname -> Port -> IO Socket+-- makeSocket = undefined+--+-- main :: IO ()+-- main = do+-- socket <- makeSocket "localhost" "161"+-- sendAll socket $ encode $ setRequest (GetRequest 1 0 0) packet+-- result <- decode <$\> recv socket 1500 :: IO Packet+-- print $ getSuite result +-- +-- @+-- ++-----------------------------------------------------------------------------------------------------------------++fI :: (Num b, Integral a) => a -> b+fI = fromIntegral++-- | Phantom type for version 2 (Header V2, PDU V2)+data V2+-- | Phantom type for version 3 (Header V3, PDU V3)+data V3++-- | Snmp version tag+data Version = Version1+ | Version2 + | Version3+ deriving (Eq, Show)++type OIDS = [OID]++-- | Top level type, which describe snmp packet+data Packet where+ V2Packet :: Version -> Header V2 -> PDU V2 -> Packet+ V3Packet :: Version -> Header V3 -> PDU V3 -> Packet++deriving instance Show Packet +deriving instance Eq Packet ++-- | Snmp header without version tag+data Header a where+ V2Header :: Community -> Header V2+ V3Header :: ID -> MaxSize -> Flag -> SecurityModel -> SecurityParameter -> Header V3++deriving instance Show (Header a)+deriving instance Eq (Header a)++-- | Snmp body+data PDU a where+ PDU :: Request -> Suite -> PDU V2+ ScopedPDU :: ContextEngineID -> ContextName -> PDU V2 -> PDU V3+ CryptedPDU :: ByteString -> PDU V3++deriving instance Show (PDU a)+deriving instance Eq (PDU a)++-- | Snmp data types+data Value = OI OID+ | Zero+ | Integer Int32+ | String ByteString+ | IpAddress Word8 Word8 Word8 Word8+ | Counter32 Word32+ | Gaude32 Word32+ | TimeTicks Word32+ | Opaque ByteString+ | Counter64 Word64+ | ZeroDotZero+ | NoSuchInstance+ | NoSuchObject+ | EndOfMibView+ deriving (Show, Eq)++-- | Request id +type RequestId = Int32++-- | Error status +type ErrorStatus = Integer++-- | Error index +type ErrorIndex = Integer++-- | requests+data Request = GetRequest { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ | GetNextRequest { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ | GetResponse { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ | SetRequest { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ | GetBulk { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ | Inform { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ | V2Trap { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ | Report { rid :: RequestId, es :: ErrorStatus, ei :: ErrorIndex }+ deriving (Show, Eq)++-- | Coupla oid -> value+data Coupla = Coupla { oid :: OID, value :: Value } deriving (Eq)++-- | Variable bindings+newtype Suite = Suite [Coupla] deriving (Eq, Monoid)++-- ** Types describing header++-- | (snmp2 only) Community for 2(1) version+newtype Community = Community ByteString deriving (Show, Eq)++-- | (snmp3 only) Message Identifier (like RequestId in PDU)+newtype ID = ID Int32 deriving (Show, Eq)++-- | (snmp3 only) Message max size must be > 484+newtype MaxSize = MaxSize Integer deriving (Show, Eq)++-- | (snmp3 only) rfc3412, type for create message flag+data PrivAuth = NoAuthNoPriv | AuthNoPriv | AuthPriv deriving (Show, Eq)++-- | (snmp3 only) rfc3412, as PrivAuth+type Reportable = Bool++-- | (snmp3 only) rfc3412, message flag+data Flag = Flag Reportable PrivAuth deriving (Show, Eq)++-- | (snmp3 only) rfc3412, security model+data SecurityModel = UserBasedSecurityModel deriving (Show, Eq)++-- | (snmp3 only) rfc3412, security parameter+data SecurityParameter = SecurityParameter + { authoritiveEngineId :: ByteString+ , authoritiveEngineBoots :: Int32+ , authoritiveEngineTime :: Int32+ , userName :: ByteString+ , authenticationParameters :: ByteString+ , privacyParameters :: ByteString+ }+ deriving (Eq)++-- | (snmp3 only) rfc3412, types for ScopedPDU+newtype ContextEngineID = ContextEngineID ByteString deriving (Show, Eq)+newtype ContextName = ContextName ByteString deriving (Show, Eq)++-- | some exception+data ClientException = TimeoutException + | ServerException Integer+ deriving (Typeable, Eq)++-- | class for make binary packet from [ASN1] +class Pack a where+ encode :: a -> ByteString+ decode :: ByteString -> a++-- | some universal getters, setters+class HasItem a where+ getHeader :: Packet -> Header a+ setHeader :: Header a -> Packet -> Packet+ getPDU :: Packet -> PDU a+ setPDU :: PDU a -> Packet -> Packet++-- | (snmp2 only) getters, setters for work with Header V2+class HasV2 a where+ getCommunity :: Header a -> Community+ setCommunity :: Community -> Header a -> Header a++-- | (snmp3 only) getters, setters for work with Header V3 and PDU V3.+class HasV3 a where+ getID :: Header a -> ID+ getMaxSize :: Header a -> MaxSize+ getFlag :: Header a -> Flag+ getSecurityModel :: Header a -> SecurityModel+ getSecurityParameter :: Header a -> SecurityParameter+ getAuthoritiveEngineId :: Header a -> ByteString+ getAuthoritiveEngineBoots :: Header a -> Int32+ getAuthoritiveEngineTime :: Header a -> Int32+ getUserName :: Header a -> ByteString+ getAuthenticationParameters :: Header a -> ByteString+ getPrivacyParameters :: Header a -> ByteString+ getContextEngineID :: PDU a -> ContextEngineID+ getContextName :: PDU a -> ContextName+ setID :: ID -> Header a -> Header a+ setMaxSize :: MaxSize -> Header a -> Header a+ setFlag :: Flag -> Header a -> Header a+ setSecurityModel :: SecurityModel -> Header a -> Header a+ setSecurityParameter :: SecurityParameter -> Header a -> Header a+ setAuthoritiveEngineId :: ByteString -> Header a -> Header a+ setAuthoritiveEngineBoots :: Int32 -> Header a -> Header a+ setAuthoritiveEngineTime :: Int32 -> Header a -> Header a+ setUserName :: ByteString -> Header a -> Header a+ setAuthenticationParameters :: ByteString -> Header a -> Header a+ setPrivacyParameters :: ByteString -> Header a -> Header a+ setContextEngineID :: ContextEngineID -> PDU a -> PDU a+ setContextName :: ContextName -> PDU a -> PDU a++-- | initial new object, like mempty for monoid+class Construct a where+ initial :: a++----------------------------------------------------------------------------------------+instance Construct (Version -> Packet) where+ initial Version3 = V3Packet Version3 initial initial+ initial Version2 = V2Packet Version2 initial initial+ initial Version1 = error "not inplemented"++instance Construct (Header V3) where+ initial = V3Header (ID 0) (MaxSize 65007) (Flag False NoAuthNoPriv) UserBasedSecurityModel initial++instance Construct (Header V2) where+ initial = V2Header (Community "")++instance Construct (PDU V3) where+ initial = ScopedPDU (ContextEngineID "") (ContextName "") initial++instance Construct (PDU V2) where+ initial = PDU initial initial++instance Construct SecurityParameter where+ initial = SecurityParameter "" 0 0 "" "" ""++instance Construct Suite where+ initial = Suite []++instance Construct Request where+ initial = GetRequest 0 0 0+----------------------------------------------------------------------------------------+instance HasItem V2 where+ getHeader (V2Packet _ x _) = x+ getHeader _ = undefined+ setHeader h (V2Packet v _ x) = V2Packet v h x+ setHeader _ _ = undefined+ getPDU (V2Packet _ _ x) = x+ getPDU _ = undefined+ setPDU p (V2Packet v h _) = V2Packet v h p+ setPDU _ _ = undefined++instance HasItem V3 where+ getHeader (V3Packet _ x _) = x+ getHeader _ = undefined+ setHeader h (V3Packet v _ x) = V3Packet v h x+ setHeader _ _ = undefined+ getPDU (V3Packet _ _ x) = x+ getPDU _ = undefined+ setPDU p (V3Packet v h _) = V3Packet v h p+ setPDU _ _ = undefined++instance HasV2 V2 where+ getCommunity (V2Header c) = c+ setCommunity c (V2Header _) = V2Header c++instance HasV3 V3 where+ getID (V3Header i _ _ _ _) = i+ getMaxSize (V3Header _ i _ _ _) = i+ getFlag (V3Header _ _ i _ _) = i+ getSecurityModel (V3Header _ _ _ i _) = i+ getSecurityParameter (V3Header _ _ _ _ i) = i+ getAuthoritiveEngineId = authoritiveEngineId . getSecurityParameter+ getAuthoritiveEngineBoots = authoritiveEngineBoots . getSecurityParameter+ getAuthoritiveEngineTime = authoritiveEngineTime . getSecurityParameter+ getUserName = userName . getSecurityParameter+ getAuthenticationParameters = authenticationParameters . getSecurityParameter+ getPrivacyParameters = privacyParameters . getSecurityParameter+ getContextEngineID (ScopedPDU i _ _) = i+ getContextEngineID _ = undefined+ getContextName (ScopedPDU _ i _) = i+ getContextName _ = undefined+ setID i (V3Header _ a b c d) = V3Header i a b c d+ setMaxSize i (V3Header a _ b c d) = V3Header a i b c d+ setFlag i (V3Header a b _ c d) = V3Header a b i c d+ setSecurityModel i (V3Header a b c _ d) = V3Header a b c i d+ setSecurityParameter i (V3Header a b c d _) = V3Header a b c d i+ setAuthoritiveEngineId i (V3Header a b c d f) = V3Header a b c d (f { authoritiveEngineId = i })+ setAuthoritiveEngineBoots i (V3Header a b c d f) = V3Header a b c d (f { authoritiveEngineBoots = i })+ setAuthoritiveEngineTime i (V3Header a b c d f) = V3Header a b c d (f { authoritiveEngineTime = i })+ setUserName i (V3Header a b c d f) = V3Header a b c d (f { userName = i })+ setAuthenticationParameters i (V3Header a b c d f) = V3Header a b c d (f { authenticationParameters = i })+ setPrivacyParameters i (V3Header a b c d f) = V3Header a b c d (f { privacyParameters = i })+ setContextEngineID i (ScopedPDU _ b c) = ScopedPDU i b c+ setContextEngineID _ _ = undefined+ setContextName i (ScopedPDU a _ b) = ScopedPDU a i b + setContextName _ _ = undefined++----------------------------------------------------------------------------------------+setIDP :: ID -> Packet -> Packet +setIDP x p = + let header = getHeader p :: Header V3+ newHeader = setID x header+ in setHeader newHeader p++setMaxSizeP :: MaxSize -> Packet -> Packet +setMaxSizeP x p = + let header = getHeader p :: Header V3+ newHeader = setMaxSize x header+ in setHeader newHeader p ++setCommunityP :: Community -> Packet -> Packet +setCommunityP x p = + let header = getHeader p :: Header V2+ newHeader = setCommunity x header+ in setHeader newHeader p++getEngineIdP :: Packet -> EngineId+getEngineIdP p = + let header = getHeader p :: Header V3+ in getAuthoritiveEngineId header++setEngineIdP :: EngineId -> Packet -> Packet+setEngineIdP x p =+ let header = getHeader p :: Header V3+ newHeader = setAuthoritiveEngineId x header+ in setHeader newHeader p++getEngineBootsP :: Packet -> EngineBootId+getEngineBootsP p = + let header = getHeader p :: Header V3+ in getAuthoritiveEngineBoots header++setEngineBootsP :: EngineBootId -> Packet -> Packet+setEngineBootsP x p =+ let header = getHeader p :: Header V3+ newHeader = setAuthoritiveEngineBoots x header+ in setHeader newHeader p+ +getEngineTimeP :: Packet -> Int32+getEngineTimeP p = + let header = getHeader p :: Header V3+ in getAuthoritiveEngineTime header++setEngineTimeP :: Int32 -> Packet -> Packet+setEngineTimeP x p =+ let header = getHeader p :: Header V3+ newHeader = setAuthoritiveEngineTime x header+ in setHeader newHeader p++setReportableP :: Reportable -> Packet -> Packet+setReportableP r p = + let header = getHeader p :: Header V3+ Flag _ a = getFlag header+ newHeader = setFlag (Flag r a) header+ in setHeader newHeader p++setPrivAuthP :: PrivAuth -> Packet -> Packet+setPrivAuthP x p = + let header = getHeader p :: Header V3+ Flag r _ = getFlag header+ newHeader = setFlag (Flag r x) header+ in setHeader newHeader p++setUserNameP :: ByteString -> Packet -> Packet +setUserNameP x p = + let header = getHeader p :: Header V3+ sp = getSecurityParameter header+ newHeader = setSecurityParameter (sp { userName = x }) header+ in setHeader newHeader p++setAuthenticationParametersP :: ByteString -> Packet -> Packet +setAuthenticationParametersP x p = + let header = getHeader p :: Header V3+ sp = getSecurityParameter header+ newHeader = setSecurityParameter (sp { authenticationParameters = x }) header+ in setHeader newHeader p+ +getAuthenticationParametersP :: Packet -> ByteString+getAuthenticationParametersP p = + let header = getHeader p :: Header V3+ in authenticationParameters (getSecurityParameter header)++setPrivParametersP :: ByteString -> Packet -> Packet +setPrivParametersP x p = + let header = getHeader p :: Header V3+ sp = getSecurityParameter header+ newHeader = setSecurityParameter (sp { privacyParameters = x }) header+ in setHeader newHeader p++getPrivParametersP :: Packet -> ByteString+getPrivParametersP p =+ let header = getHeader p :: Header V3+ in privacyParameters $ getSecurityParameter header+++getVersion :: Packet -> Version+getVersion (V2Packet v _ _) = v+getVersion (V3Packet v _ _) = v++getRid :: Packet -> RequestId +getRid (V2Packet _ _ (PDU r _)) = rid r +getRid (V3Packet _ _ (ScopedPDU _ _ (PDU r _))) = rid r +getRid _ = undefined++setRid :: RequestId -> Packet -> Packet+setRid r (V2Packet v h (PDU req s)) = V2Packet v h (PDU req { rid = r } s)+setRid r (V3Packet v h (ScopedPDU a b (PDU req s))) = V3Packet v h (ScopedPDU a b (PDU req { rid = r } s))+setRid _ _ = undefined++getErrorStatus :: Packet -> ErrorStatus +getErrorStatus (V2Packet _ _ (PDU r _)) = es r +getErrorStatus (V3Packet _ _ (ScopedPDU _ _ (PDU r _))) = es r +getErrorStatus _ = undefined++setErrorStatus :: ErrorStatus -> Packet -> Packet+setErrorStatus e (V2Packet v h (PDU req s)) = V2Packet v h (PDU req { es = e } s)+setErrorStatus e (V3Packet v h (ScopedPDU a b (PDU req s))) = V3Packet v h (ScopedPDU a b (PDU req { es = e } s))+setErrorStatus _ _ = undefined++getSuite :: Packet -> Suite+getSuite (V2Packet _ _ (PDU _ r)) = r +getSuite (V3Packet _ _ (ScopedPDU _ _ (PDU _ r))) = r +getSuite _ = undefined++setSuite :: Suite -> Packet -> Packet+setSuite s (V2Packet v h (PDU req _)) = V2Packet v h (PDU req s)+setSuite s (V3Packet v h (ScopedPDU a b (PDU req _))) = V3Packet v h (ScopedPDU a b (PDU req s))+setSuite _ _ = undefined++getRequest :: Packet -> Request+getRequest (V2Packet _ _ (PDU r _)) = r +getRequest (V3Packet _ _ (ScopedPDU _ _ (PDU r _))) = r +getRequest _ = undefined++setRequest :: Request -> Packet -> Packet+setRequest req (V2Packet v h (PDU _ s)) = V2Packet v h (PDU req s)+setRequest req (V3Packet v h (ScopedPDU a b (PDU _ s))) = V3Packet v h (ScopedPDU a b (PDU req s))+setRequest _ _ = undefined+----------------------------------------------------------------------------------------++instance ASN1Object (Header V2) where+ toASN1 (V2Header c) = toASN1 c + fromASN1 asn = flip runParseASN1State asn $ V2Header <$> getObject++sS :: ParseASN1 ()+sS = do+ Start Sequence <- getNext+ return ()++eS :: ParseASN1 ()+eS = do+ End Sequence <- getNext+ return ()++instance ASN1Object (Header V3) where+ toASN1 (V3Header i ms f sm sp) xs = + Start Sequence : toASN1 i (toASN1 ms (toASN1 f (toASN1 sm [End Sequence]))) ++ toASN1 sp xs+ fromASN1 asn = flip runParseASN1State asn $+ V3Header <$> (sS *> getObject) <*> getObject <*> getObject <*> (getObject <* eS) <*> getObject++instance ASN1Object (PDU V2) where+ toASN1 (PDU (GetRequest rid _ _ ) sd) xs = (Start $ Container Context 0):IntVal (fromIntegral rid) : IntVal 0 : IntVal 0 : Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 0)] ++ xs+ toASN1 (PDU (GetNextRequest rid _ _) sd) xs = (Start $ Container Context 1):IntVal (fromIntegral rid) : IntVal 0 : IntVal 0 : Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 1)] ++ xs+ toASN1 (PDU (GetResponse rid es ei ) sd) xs = (Start $ Container Context 2):IntVal (fromIntegral rid) : IntVal es : IntVal ei: Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 2)] ++ xs+ toASN1 (PDU (SetRequest rid _ _ ) sd) xs = (Start $ Container Context 3):IntVal (fromIntegral rid) : IntVal 0 : IntVal 0 : Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 3)] ++ xs+ toASN1 (PDU (GetBulk rid es ei ) sd) xs = (Start $ Container Context 5):IntVal (fromIntegral rid) : IntVal es : IntVal ei: Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 4)] ++ xs+ toASN1 (PDU (Inform rid es ei ) sd) xs = (Start $ Container Context 6):IntVal (fromIntegral rid) : IntVal es : IntVal ei: Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 4)] ++ xs+ toASN1 (PDU (V2Trap rid es ei ) sd) xs = (Start $ Container Context 7):IntVal (fromIntegral rid) : IntVal es : IntVal ei: Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 4)] ++ xs+ toASN1 (PDU (Report rid es ei ) sd) xs = (Start $ Container Context 8):IntVal (fromIntegral rid) : IntVal es : IntVal ei: Start Sequence : toASN1 sd [] ++ [ End Sequence, End (Container Context 8)] ++ xs+ fromASN1 asn = runParseASN1State pduParser asn ++pduParser :: ParseASN1 (PDU V2)+pduParser = do+ Start (Container Context n) <- getNext+ IntVal rid' <- getNext+ IntVal es <- getNext+ IntVal ei <- getNext+ x <- getNextContainer Sequence + End (Container Context _) <- getNext+ let psuite = fromASN1 x+ rid = fromIntegral rid'+ case (n, psuite) of+ (0, Right (suite, _)) -> return $ PDU (GetRequest rid es ei) suite+ (1, Right (suite, _)) -> return $ PDU (GetNextRequest rid es ei) suite+ (2, Right (suite, _)) -> return $ PDU (GetResponse rid es ei) suite+ (3, Right (suite, _)) -> return $ PDU (SetRequest rid es ei) suite+ (5, Right (suite, _)) -> return $ PDU (GetBulk rid es ei) suite+ (6, Right (suite, _)) -> return $ PDU (Inform rid es ei) suite+ (7, Right (suite, _)) -> return $ PDU (V2Trap rid es ei) suite+ (8, Right (suite, _)) -> return $ PDU (Report rid es ei) suite+ _ -> throw $ ServerException 9++instance ASN1Object (PDU V3) where+ toASN1 (ScopedPDU (ContextEngineID x) (ContextName y) pdu) xs = + [Start Sequence, OctetString x, OctetString y] ++ toASN1 pdu (End Sequence :xs)+ toASN1 (CryptedPDU cryptedBody) xs = OctetString cryptedBody : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ whatIs <- getNext+ case whatIs of+ Start Sequence -> do+ OctetString x <- getNext+ OctetString y <- getNext+ p <- pduParser + End Sequence <- getNext+ return $ ScopedPDU (ContextEngineID x) (ContextName y) p+ OctetString x -> return $ CryptedPDU x+ _ -> throw $ ServerException 9++instance ASN1Object Version where+ toASN1 Version1 xs = IntVal 0 : xs+ toASN1 Version2 xs = IntVal 1 : xs+ toASN1 Version3 xs = IntVal 3 : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ IntVal x <- getNext+ case x of + 0 -> return Version1+ 1 -> return Version2+ 3 -> return Version3+ _ -> throw $ ServerException 10++instance ASN1Object Packet where+ toASN1 (V2Packet Version2 header body) _ = Start Sequence : toASN1 Version2 (toASN1 header (toASN1 body [End Sequence]))+ toASN1 (V3Packet Version3 header body) _ = Start Sequence : toASN1 Version3 (toASN1 header (toASN1 body [End Sequence]))+ toASN1 _ _ = throw $ ServerException 10+ fromASN1 asn = flip runParseASN1State asn $ onNextContainer Sequence $ do+ v <- getObject+ case v of+ Version2 -> V2Packet Version2 <$> getObject <*> getObject+ Version3 -> V3Packet Version3 <$> getObject <*> getObject+ _ -> throw $ ServerException 10++instance ASN1Object Value where+ toASN1 NoSuchObject xs = Other Context 0 "" : xs+ toASN1 NoSuchInstance xs = Other Context 1 "" : xs+ toASN1 EndOfMibView xs = Other Context 2 "" : xs+ toASN1 (OI x) xs = OID x : xs+ toASN1 Zero xs = Null : xs+ toASN1 ZeroDotZero xs = OID [0,0] : xs+ toASN1 (Integer x) xs = IntVal (fI x) : xs+ toASN1 (String x) xs = OctetString x : xs+ toASN1 (IpAddress a1 a2 a3 a4) xs = Other Application 0 (B.pack [a1, a2, a3, a4]) : xs+ toASN1 (Counter32 x) xs = Other Application 1 (packInteger (fI x)) : xs+ toASN1 (Gaude32 x) xs = Other Application 2 (packInteger (fI x)) : xs+ toASN1 (TimeTicks x) xs = Other Application 3 (packInteger (fI x)) : xs+ toASN1 (Opaque x) xs = Other Application 4 x : xs+ toASN1 (Counter64 x) xs = Other Application 6 (packInteger (fI x)) : xs+ fromASN1 asn = runParseASN1State (unp =<< getNext) asn+ where+ unp (Other Context 0 "") = return NoSuchObject+ unp (Other Context 1 "") = return NoSuchInstance+ unp (Other Context 2 "") = return EndOfMibView+ unp Null = return Zero+ unp (OID [0,0]) = return ZeroDotZero+ unp (IntVal x) = return $ Integer (fI x)+ unp (OctetString x) = return $ String x+ unp (Other Application 0 y) = let [a1, a2, a3, a4] = B.unpack y+ in return $ IpAddress a1 a2 a3 a4+ unp (Other Application 1 y) = case unpackInteger y of+ Right z -> return $ Counter32 (fI z)+ Left _ -> throw $ ServerException 9+ unp (Other Application 2 y) = case unpackInteger y of+ Right z -> return $ Gaude32 (fI z)+ Left _ -> throw $ ServerException 9+ unp (Other Application 3 y) = case unpackInteger y of+ Right z -> return $ TimeTicks (fI z)+ Left _ -> throw $ ServerException 9+ unp (Other Application 4 y) = return $ Opaque y+ unp (Other Application 6 y) = case unpackInteger y of+ Right z -> return $ Counter64 (fI z)+ Left _ -> throw $ ServerException 9+ unp (OID x) = return . OI $ x+ unp _ = throw $ ServerException 9++instance ASN1Object Community where+ toASN1 (Community x) xs = OctetString x : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ OctetString x <- getNext+ return $ Community x++instance Show SecurityParameter where+ show msg = "SecurityParameter:\n\t\tAuthoritiveEngineId: " + ++ show (authoritiveEngineId msg )+ ++ "\n\t\tAuthoritiveEngineBoots: " ++ show (authoritiveEngineBoots msg )+ ++ "\n\t\tAuthoritiveEngineTime: " ++ show (authoritiveEngineTime msg )+ ++ "\n\t\tUserName: " ++ show (userName msg )+ ++ "\n\t\tAuthenticationParameters: " ++ show (authenticationParameters msg )+ ++ "\n\t\tPrivacyParameters: " ++ show (privacyParameters msg )++instance ASN1Object ID where+ toASN1 (ID x) xs = IntVal (fromIntegral x) : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ IntVal x <- getNext+ return $ ID (fromIntegral x)++instance ASN1Object MaxSize where+ toASN1 (MaxSize x) xs = IntVal x : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ IntVal x <- getNext+ return $ MaxSize x++instance ASN1Object Flag where+ toASN1 (Flag r pa) xs = let zero = zeroBits :: Word8+ reportable = if r then setBit zero 0 else zero+ privauth = case pa of+ NoAuthNoPriv -> zero+ AuthNoPriv -> setBit zero 2+ AuthPriv -> setBit zero 1 .|. setBit zero 2+ flag = reportable .|. privauth+ in OctetString (B.pack [flag]) : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ OctetString x <- getNext+ let [w] = B.unpack x+ return $ case (testBit w 0, testBit w 1) of+ (True, True) -> Flag (testBit w 2) AuthPriv+ (False, False) -> Flag (testBit w 2) NoAuthNoPriv+ (True, False) -> Flag (testBit w 2) AuthNoPriv+ _ -> throw $ ServerException 10+++instance ASN1Object SecurityModel where+ toASN1 UserBasedSecurityModel xs = IntVal 3 : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ IntVal x <- getNext+ case x of+ 3 -> return UserBasedSecurityModel+ _ -> throw $ ServerException 7++instance ASN1Object SecurityParameter where+ toASN1 SecurityParameter{..} xs = OctetString (encodeASN1' DER+ [ Start Sequence+ , OctetString authoritiveEngineId + , IntVal $ fromIntegral authoritiveEngineBoots + , IntVal $ fromIntegral authoritiveEngineTime + , OctetString userName + , OctetString authenticationParameters + , OctetString privacyParameters + , End Sequence+ ]) : xs+ fromASN1 asn = flip runParseASN1State asn $ do+ OctetString packed <- getNext+ let r = case decodeASN1' DER packed of+ Left _ -> throw $ ServerException 9+ Right asn' -> parseMsgSecurityParameter asn'+ case r of+ Left _ -> throw $ ServerException 9+ Right r' -> return r'++parseMsgSecurityParameter :: [ASN1] -> Either String SecurityParameter+parseMsgSecurityParameter asn = flip runParseASN1 asn $ do+ Start Sequence <- getNext+ OctetString msgAuthoritiveEngineId <- getNext+ IntVal msgAuthoritiveEngineBoots <- getNext+ IntVal msgAuthoritiveEngineTime <- getNext+ OctetString msgUserName <- getNext+ OctetString msgAuthenticationParameters <- getNext+ OctetString msgPrivacyParameters <- getNext+ End Sequence <- getNext+ return $ SecurityParameter msgAuthoritiveEngineId (fromIntegral msgAuthoritiveEngineBoots) (fromIntegral msgAuthoritiveEngineTime) msgUserName msgAuthenticationParameters msgPrivacyParameters ++instance Pack (PDU V3) where+ encode s = encodeASN1' DER $ toASN1 s []+ decode = toP++toP :: ByteString -> PDU V3+toP bs = let a = fromASN1 <$> decodeASN1' DER bs+ in case a of+ Right (Right (r, _)) -> r+ _ -> throw $ ServerException 9++instance Pack Packet where+ encode s = encodeASN1' DER $ toASN1 s []+ decode = toB ++toB :: ByteString -> Packet +toB bs = let a = fromASN1 <$> decodeASN1' DER bs+ in case a of+ Right (Right (r, _)) -> r+ _ -> throw $ ServerException 9+ --}+ --+instance Show Coupla where+ show (Coupla o v) = oidToString o ++ " = " ++ show v++instance Show Suite where+ show (Suite xs) = unlines $ map show xs++oidToString :: OID -> String+oidToString xs = foldr1 (\x y -> x ++ "." ++ y) $ map show xs++instance ASN1Object Suite where+ toASN1 (Suite xs) ys = foldr toA [] xs ++ ys+ where + toA ::Coupla -> [ASN1] -> [ASN1]+ toA (Coupla o v) zs = [Start Sequence , OID o] ++ toASN1 v (End Sequence : zs)+ fromASN1 asn = flip runParseASN1State asn $ do+ xs <- getMany $ do+ Start Sequence <- getNext+ OID x <- getNext+ v <- getObject+ End Sequence <- getNext+ return $ Coupla x v+ return $ Suite xs++instance Show ClientException where+ show TimeoutException = "Timeout exception"+ show (ServerException 1) = "tooBig"+ show (ServerException 2) = "noSuchName"+ show (ServerException 3) = "badValue"+ show (ServerException 4) = "readOnly"+ show (ServerException 5) = "genErr"+ show (ServerException 6) = "noAccess"+ show (ServerException 7) = "wrongType"+ show (ServerException 8) = "wrongLength"+ show (ServerException 9) = "wrongEncoding"+ show (ServerException 10) = "wrongValue"+ show (ServerException 11) = "noCreation"+ show (ServerException 12) = "inconsistentValue"+ show (ServerException 13) = "resourceUnavailable"+ show (ServerException 14) = "commitFailed"+ show (ServerException 15) = "undoFailed"+ show (ServerException 16) = "authorizationError"+ show (ServerException 17) = "notWritable"+ show (ServerException 18) = "inconsistentName"+ show (ServerException 80) = "General IO failure occured on the set request"+ show (ServerException 81) = "General SNMP timeout occured"+ show (ServerException x) = "Exception " ++ show x++instance Exception ClientException++-- copy paste from asn1-encoding++packInteger :: Integer -> ByteString+packInteger = B.pack . bytesOfInt ++unpackInteger :: ByteString -> Either String Integer+unpackInteger = getIntegerRaw "Integer"++bytesOfInt :: Integer -> [Word8]+bytesOfInt i+ | i > 0 = if testBit (head uints) 7 then 0 : uints else uints+ | i == 0 = [0]+ | otherwise = if testBit (head nints) 7 then nints else 0xff : nints+ where+ uints = bytesOfUInt (abs i)+ nints = reverse $ plusOne $ reverse $ map complement uints+ plusOne [] = [1]+ plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs+++--bytesOfUInt i = B.unfoldr (\x -> if x == 0 then Nothing else Just (fromIntegral (x .&. 0xff), x `shiftR` 8)) i+bytesOfUInt :: Integer -> [Word8]+bytesOfUInt x = reverse (list x)+ where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8)++{- | According to X.690 section 8.4 integer and enumerated values should be encoded the same way. -}+getIntegerRaw :: String -> ByteString -> Either String Integer+getIntegerRaw typestr s+ | B.length s == 0 = Left $ typestr ++ ": null encoding"+ | B.length s == 1 = Right $ snd $ intOfBytes s+ | otherwise =+ if (v1 == 0xff && testBit v2 7) || (v1 == 0x0 && not (testBit v2 7))+ then Left $ typestr ++ ": not shortest encoding"+ else Right $ snd $ intOfBytes s+ where+ v1 = s `B.index` 0+ v2 = s `B.index` 1++{- | intOfBytes returns the number of bytes in the list and+the represented integer by a two's completement list of bytes -}+intOfBytes :: ByteString -> (Int, Integer)+intOfBytes b+ | B.length b == 0 = (0, 0)+ | otherwise = (len, if isNeg then -(maxIntLen - v + 1) else v)+ where+ (len, v) = uintOfBytes b+ maxIntLen = 2 ^ (8 * len) - 1+ isNeg = testBit (B.head b) 7++{- | uintOfBytes returns the number of bytes and the unsigned integer represented by the bytes -}+uintOfBytes :: ByteString -> (Int, Integer)+uintOfBytes b = (B.length b, B.foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 b)++------------------------------------------------------------------------------------------------------++cleanPass :: ByteString+cleanPass = B.pack $ replicate 12 0x00+ +data PrivType = DES | AES deriving (Show, Eq)+data AuthType = MD5 | SHA deriving (Show, Eq)+type Key = ByteString+type Password = ByteString++hash :: AuthType -> ByteString -> ByteString+hash MD5 = Md5.hash+hash SHA = Sha.hash++hashlazy :: AuthType -> BL.ByteString -> ByteString+hashlazy MD5 = Md5.hashlazy+hashlazy SHA = Sha.hashlazy++-- | (only V3) sign Packet +signPacket :: AuthType -> Key -> Packet -> Packet +signPacket at key packet = + let packetAsBin = encode packet+ sign = B.take 12 $ HMAC.hmac (hash at) 64 key packetAsBin + in setAuthenticationParametersP sign packet++-- | create auth key from password and context engine id+passwordToKey :: AuthType -> Password -> EngineId -> Key+passwordToKey at pass eid = + let buf = BL.take 1048576 $ BL.fromChunks $ repeat pass+ authKey = hashlazy at buf+ in hash at $ authKey <> eid <> authKey++-----------------------------------------------------------------------------------------------------++type EngineBootId = Int32+type PrivacyParameter = ByteString+type EngineId = ByteString+type Salt = ByteString+type Encrypted = ByteString+type Raw = ByteString+type Rand32 = Int32+type Rand64 = Int64++desEncrypt :: Key -> EngineBootId -> Rand32 -> Raw -> (Encrypted, Salt)+desEncrypt privKey engineBoot localInt dataToEncrypt = + let desKey = B.take 8 privKey+ preIV = B.drop 8 $ B.take 16 privKey+ salt = toSalt engineBoot localInt+ ivR = B.pack $ zipWith xor (B.unpack preIV) (B.unpack salt)+ Just iv = Priv.makeIV ivR+ Right key = Priv.makeKey desKey + des = Priv.cipherInit key :: Priv.DES+ tailLen = (8 - B.length dataToEncrypt `rem` 8) `rem` 8+ tailB = B.replicate tailLen 0x00+ in (Priv.cbcEncrypt des iv (dataToEncrypt <> tailB), salt)++type EngineTime = Int32++aesEncrypt :: Key -> EngineBootId -> EngineTime -> Rand64 -> Raw -> (Encrypted, Salt)+aesEncrypt privKey engineBoot engineTime rcounter dataToEncrypt =+ let aesKey = B.take 16 privKey+ salt = wToBs rcounter+ Just iv = Priv.makeIV $ toSalt engineBoot engineTime <> salt+ Right key = Priv.makeKey aesKey+ aes = Priv.cipherInit key :: Priv.AES128+ in (Priv.cfbEncrypt aes iv dataToEncrypt, salt)+++wToBs :: Int64 -> ByteString+wToBs x = B.pack+ [ fromIntegral $ x `shiftR` 56 .&. 0xff+ , fromIntegral $ x `shiftR` 48 .&. 0xff+ , fromIntegral $ x `shiftR` 40 .&. 0xff+ , fromIntegral $ x `shiftR` 32 .&. 0xff+ , fromIntegral $ x `shiftR` 24 .&. 0xff+ , fromIntegral $ x `shiftR` 16 .&. 0xff+ , fromIntegral $ x `shiftR` 8 .&. 0xff+ , fromIntegral $ x `shiftR` 0 .&. 0xff+ ]++toSalt :: Int32 -> Int32 -> ByteString+toSalt x y = B.pack+ [ fromIntegral $ x `shiftR` 24 .&. 0xff + , fromIntegral $ x `shiftR` 16 .&. 0xff+ , fromIntegral $ x `shiftR` 8 .&. 0xff+ , fromIntegral $ x `shiftR` 0 .&. 0xff+ , fromIntegral $ y `shiftR` 24 .&. 0xff+ , fromIntegral $ y `shiftR` 16 .&. 0xff+ , fromIntegral $ y `shiftR` 8 .&. 0xff+ , fromIntegral $ y `shiftR` 0 .&. 0xff+ ]++desDecrypt :: Key -> Salt -> Encrypted -> Raw+desDecrypt privKey privParameters dataToDecrypt =+ let desKey = B.take 8 privKey+ preIV = B.drop 8 $ B.take 16 privKey+ salt = privParameters+ ivR = zipWith xor (B.unpack preIV) (B.unpack salt)+ Just iv = Priv.makeIV (B.pack ivR)+ Right key = Priv.makeKey desKey+ des = Priv.cipherInit key :: Priv.DES+ in stripBS $ Priv.cbcDecrypt des iv dataToDecrypt++aesDecrypt :: Key -> Salt -> EngineBootId -> EngineTime -> Encrypted -> Raw+aesDecrypt privKey privParameters engineBoot engineTime dataToDecrypt =+ let aesKey = B.take 16 privKey+ salt = privParameters+ ivR = toSalt engineBoot engineTime <> salt+ Just iv = Priv.makeIV ivR+ Right key = Priv.makeKey aesKey+ aes = Priv.cipherInit key :: Priv.AES128+ in stripBS $ Priv.cfbDecrypt aes iv dataToDecrypt++stripBS :: ByteString -> ByteString+stripBS bs = + let bs' = B.drop 1 bs+ l1 = fromIntegral $ B.head bs'+ in if testBit l1 7+ then case clearBit l1 7 of+ 0 -> throw $ ServerException 12+ len -> + let size = uintbs (B.take len (B.drop 1 bs'))+ in B.take (size + len + 2) bs+ else B.take (l1 + 2) bs+ where+ {- uintbs return the unsigned int represented by the bytes -}+ uintbs = B.foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0+
+ src/Network/Snmp/Client.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+module Network.Snmp.Client (+-- * types+ Client+, Port+, Hostname+, Login+, Password+, Version(..)+, Community(..)+, Config(..)+, Coupla(..)+, Suite(..)+, PrivAuth(..)+, AuthType(..)+, Value(String, Integer, IpAddress, Counter32, Gaude32, TimeTicks, Opaque, Counter64, ZeroDotZero, Zero, OI)+-- * client +, client+-- ** client methods+, get+, bulkget+, getnext+, walk+, bulkwalk+, set+, close+-- * usefull functions+, oidFromBS+)+where++import Network.Protocol.Snmp+import Network.Snmp.Client.Types+import Network.Snmp.Client.Internal+import Network.Snmp.Client.Version2+import Network.Snmp.Client.Version3++client :: Config -> IO Client+client conf@ConfigV2{..} = clientV2 hostname + port + timeout + community+client conf@ConfigV3{..} = clientV3 hostname + port + timeout + sequrityName + authPass + privPass + sequrityLevel + authType + privType
+ src/Network/Snmp/Client/Internal.hs view
@@ -0,0 +1,67 @@+module Network.Snmp.Client.Internal +( oidFromBS+, makeSocket+, succCounter+, predCounter+, lastS+, isUpLevel+, uniqID+)+where++import Data.ByteString (ByteString)+import Network.Socket hiding (recv, socket, close)+import qualified Network.Socket as NS+import qualified Data.ByteString.Char8 as C+import Control.Applicative ((<$>))+import Data.Maybe (catMaybes)+import Network.Protocol.Snmp (Coupla, Suite(..), OID)+import Network.Snmp.Client.Types (Port, Hostname)+import Data.IORef (IORef, atomicModifyIORef')+import Network.Info+import Data.Int++oidFromBS :: ByteString -> [Integer]+oidFromBS xs = catMaybes $ map (\x -> fst <$> C.readInteger x) $ C.splitWith (== '.') xs++makeSocket :: Hostname -> Port -> IO Socket+makeSocket hostname port = do+ serverAddress <- head <$> getAddrInfo (Just defaultHints) (Just hostname) (Just port)+ sock <- NS.socket (addrFamily serverAddress) Datagram defaultProtocol+ connect sock (addrAddress serverAddress)+ return sock++succCounter :: (Bounded a, Integral a) => IORef a -> IO a+succCounter ref = atomicModifyIORef' ref check + where+ check x + | x < maxBound = (succ x, succ x)+ | otherwise = (0, 0)+ +predCounter :: (Bounded a, Integral a) => IORef a -> IO a+predCounter ref = atomicModifyIORef' ref check + where+ check x+ | x > 0 = (pred x, pred x)+ | otherwise = (maxBound, maxBound)++lastS :: Suite -> Coupla+lastS (Suite xs) = last xs++isUpLevel :: OID -> OID -> Bool+isUpLevel new old = let baseLength = length old+ in old /= take baseLength new ++uniqID :: IO Int32+uniqID = do+ nf <- getNetworkInterfaces+ let zeroMac = MAC 0 0 0 0 0 0+ zeroIp = IPv4 0+ ipToW (IPv4 x) = x+ return $ abs . fromIntegral $ case filter (\x -> ipv4 x /= zeroIp && mac x /= zeroMac ) nf of+ [] -> 1000000 -- i cant find ip address+ [x] -> ipToW (ipv4 x)+ x:_ -> ipToW (ipv4 x)+++
+ src/Network/Snmp/Client/Types.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+module Network.Snmp.Client.Types where++import Network.Protocol.Snmp+import Data.ByteString (ByteString)+++type Hostname = String+type Port = String+type Login = ByteString+++data Config = ConfigV2+ { hostname :: Hostname+ , port :: Port+ , timeout :: Int+ , community :: Community+ } | ConfigV3+ { hostname :: Hostname+ , port :: Port+ , timeout :: Int+ , sequrityName :: Login+ , authPass :: Password+ , privPass :: Password+ , sequrityLevel :: PrivAuth+ , context :: ByteString+ , authType :: AuthType+ , privType :: PrivType+ }+ deriving (Show, Eq)++sec :: Int -> Int+sec = (* 1000000)++data Client = Client + { get :: OIDS -> IO Suite+ , bulkget :: OIDS -> IO Suite + , getnext :: OIDS -> IO Suite+ , walk :: OIDS -> IO Suite+ , bulkwalk :: OIDS -> IO Suite+ , set :: Suite -> IO Suite+ , close :: IO ()+ }++instance Construct (Version -> Config) where+ initial Version1 = ConfigV2 "localhost" "161" (sec 5) (Community "public") + initial Version2 = ConfigV2 "localhost" "161" (sec 5) (Community "public")+ initial Version3 = ConfigV3 "localhost" "161" (sec 5) "guest" "" "" AuthNoPriv "" MD5 DES++
+ src/Network/Snmp/Client/Version2.hs view
@@ -0,0 +1,100 @@+module Network.Snmp.Client.Version2+( clientV2+)+where++import Network.Socket hiding (recv, socket, close)+import qualified Network.Socket as NS+import Network.Socket.ByteString (recv, sendAll)+import Control.Applicative ((<$>))+import Control.Concurrent.Async+import Data.IORef (newIORef)+import Control.Concurrent (threadDelay)+import Control.Exception+import Control.Monad (when)+import Data.Monoid ((<>), mconcat, mempty)++import Network.Protocol.Snmp hiding (rid)+import Network.Snmp.Client.Internal+import Network.Snmp.Client.Types hiding (timeout, community, hostname, port)++v2 :: Packet+v2 = initial Version2++returnResult2 :: NS.Socket -> Int -> IO Suite+returnResult2 socket timeout = do+ result <- race (threadDelay timeout) (decode <$> recv socket 1500 :: IO Packet)+ case result of+ Right packet -> do+ when (getErrorStatus packet /= 0) $ throwIO $ ServerException $ getErrorStatus packet+ return $ getSuite packet+ Left _ -> throwIO TimeoutException ++setRCS :: Community -> OIDS -> Packet -> Packet+setRCS c o = setCommunityP c . setSuite (Suite $ map (`Coupla` Zero) o)++clientV2 :: Hostname -> Port -> Int -> Community -> IO Client+clientV2 hostname port timeout community = do+ socket <- makeSocket hostname port + uniqInteger <- uniqID+ ref <- newIORef uniqInteger+ let + req oids = setRCS community oids v2+ get' oids = withSocketsDo $ do+ rid <- succCounter ref+ sendAll socket $ encode $ setRequest (GetRequest rid 0 0) (req oids) + returnResult2 socket timeout++ bulkget' oids = withSocketsDo $ do+ rid <- succCounter ref+ sendAll socket $ encode $ setRequest (GetBulk rid 0 10) (req oids)+ returnResult2 socket timeout++ getnext' oids = withSocketsDo $ do+ rid <- succCounter ref+ sendAll socket $ encode $ setRequest (GetNextRequest rid 0 0) (req oids)+ returnResult2 socket timeout++ walk' oids base accumulator + | oids == base = do+ first <- get' [oids]+ next <- getnext' [oids]+ case (first, next) of+ (Suite [Coupla _ NoSuchObject], Suite [Coupla nextOid _]) -> walk' nextOid base next+ (Suite [Coupla _ NoSuchInstance], Suite [Coupla nextOid _]) -> walk' nextOid base next+ (Suite [Coupla _ EndOfMibView], _) -> return accumulator+ (_, Suite [Coupla nextOid _]) -> walk' nextOid base first+ (_, _) -> throwIO $ ServerException 5+ | otherwise = do+ nextData <- getnext' [oids]+ let Suite [Coupla next v] = nextData+ case (isUpLevel next base, v) of+ (True, _) -> return accumulator+ (_, NoSuchObject) -> walk' next base accumulator+ (_, NoSuchInstance) -> walk' next base accumulator+ (_, EndOfMibView) -> return accumulator+ (_, _) -> walk' next base (accumulator <> nextData) ++ bulkwalk' oids base accumulator = do+ first <- bulkget' [oids]+ let Coupla next snmpData = lastS first+ filtered (Suite xs) = Suite $ filter (\(Coupla x _) -> not $ isUpLevel x base) xs+ case (isUpLevel next base , snmpData) of+ (_, EndOfMibView) -> return $ accumulator <> filtered first+ (False, _) -> bulkwalk' next base (accumulator <> first)+ (True, _) -> return $ accumulator <> filtered first+ set' oids = withSocketsDo $ do+ rid <- succCounter ref+ sendAll socket $ encode $ setRequest (SetRequest rid 0 0) . setCommunityP community . setSuite oids $ v2+ returnResult2 socket timeout++ return Client + { get = get'+ , bulkget = bulkget'+ , getnext = getnext'+ , walk = \oids -> mconcat <$> mapM (\oi -> walk' oi oi mempty) oids+ , bulkwalk = \oids -> mconcat <$> mapM (\oi -> bulkwalk' oi oi mempty) oids+ , set = set' + , close = NS.close socket+ } +
+ src/Network/Snmp/Client/Version3.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GADTs #-}+module Network.Snmp.Client.Version3 +( clientV3+)+where++import Data.ByteString (ByteString)+import Network.Socket hiding (recv, socket, close)+import qualified Network.Socket as NS+import Network.Socket.ByteString (recv, sendAll)+import Control.Applicative ((<$>))+import Control.Concurrent.Async+import Data.IORef (newIORef, IORef, readIORef, atomicWriteIORef)+import Control.Concurrent (threadDelay)+import Control.Monad (when)+import Data.ASN1.Types hiding (Context) +import Data.Monoid ((<>), mempty, mconcat)+import Data.Int+import Control.Exception +import System.Random (randomIO)++import Network.Protocol.Snmp+import Network.Snmp.Client.Types+import Network.Snmp.Client.Internal ++v3 :: Packet +v3 = initial Version3 ++data ST = ST+ { authCache' :: IORef (Maybe ByteString)+ , privCache' :: IORef (Maybe ByteString)+ , engine' :: IORef (Maybe (ByteString, Int32, Int32))+ , ref' :: IORef Int32+ , salt32 :: IORef Int32+ , salt64 :: IORef Int64+ , securityLevel' :: PrivAuth+ , authType' :: AuthType+ , privType' :: PrivType+ , timeout' :: Int+ , socket' :: Socket+ , login' :: Login+ , authPass' :: Password+ , privPass' :: Password+ } ++clientV3 :: Hostname -> Port -> Int -> Login -> Password -> Password -> PrivAuth -> AuthType -> PrivType -> IO Client+clientV3 hostname port timeout sequrityName authPass privPass securityLevel authType privType = do+ socket <- makeSocket hostname port + uniqInteger <- uniqID+ ref <- newIORef uniqInteger+ salt32 <- newIORef =<< abs <$> randomIO+ salt64 <- newIORef =<< abs <$> randomIO+ authCache <- newIORef Nothing+ privCache <- newIORef Nothing+ engine <- newIORef Nothing+ let st = ST authCache privCache engine ref salt32 salt64 securityLevel authType privType timeout socket sequrityName authPass privPass+ return $ Client + { get = get' st+ , bulkget = bulkget' st+ , getnext = getnext' st+ , walk = \oids -> mconcat <$> mapM (\oi -> walk' st oi oi mempty) oids+ , bulkwalk = \oids -> mconcat <$> mapM (\oi -> bulkwalk' st oi oi mempty) oids+ , set = set' st+ , close = NS.close socket+ }+++init' :: ST -> IO (ByteString, Int32, Int32)+init' st = withSocketsDo $ do+ rid <- predCounter (ref' st)+ sendAll (socket' st) $ encode $ packet' rid+ resp <- decode <$> recv (socket' st) 1500 :: IO Packet+ atomicWriteIORef (engine' st) $ Just (getEngineIdP resp, getEngineBootsP resp, getEngineTimeP resp) + return (getEngineIdP resp, getEngineBootsP resp, getEngineTimeP resp)+ where+ packet' x = ( setIDP (ID x)+ . setMaxSizeP (MaxSize 1500)+ . setReportableP False+ . setPrivAuthP NoAuthNoPriv+ . setRid x+ ) v3+++get' :: ST -> OIDS -> IO Suite+get' st oids = withSocketsDo $ do+ full <- packet st (toEmptySuite oids) GetRequest+ sendPacket st full+ packet' <- decryptPacketWithCache st =<< returnResult st+ checkError packet'+ return $ getSuite packet'++bulkget' :: ST -> OIDS -> IO Suite+bulkget' st oids = withSocketsDo $ do+ full <- packet st (toEmptySuite oids) GetBulk+ sendPacket st full+ packet' <- decryptPacketWithCache st =<< returnResult st+ checkError packet'+ return $ getSuite packet'++getnext' :: ST -> OIDS -> IO Suite+getnext' st oids = withSocketsDo $ do+ full <- packet st (toEmptySuite oids) GetNextRequest+ sendPacket st full+ packet' <- decryptPacketWithCache st =<< returnResult st+ checkError packet'+ return $ getSuite packet'++set' :: ST -> Suite -> IO Suite+set' st suite = withSocketsDo $ do+ full <- packet st suite SetRequest+ sendPacket st full+ packet' <- decryptPacketWithCache st =<< returnResult st+ checkError packet'+ return $ getSuite packet'++walk' :: ST -> OID -> OID -> Suite -> IO Suite+walk' st oids base accumulator + | oids == base = do+ first <- get' st [oids]+ next <- getnext' st [oids]+ case (first, next) of+ (Suite [Coupla _ NoSuchObject], Suite [Coupla nextOid _]) -> walk' st nextOid base next+ (Suite [Coupla _ NoSuchInstance], Suite [Coupla nextOid _]) -> walk' st nextOid base next+ (Suite [Coupla _ EndOfMibView], _) -> return accumulator+ (_, Suite [Coupla nextOid _]) -> walk' st nextOid base first+ (_, _) -> throwIO $ ServerException 5+ | otherwise = do+ nextData <- getnext' st [oids]+ let Suite [Coupla next v] = nextData+ case (isUpLevel next base, v) of+ (True, _) -> return accumulator+ (_, NoSuchObject) -> walk' st next base accumulator+ (_, NoSuchInstance) -> walk' st next base accumulator+ (_, EndOfMibView) -> return accumulator+ (_, _) -> walk' st next base (accumulator <> nextData) ++bulkwalk' :: ST -> OID -> OID -> Suite -> IO Suite+bulkwalk' st oids base accumulator = do+ first <- bulkget' st [oids]+ let Coupla next snmpData = lastS first+ filtered (Suite xs) = Suite $ filter (\(Coupla x _) -> not $ isUpLevel x base) xs+ case (isUpLevel next base , snmpData) of+ (_, EndOfMibView) -> return $ accumulator <> filtered first+ (False, _) -> bulkwalk' st next base (accumulator <> first)+ (True, _) -> return $ accumulator <> filtered first+ +checkError :: Packet -> IO ()+checkError p = when (getErrorStatus p /= 0) $ throwIO $ ServerException $ getErrorStatus p++toEmptySuite :: OIDS -> Suite+toEmptySuite = Suite . map (\x -> Coupla x Zero) ++packet :: ST -> Suite -> (RequestId -> ErrorStatus -> ErrorIndex -> Request) -> IO Packet+packet st suite r = do+ rid <- predCounter (ref' st)+ eid' <- readIORef (engine' st)+ (eid, boots, time) <- case eid' of+ Just x -> return x+ Nothing -> init' st+ let wrapBulk (GetBulk rid' x _) = GetBulk rid' x 10+ wrapBulk x = x+ full = ( (setReportableP True) + . (setPrivAuthP (securityLevel' st)) + . (setUserNameP (login' st)) + . (setEngineIdP eid)+ . (setEngineBootsP boots)+ . (setEngineTimeP time)+ . (setAuthenticationParametersP cleanPass) + . (setIDP (ID rid))+ . (setRequest $ wrapBulk (r rid 0 0))+ . (setSuite suite)+ ) v3+ return full+++sendPacket :: ST -> Packet -> IO ()+sendPacket st packet' = sendAll (socket' st) . encode+ =<< signPacketWithCache st + =<< encryptPacketWithCache st packet'++returnResult :: ST -> IO Packet+returnResult st = do+ result <- race (threadDelay (timeout' st)) (decode <$> recv (socket' st) 1500 :: IO Packet)+ case result of+ Right resp -> return resp+ Left _ -> throwIO TimeoutException++signPacketWithCache :: ST -> Packet -> IO Packet+signPacketWithCache st packet' = do+ k <- readIORef (authCache' st)+ maybe (newKey packet') (reuseKey packet') k+ where+ newKey packet'' = do+ let key = passwordToKey (authType' st) (authPass' st) (getEngineIdP packet'')+ atomicWriteIORef (authCache' st) (Just key)+ return $ signPacket (authType' st) key packet'+ reuseKey packet'' key = return $ signPacket (authType' st) key packet''++encryptPacketWithCache :: ST -> Packet -> IO Packet+encryptPacketWithCache st packet'+ | (securityLevel' st) == AuthPriv = do+ k <- readIORef (privCache' st)+ maybe (newKey packet') (reuseKey packet') k+ | otherwise = return packet'+ where+ newKey packet'' = do+ let key = passwordToKey (authType' st) (privPass' st) (getEngineIdP packet'')+ atomicWriteIORef (privCache' st) (Just key)+ encryptPacket st key packet'' + reuseKey packet'' key = encryptPacket st key packet''++decryptPacketWithCache :: ST -> Packet -> IO Packet+decryptPacketWithCache st packet' = do+ k <- readIORef (privCache' st)+ maybe (newKey packet') (reuseKey packet') k+ where+ newKey packet'' = do+ let key = passwordToKey (authType' st) (privPass' st) (getEngineIdP packet'')+ atomicWriteIORef (privCache' st) (Just key)+ return $ decryptPacket st key packet''+ reuseKey packet'' key = return $ decryptPacket st key packet''+ +encryptPacket :: ST -> Key -> Packet -> IO Packet+encryptPacket st key packet'+ | privType' st == DES = do+ s <- succCounter (salt32 st)+ let eib = getEngineBootsP packet'+ (encrypted, salt) = desEncrypt key eib s (encode $ (getPDU packet' :: PDU V3))+ return $ setPrivParametersP salt . setPDU (CryptedPDU encrypted) $ packet'+ | privType' st == AES = do+ s <- succCounter (salt64 st)+ let eib = getEngineBootsP packet'+ t = getEngineTimeP packet'+ (encrypted, salt) = aesEncrypt key eib t s (encode $ (getPDU packet' :: PDU V3))+ return $ setPrivParametersP salt . setPDU (CryptedPDU encrypted) $ packet'+ | otherwise = throwIO $ ServerException 5++decryptPacket :: ST -> Key -> Packet -> Packet+decryptPacket st key packet'+ | privType' st == DES = + let pdu = getPDU packet' :: PDU V3+ salt = getPrivParametersP packet'+ in case pdu of+ CryptedPDU x -> setPDU (decode (desDecrypt key salt x) :: PDU V3) packet'+ _ -> packet'+ | privType' st == AES =+ let pdu = getPDU packet' :: PDU V3+ salt = getPrivParametersP packet'+ eib = getEngineBootsP packet'+ t = getEngineTimeP packet'+ in case pdu of+ CryptedPDU x -> setPDU (decode (aesDecrypt key salt eib t x) :: PDU V3) packet'+ _ -> packet'+ | otherwise = throw $ ServerException 5+
+ src/Network/Snmp/Example.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Snmp.Example (+-- * Usage+-- ** Imports+-- $imports++-- ** Create config+-- $config+ +-- ** Describe oids+-- $oids++-- ** Describe requests+-- $request++-- ** Do IO+-- $send+) where++import Data.ByteString (ByteString)+import Control.Exception (bracket, try)++import Network.Snmp.Client+import Network.Protocol.Snmp++{- $imports+> -- imports here+> import Data.ByteString (ByteString)+> import Control.Exception (bracket, try)+> +> import Network.Snmp.Client+> import Network.Protocol.Snmp+-}++{- $config+> -- First you must create config+> -- For SNMPv3+> conf2 :: Config+> conf2 = (initial Version2) { hostname = "salt" +> , community = Community "helloall"+> } +> +> -- For SNMPv3+> conf3 :: Config+> conf3 = (initial Version3) { hostname = "salt" +> , sequrityName = "aes"+> , authPass = "helloallhello"+> , privPass = "helloallhello"+> , authType = SHA+> , privType = AES+> , sequrityLevel = AuthPriv+> } +> +-}+{- $send+> -- do io +> client3 :: IO ()+> client3 = bracket (client conf3)+> close+> requests+> +> client2 :: IO ()+> client2 = bracket (client conf2)+> close+> requests+> +-}++{- $oids+> -- Describe oids which you need+> root, eth0, tabl, ipAddr, zeroDotZero :: [Integer]+> root = [1,3,6,1,2,1,2,2,1,2]+> eth0 = [1,3,6,1,2,1,2,2,1,2,1]+> tabl = [31,1,1,1,1]+> ipAddr = [1,3,6,1,2,1,4,22,1,3,3,192,168,3,1]+> zeroDotZero = [1,3,6,1,2,1,2,2,1,22,20]+> +> oi, sysUptime, memory, sysContact, bad, testOid :: ByteString+> oi = ".1.3.6.1.2.1.1.9.1.2.1"+> sysUptime = "1.3.6.1.2.1.25.1.1.0"+> memory = "1.3.6.1.2.1.25.2"+> sysContact = "1.3.6.1.2.1.1.4.0"+> bad = "1.4.6.1.2.1.1.4"+> testOid = "1.3.6.1.2.1.25.1.1.0"+-}++{- $request+> -- Describe requests+> requests :: Client -> IO ()+> requests snmp = do+> print "get request"+> putStr . show =<< get snmp [oidFromBS testOid]+> putStr . show =<< get snmp [oidFromBS testOid]+> putStr . show =<< get snmp [oidFromBS sysUptime, oidFromBS oi, zeroDotZero]+> print "bulkget request"+> putStr . show =<< bulkget snmp [oidFromBS sysUptime]+> print "getnext request"+> putStr . show =<< getnext snmp [oidFromBS sysUptime]+> print "walk memory"+> putStr . show =<< walk snmp [oidFromBS memory]+> print "bulkwalk memory"+> putStr . show =<< bulkwalk snmp [oidFromBS memory]+> print "get sysContact"+> putStr . show =<< get snmp [oidFromBS sysContact]+> print "set sysContact"+> putStr . show =<< (try $ set snmp (Suite [Coupla (oidFromBS sysContact) (String "hello all")]) :: IO (Either ClientException Suite))+> print "get sysContact"+> putStr . show =<< get snmp [oidFromBS sysContact]+-}