diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,12 @@ +# Changelog + +`snmp` uses [PVP Versioning][1]. +The changelog is available [on GitHub][2]. + +0.0.0 +===== + +* Initially created. + +[1]: https://pvp.haskell.org +[2]: https://github.com/chessai/snmp/releases diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,29 @@ -Copyright (c) 2014, Alexey Smirnov +BSD 3-Clause License +Copyright (c) 2019, chessai 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 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. +* 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. +* Neither the name of the copyright holder nor the names of its + 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 +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 HOLDER 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. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/snmp.cabal b/snmp.cabal --- a/snmp.cabal +++ b/snmp.cabal @@ -1,44 +1,55 @@ -name: snmp -version: 0.2.1.1 -synopsis: API for write snmp client. -description: API for write snmp client. -license: BSD3 -license-file: LICENSE -author: Alexey Smirnov -maintainer: Alexey Smirnov --- copyright: -category: Network -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 +cabal-version: 2.4 +name: + snmp +version: + 0.3.0.0 +synopsis: + SNMP protocol library +description: + SNMP library for writing client applications with SNMP +homepage: + https://github.com/chessai/snmp.git +license: + BSD-3-Clause +license-file: + LICENSE +author: + Andrew Martin +maintainer: + chessai1996@gmail.com +copyright: + 2019 (c) Andrew Martin +category: + Language +build-type: + Simple +extra-source-files: + CHANGELOG.md source-repository head - type: git - location: git@github.com:chemist/snmp.git + type: git + location: https://github.com/chessai/language-asn 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.6 && <4.9, - 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 + exposed-modules: + Snmp.Types + Snmp.Encoding + Snmp.Decoding + Snmp.Client + build-depends: + , base >=4.10.1 && < 4.13 + , bytestring >= 0.10 && < 0.11 + , containers >= 0.5 && < 0.7 + , cryptonite >= 0.20 && < 0.26 + , ip >= 1.3 && < 1.5 + , language-asn >= 0.1 && < 0.2 + , memory >= 0.14 && < 0.15 + , stm >= 2.4 && < 2.6 + , vector >= 0.11 && < 0.13 + , network >= 2.8 && < 2.9 + hs-source-dirs: + src + default-language: + Haskell2010 + ghc-options: + -Wall diff --git a/src/Network/Protocol/Snmp.hs b/src/Network/Protocol/Snmp.hs deleted file mode 100644 --- a/src/Network/Protocol/Snmp.hs +++ /dev/null @@ -1,1059 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE CPP #-} -{-# 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(..) --- * 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 -#if MIN_VERSION_base(4,7,0) -import Data.Bits (testBit, complement, shiftL, (.|.), (.&.), setBit, shiftR, zeroBits, xor, clearBit) -#else -import Data.Bits (testBit, complement, shiftL, (.|.), (.&.), setBit, shiftR, xor, clearBit, Bits(..)) -#endif -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 -import Data.Binary -import Data.Binary.Get -import Data.Binary.Put - --- $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 - -#if MIN_VERSION_base(4,7,0) -#else -zeroBits :: (Num a, Bits a) => a -zeroBits = clearBit (bit 0) 0 - where - bit :: (Bits a, Num a) => Int -> a - bit i = 1 `shiftL` i -#endif - --- | Phantom type for version 1 (Header V2, PDU V2) -data V1 --- | 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 - | Gauge32 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) - --- | 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 = V2Packet Version1 initial initial - -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 Version1 header body) _ = Start Sequence : toASN1 Version1 (toASN1 header (toASN1 body [End Sequence])) - 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 - Version1 -> V2Packet Version1 <$> getObject <*> getObject - Version2 -> V2Packet Version2 <$> getObject <*> getObject - Version3 -> V3Packet Version3 <$> getObject <*> getObject - -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 (Gauge32 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 $ Gauge32 (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 Binary (PDU V3) where - put = putByteString . encodeASN1' DER . flip toASN1 [] - get = toP . BL.toStrict <$> getRemainingLazyByteString --- 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 Binary Packet where - put = putByteString . encodeASN1' DER . flip toASN1 [] --- encode s = encodeASN1' DER $ toASN1 s [] - get = toB . BL.toStrict <$> getRemainingLazyByteString - -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 = BL.toStrict $ 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 - diff --git a/src/Network/Snmp/Client.hs b/src/Network/Snmp/Client.hs deleted file mode 100644 --- a/src/Network/Snmp/Client.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# 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, Gauge32, TimeTicks, Opaque, Counter64, ZeroDotZero, Zero, OI) --- * client -, client --- ** client methods -, get -, bulkget -, getnext -, walk -, bulkwalk -, set -, close --- * useful 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 ConfigV1{..} = clientV1 hostname - port - timeout - community -client ConfigV2{..} = clientV2 hostname - port - timeout - community -client ConfigV3{..} = clientV3 hostname - port - timeout - sequrityName - authPass - privPass - sequrityLevel - authType - privType - diff --git a/src/Network/Snmp/Client/Internal.hs b/src/Network/Snmp/Client/Internal.hs deleted file mode 100644 --- a/src/Network/Snmp/Client/Internal.hs +++ /dev/null @@ -1,67 +0,0 @@ -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) - - - diff --git a/src/Network/Snmp/Client/Types.hs b/src/Network/Snmp/Client/Types.hs deleted file mode 100644 --- a/src/Network/Snmp/Client/Types.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# 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 = ConfigV1 - { hostname :: Hostname - , port :: Port - , timeout :: Int - , community :: Community - } | 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 = ConfigV1 "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 - - diff --git a/src/Network/Snmp/Client/Version2.hs b/src/Network/Snmp/Client/Version2.hs deleted file mode 100644 --- a/src/Network/Snmp/Client/Version2.hs +++ /dev/null @@ -1,125 +0,0 @@ -module Network.Snmp.Client.Version2 -( clientV1 -, clientV2 -) -where - -import Network.Socket hiding (recv, socket, close) -import qualified Network.Socket as NS -import Network.Socket.ByteString.Lazy (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 Data.Binary hiding (get) - -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 - -v1 :: Packet -v1 = initial Version1 - -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) - -clientV1 :: Hostname -> Port -> Int -> Community -> IO Client -clientV1 = clientV12 v1 - -clientV2 :: Hostname -> Port -> Int -> Community -> IO Client -clientV2 = clientV12 v2 - -clientV12 :: Packet -> Hostname -> Port -> Int -> Community -> IO Client -clientV12 packet hostname port timeout community = do - socket <- makeSocket hostname port - uniqInteger <- uniqID - ref <- newIORef uniqInteger - let - req oids = setRCS community oids packet - get' oids = withSocketsDo $ do - let packet' = req oids - version = getVersion packet' - rid <- succCounter ref - sendAll socket $ encode $ setRequest (GetRequest rid 0 0) packet' - case version of - Version2 -> returnResult2 socket timeout - Version1 -> catch (returnResult2 socket timeout) (fixErrorV1Get oids) - Version3 -> error "imposible" - fixErrorV1Get oids (ServerException 2) = return $ Suite $ map (`Coupla` NoSuchObject) oids - fixErrorV1Get _ e = throwIO e - - bulkget' oids = withSocketsDo $ do - rid <- succCounter ref - sendAll socket $ encode $ setRequest (GetBulk rid 0 10) (req oids) - returnResult2 socket timeout - - getnext' oids = withSocketsDo $ do - let packet' = req oids - version = getVersion packet' - rid <- succCounter ref - sendAll socket $ encode $ setRequest (GetNextRequest rid 0 0) packet' - case version of - Version2 -> returnResult2 socket timeout - Version1 -> catch (returnResult2 socket timeout) (fixErrorV1GetNext oids) - Version3 -> error "imposible" - fixErrorV1GetNext oids (ServerException 2) = return $ Suite $ map (`Coupla` EndOfMibView) oids - fixErrorV1GetNext _ e = throwIO e - - 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 $ packet - 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 - } - diff --git a/src/Network/Snmp/Client/Version3.hs b/src/Network/Snmp/Client/Version3.hs deleted file mode 100644 --- a/src/Network/Snmp/Client/Version3.hs +++ /dev/null @@ -1,272 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE GADTs #-} -module Network.Snmp.Client.Version3 -( clientV3 -) -where - -import Data.ByteString (ByteString) -import Data.ByteString.Lazy (toStrict, fromStrict) -import Network.Socket hiding (recv, socket, close) -import qualified Network.Socket as NS -import Network.Socket.ByteString.Lazy (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 Data.Binary - -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, ContextEngineID, 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, ContextEngineID, Int32, Int32) -init' st = withSocketsDo $ do - rid <- predCounter (ref' st) - sendAll (socket' st) $ encode $ packet' rid - result <- race (threadDelay (timeout' st)) (decode <$> recv (socket' st) 1500 :: IO Packet) - case result of - Left _ -> throwIO TimeoutException - Right resp -> do - let pdu = (getPDU resp :: PDU V3) - atomicWriteIORef (engine' st) $ Just (getEngineIdP resp, getContextEngineID pdu, getEngineBootsP resp, getEngineTimeP resp) - return (getEngineIdP resp, getContextEngineID pdu, 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, ceid, 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) - . (setContextEngineIDPacket ceid) - . (setEngineBootsP boots) - . (setEngineTimeP time) - . (setAuthenticationParametersP cleanPass) - . (setIDP (ID rid)) - . (setRequest $ wrapBulk (r rid 0 0)) - . (setSuite suite) - ) v3 - return full - -setContextEngineIDPacket :: ContextEngineID -> Packet -> Packet -setContextEngineIDPacket ceid packet = - let pdu = (getPDU packet :: PDU V3) - newpdu = setContextEngineID ceid pdu - in setPDU newpdu packet - - -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 (toStrict $ 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 (toStrict $ 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 (fromStrict $ 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 (fromStrict $ aesDecrypt key salt eib t x) :: PDU V3) packet' - _ -> packet' - | otherwise = throw $ ServerException 5 - diff --git a/src/Network/Snmp/Example.hs b/src/Network/Snmp/Example.hs deleted file mode 100644 --- a/src/Network/Snmp/Example.hs +++ /dev/null @@ -1,188 +0,0 @@ -{-# 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 SNMPv1 -> conf1 :: Config -> conf1 = (initial Version1) { hostname = "salt" -> , community = Community "helloall" -> } -> -- For SNMPv2 -> 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 -> } -> --} -conf1 :: Config -conf1 = (initial Version1) { hostname = "salt" - , community = Community "helloall" - } -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 -> -> client1 :: IO () -> client1 = bracket (client conf1) -> close -> requests -> --} -client3 :: IO () -client3 = bracket (client conf3) - close - requests - -client2 :: IO () -client2 = bracket (client conf2) - close - requests - -client1 :: IO () -client1 = bracket (client conf1) - 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" --} -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, inet :: 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" -inet = ".1.3.6.1" - -{- $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] --} -requests :: Client -> IO () -requests snmp = do - print "get request" - 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] - diff --git a/src/Snmp/Client.hs b/src/Snmp/Client.hs new file mode 100644 --- /dev/null +++ b/src/Snmp/Client.hs @@ -0,0 +1,451 @@ +{-# language BangPatterns #-} +{-# language OverloadedStrings #-} + +module Snmp.Client + ( Session(..) + , Config(..) + , Destination(..) + , Credentials(..) + , CredentialsV2(..) + , CredentialsV3(..) + , Context(..) + , PerHostV3(..) + , SnmpException(..) + , openSession + , closeSession + , get + , get' + , getBulkStep + , getBulkStep' + , getBulkChildren + , getBulkChildren' + ) where + +import Control.Applicative ((<|>)) +import Control.Concurrent (Chan,newChan,writeList2Chan,readChan,threadWaitReadSTM,writeChan) +import Control.Concurrent.STM.TVar (TVar,newTVarIO,registerDelay,readTVar,writeTVar) +import Control.Exception (throwIO,Exception) +import Control.Monad (replicateM,replicateM_,when,(<=<)) +import Control.Monad.STM (STM,atomically,check) +import Data.Bits ((.|.)) +import Data.ByteString (ByteString) +import Data.Functor (($>)) +import Data.IORef (IORef,readIORef,writeIORef,newIORef) +import Data.Int (Int32) +import Data.Map (Map) +import Data.Maybe (mapMaybe) +import Data.Vector (Vector) +import Data.Word (Word16) +import Language.Asn.Types +import Snmp.Types +import Net.Types (IPv4) +import Text.Printf (printf) +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as LB +import qualified Data.Map as Map +import qualified Data.Vector as Vector +import qualified Language.Asn.Decoding as AsnDecoding +import qualified Language.Asn.Encoding as AsnEncoding +import qualified Language.Asn.ObjectIdentifier as OID +import qualified Net.IPv4 as IPv4 +import qualified Snmp.Decoding as SnmpDecoding +import qualified Snmp.Encoding as SnmpEncoding +import qualified Network.Socket as NS +import qualified Network.Socket.ByteString as NSB +import qualified System.Posix.Types + +data Session = Session + { sessionSockets :: !(Chan NS.Socket) + -- , sessionCredsTimestamps :: !(TVar (Map Word32 + , sessionSocketCount :: !Int + , sessionRequestId :: !(TVar RequestId) + , sessionAesSalt :: !(TVar AesSalt) + , sessionTimeoutMicroseconds :: !Int + , sessionMaxTries :: !Int + , sessionKeyCache :: !(IORef (Map (AuthType,ByteString,EngineId) ByteString)) + } + +data Config = Config + { configSocketPoolSize :: !Int + , configTimeoutMicroseconds :: !Int + , configRetries :: !Int + } deriving (Show,Eq) + +data Destination = Destination + { destinationHost :: !IPv4 + , destinationPort :: !Word16 + } deriving (Show,Eq) + +data Credentials + = CredentialsConstructV2 CredentialsV2 + | CredentialsConstructV3 CredentialsV3 + deriving (Show,Eq) + +newtype CredentialsV2 = CredentialsV2 + { credentialsV2CommunityString :: ByteString + } deriving (Show,Eq) + + +data CredentialsV3 = CredentialsV3 + { credentialsV3Crypto :: !Crypto + , credentialsV3ContextName :: !ByteString + , credentialsV3User :: !ByteString + } deriving (Show,Eq) + +data Context = Context + { contextSession :: !Session + , contextDestination :: !Destination + , contextCredentials :: !Credentials + } + +data PerHostV3 = PerHostV3 + { perHostV3AuthoritativeEngineId :: !EngineId + , perHostV3ReceiverTime :: !Int32 + , perHostV3ReceiverBoots :: !Int32 + } + +-- | Only one connection can be open at a time on a given port. +openSession :: Config -> IO Session +openSession (Config socketPoolSize timeout retries) = do + addrinfos <- NS.getAddrInfo + (Just (NS.defaultHints {NS.addrFlags = [NS.AI_PASSIVE]})) + (Just "0.0.0.0") + Nothing + let serveraddr = head addrinfos + allSockets <- replicateM socketPoolSize $ do + sock <- NS.socket (NS.addrFamily serveraddr) NS.Datagram NS.defaultProtocol + NS.bind sock (NS.addrAddress serveraddr) + return sock + requestIdVar <- newTVarIO (RequestId 1) + aesSaltVar <- newTVarIO (AesSalt 1) + socketChan <- newChan + writeList2Chan socketChan allSockets + keyCache <- newIORef Map.empty + return (Session socketChan socketPoolSize requestIdVar aesSaltVar timeout retries keyCache) + +closeSession :: Session -> IO () +closeSession session = replicateM_ (sessionSocketCount session) $ do + sock <- readChan (sessionSockets session) + NS.close sock + +generalRequest :: + (RequestId -> Pdus) + -> (Pdu -> Either SnmpException a) + -> Context + -> IO (Either SnmpException a) +generalRequest pdusFromRequestId fromPdu (Context session (Destination ip port) creds) = do + sock <- readChan (sessionSockets session) + case creds of + CredentialsConstructV2 (CredentialsV2 commStr) -> do + requestId <- nextRequestId (sessionRequestId session) + let !bs = id + $ LB.toStrict + $ AsnEncoding.der SnmpEncoding.messageV2 + $ MessageV2 commStr + $ pdusFromRequestId requestId + !bsLen = ByteString.length bs + go1 :: Int -> IO (Either SnmpException Pdu) + go1 !n1 = if n1 > 0 + then do + when inDebugMode $ putStrLn "Sending:" + when inDebugMode $ putStrLn (hexByteStringInternal bs) + bytesSentLen <- NSB.sendTo sock bs (NS.SockAddrInet (fromIntegral port) (NS.tupleToHostAddress (IPv4.toOctets ip))) + if bytesSentLen /= bsLen + then return $ Left $ SnmpExceptionNotAllBytesSent bytesSentLen bsLen + else do + let go2 mperHostV3 = do + (isReadyAction,deregister) <- threadWaitReadSTM (mySockFd sock) + delay <- registerDelay (sessionTimeoutMicroseconds session) + isContentReady <- atomically $ (isReadyAction $> True) <|> (fini delay $> False) + deregister + if not isContentReady + then go1 (n1 - 1) + else do + bsRecv <- NSB.recv sock 10000 + when inDebugMode $ putStrLn "Received:" + when inDebugMode $ print bsRecv + if ByteString.null bsRecv + then return (Left SnmpExceptionSocketClosed) + else case AsnDecoding.ber SnmpDecoding.messageV2 bsRecv of + Left err -> return (Left $ SnmpExceptionDecoding err) + Right msg -> case messageV2Data msg of + PdusResponse pdu@(Pdu respRequestId _ _ _) -> + case compare requestId respRequestId of + GT -> go2 mperHostV3 + EQ -> return (Right pdu) + LT -> return $ Left $ SnmpExceptionMissedResponse requestId respRequestId + _ -> return (Left (SnmpExceptionNonPduResponseV2 msg)) + go2 Nothing + else return $ Left SnmpExceptionTimeout + e <- go1 (sessionMaxTries session) + writeChan (sessionSockets session) sock + return (e >>= fromPdu) + CredentialsConstructV3 (CredentialsV3 crypto contextName user) -> do + let passwordToKeyCached typ password eng = do + keyCache <- readIORef (sessionKeyCache session) + let triple = (typ,password,eng) + case Map.lookup triple keyCache of + Nothing -> do + let key = SnmpEncoding.passwordToKey typ password eng + writeIORef (sessionKeyCache session) (Map.insert triple key keyCache) + return key + Just key -> return key + -- setting the reportable flags is very important + -- for AuthPriv + let flags = cryptoFlags crypto .|. 0x04 + mkAuthParams :: RequestId -> PerHostV3 -> (ByteString,ScopedPduData) -> IO ByteString + mkAuthParams reqId phv3 privPair = case cryptoAuth crypto of + Nothing -> return ByteString.empty + Just (AuthParameters typ password) -> do + key <- passwordToKeyCached typ password (perHostV3AuthoritativeEngineId phv3) + let serializationWithoutAuth = snd (makeBs (ByteString.replicate 12 0x00) reqId privPair phv3) + pure (SnmpEncoding.mkSign typ key serializationWithoutAuth) + mkPrivParams :: AesSalt -> RequestId -> PerHostV3 -> IO (ByteString,ScopedPduData) + mkPrivParams theSalt reqId phv3 = case crypto of + AuthPriv (AuthParameters authType _) (PrivParameters privType privPass) -> do + key <- passwordToKeyCached authType privPass (perHostV3AuthoritativeEngineId phv3) + case privType of + PrivTypeAes -> + let (encrypted,actualSaltBs) = SnmpEncoding.aesEncrypt + key + (perHostV3ReceiverBoots phv3) + (perHostV3ReceiverTime phv3) + theSalt + (LB.toStrict (AsnEncoding.der SnmpEncoding.scopedPdu spdu)) + in pure (actualSaltBs,ScopedPduDataEncrypted encrypted) + PrivTypeDes -> + let (encrypted,actualSaltBs) = SnmpEncoding.desEncrypt + key + (perHostV3ReceiverBoots phv3) + (fromIntegral (getAesSalt theSalt)) + -- (perHostV3ReceiverTime phv3) + (LB.toStrict (AsnEncoding.der SnmpEncoding.scopedPdu spdu)) + in pure (actualSaltBs,ScopedPduDataEncrypted encrypted) + _ -> pure (ByteString.empty,ScopedPduDataPlaintext spdu) + where spdu = ScopedPdu (perHostV3AuthoritativeEngineId phv3) contextName (pdusFromRequestId reqId) + makeBs :: ByteString -> RequestId -> (ByteString,ScopedPduData) -> PerHostV3 -> (MessageV3,ByteString) + makeBs activeAuthParams reqId (activePrivParams,spdud) (PerHostV3 authoritativeEngineId receiverTime boots) = + let myMsg = MessageV3 + (HeaderData reqId 1500 flags) -- making up a max size + (Usm authoritativeEngineId boots receiverTime user activeAuthParams activePrivParams) + spdud + -- myMsg2 = trace ("THE MESSAGE TO SEND: " ++ show myMsg) myMsg + in (myMsg, LB.toStrict $ AsnEncoding.der SnmpEncoding.messageV3 $ myMsg) + fullMakeBs :: AesSalt -> RequestId -> PerHostV3 -> IO (MessageV3, ByteString) + fullMakeBs theSalt reqId phv3 = do + privPair <- mkPrivParams theSalt reqId phv3 + authParams <- mkAuthParams reqId phv3 privPair + return (makeBs authParams reqId privPair phv3) + go1 :: Int -> RequestId -> (MessageV3,ByteString) -> Bool -> IO (Either SnmpException Pdu) + go1 !n1 !requestId (!sentMsg,!bsSent) !engineIdsAcquired = if n1 > 0 + then do + when inDebugMode $ putStrLn "Sending:" + when inDebugMode $ putStrLn (hexByteStringInternal bsSent) + let bsLen = ByteString.length bsSent + bytesSentLen <- NSB.sendTo sock bsSent (NS.SockAddrInet (fromIntegral port) (NS.tupleToHostAddress (IPv4.toOctets ip))) + if bytesSentLen /= bsLen + then return $ Left $ SnmpExceptionNotAllBytesSent bytesSentLen bsLen + else do + let go2 :: IO (Either SnmpException Pdu) + go2 = do + (isReadyAction,deregister) <- threadWaitReadSTM (mySockFd sock) + delay <- registerDelay (sessionTimeoutMicroseconds session) + isContentReady <- atomically $ (isReadyAction $> True) <|> (fini delay $> False) + deregister + if not isContentReady + then do + when inDebugMode $ putStrLn "NO RESPONSE" + requestId' <- nextRequestId (sessionRequestId session) + go1 (n1 - 1) requestId' (sentMsg,bsSent) engineIdsAcquired + else do + bsRecv <- NSB.recv sock 10000 + when inDebugMode $ putStrLn "Received:" + when inDebugMode $ putStrLn (hexByteStringInternal bsRecv) + if ByteString.null bsRecv + then return (Left SnmpExceptionSocketClosed) + else case AsnDecoding.ber SnmpDecoding.messageV3 bsRecv of + Left err -> return (Left $ SnmpExceptionDecoding err) + Right msg -> do + case cryptoAuth crypto of + Nothing -> return () + Just (AuthParameters typ password) -> do + when inDebugMode $ putStrLn "THE RECEIVED MESSAGE" + when inDebugMode $ print msg + let reencoded = LB.toStrict $ AsnEncoding.der SnmpEncoding.messageV3 msg + when inDebugMode $ putStrLn $ hexByteStringInternal $ reencoded + when (reencoded /= bsRecv) $ do + when inDebugMode $ putStrLn "NOT THE SAME" + key <- passwordToKeyCached typ password (usmAuthoritativeEngineId (messageV3SecurityParameters msg)) + case SnmpEncoding.checkSign typ key msg of + Nothing -> return () + Just (expected,actual) -> do + when (not $ ByteString.null actual) $ do + throwIO $ SnmpExceptionAuthenticationFailure expected actual + let handleSpdu :: ScopedPdu -> IO (Either SnmpException Pdu) + handleSpdu spdu = case scopedPduData spdu of + -- check to make sure that we requested an unencrypted response + -- somehow check the message id in here too + PdusResponse pdu@(Pdu respRequestId _ _ _) -> + case compare requestId respRequestId of + GT -> go2 + EQ -> return (Right pdu) + LT -> return $ Left $ SnmpExceptionMissedResponse requestId respRequestId + PdusReport (Pdu respRequestId _ _ _) -> do + when inDebugMode $ putStrLn $ "Expected Request ID: " ++ show requestId + when inDebugMode $ putStrLn $ "Received Request ID: " ++ show respRequestId + if engineIdsAcquired + then return $ Left (SnmpExceptionBadEngineId sentMsg msg) + else do + let usm = messageV3SecurityParameters msg + phv3 = PerHostV3 + (usmAuthoritativeEngineId usm) + (usmAuthoritativeEngineTime usm) + (usmAuthoritativeEngineBoots usm) + theSalt <- atomically $ nextSalt (sessionAesSalt session) + requestId' <- nextRequestId (sessionRequestId session) + -- Notice that n1 is not decremented in this + -- situation. This is intentional. + internalFragment <- fullMakeBs theSalt requestId' phv3 + go1 n1 requestId' internalFragment True + _ -> return (Left (SnmpExceptionNonPduResponseV3 msg)) + case messageV3Data msg of + ScopedPduDataEncrypted encrypted -> case crypto of + NoAuthNoPriv -> error "internal library error: messageV3Data NoAuthPriv" + AuthNoPriv _ -> error "internal library error: messageV3Data (AuthNoPriv _)" + AuthPriv (AuthParameters authType _) (PrivParameters privType privPass) -> do + let usm = messageV3SecurityParameters msg + key <- passwordToKeyCached authType privPass (usmAuthoritativeEngineId usm) + let mdecrypted = case privType of + PrivTypeDes -> SnmpEncoding.desDecrypt key (usmPrivacyParameters usm) encrypted + PrivTypeAes -> SnmpEncoding.aesDecrypt key (usmPrivacyParameters usm) (usmAuthoritativeEngineBoots usm) (usmAuthoritativeEngineTime usm) encrypted + case mdecrypted of + Just bs -> case AsnDecoding.ber SnmpDecoding.scopedPdu bs of + Left err -> throwIO (SnmpExceptionDecoding err) + Right spdu -> handleSpdu spdu + Nothing -> throwIO SnmpExceptionDecryptionFailure + ScopedPduDataPlaintext spdu -> handleSpdu spdu + go2 + else return $ Left $ SnmpExceptionTimeoutV3 sentMsg + -- boots and estimated time are made up for this, we could do better + let originalPhv3 = PerHostV3 (EngineId "initial-engine-id") 0xFFFFFF 0xEEEEEE + theSalt <- atomically $ nextSalt (sessionAesSalt session) + requestId' <- nextRequestId (sessionRequestId session) + theFragment <- fullMakeBs theSalt requestId' originalPhv3 + e <- go1 (sessionMaxTries session) requestId' theFragment False + writeChan (sessionSockets session) sock + return (e >>= fromPdu) + +nextSalt :: TVar AesSalt -> STM AesSalt +nextSalt v = do + AesSalt w <- readTVar v + let s = AesSalt (w + 1) + writeTVar v s + return s + +throwSnmpException :: IO (Either SnmpException a) -> IO a +throwSnmpException = (either throwIO return =<<) + +get :: Context -> ObjectIdentifier -> IO ObjectSyntax +get ctx ident = throwSnmpException (get' ctx ident) + +getBulkStep :: Context -> Int -> ObjectIdentifier -> IO (Vector (ObjectIdentifier,ObjectSyntax)) +getBulkStep ctx maxRep ident = throwSnmpException (getBulkStep' ctx maxRep ident) + +getBulkChildren :: Context -> Int -> ObjectIdentifier -> IO (Vector (ObjectIdentifier,ObjectSyntax)) +getBulkChildren ctx maxRep oid1 = throwSnmpException (getBulkChildren' ctx maxRep oid1) + +get' :: Context -> ObjectIdentifier -> IO (Either SnmpException ObjectSyntax) +get' ctx ident = generalRequest + (\reqId -> PdusGetRequest (Pdu reqId (ErrorStatus 0) (ErrorIndex 0) (Vector.singleton (VarBind ident BindingResultUnspecified)))) + (singleBindingValue ident <=< onlyBindings) + ctx + +getBulkStep' :: Context -> Int -> ObjectIdentifier -> IO (Either SnmpException (Vector (ObjectIdentifier,ObjectSyntax))) +getBulkStep' ctx maxRep ident = generalRequest + (\reqId -> PdusGetBulkRequest (BulkPdu reqId 0 (fromIntegral maxRep) (Vector.singleton (VarBind ident BindingResultUnspecified)))) + (fmap multipleBindings . onlyBindings) + ctx + +getBulkChildren' :: Context -> Int -> ObjectIdentifier -> IO (Either SnmpException (Vector (ObjectIdentifier,ObjectSyntax))) +getBulkChildren' ctx maxRep oid1 = go Vector.empty oid1 where + go prevPairs ident = do + epairsUnfiltered <- getBulkStep' ctx maxRep ident + case epairsUnfiltered of + Left e -> return (Left e) + Right pairsUnfiltered -> do + let pairs = Vector.filter (\(oid,_) -> oidIsPrefixOf oid1 oid) pairsUnfiltered + if Vector.null pairs + then return (Right prevPairs) + else go (prevPairs Vector.++ pairs) (fst (Vector.last pairs)) + +oidIsPrefixOf :: ObjectIdentifier -> ObjectIdentifier -> Bool +oidIsPrefixOf = OID.isPrefixOf + +-- There is not a mapMaybe for vector until 0.12.0.0 +multipleBindings :: Vector VarBind -> Vector (ObjectIdentifier,ObjectSyntax) +multipleBindings = Vector.fromList . mapMaybe + ( \(VarBind ident br) -> case br of + BindingResultValue obj -> Just (ident,obj) + _ -> Nothing + ) . Vector.toList + +singleBindingValue :: ObjectIdentifier -> Vector VarBind -> Either SnmpException ObjectSyntax +singleBindingValue oid v = if Vector.length v == 1 + then do + let VarBind name res = v Vector.! 0 + when (name /= oid) $ Left $ SnmpExceptionMismatchedBinding oid name + case res of + BindingResultValue obj -> Right obj + BindingResultUnspecified -> Left SnmpExceptionUnspecified + BindingResultNoSuchObject -> Left (SnmpExceptionNoSuchObject oid) + BindingResultNoSuchInstance -> Left (SnmpExceptionNoSuchInstance oid) + BindingResultEndOfMibView -> Left SnmpExceptionEndOfMibView + else Left (SnmpExceptionMultipleBindings (Vector.length v)) + +onlyBindings :: Pdu -> Either SnmpException (Vector VarBind) +onlyBindings (Pdu _ errStatus@(ErrorStatus e) errIndex bindings) = + if e == 0 then Right bindings else Left (SnmpExceptionPduError errStatus errIndex) + +data SnmpException + = SnmpExceptionNotAllBytesSent !Int !Int + | SnmpExceptionTimeout + | SnmpExceptionTimeoutV3 !MessageV3 + | SnmpExceptionPduError !ErrorStatus !ErrorIndex + | SnmpExceptionMultipleBindings !Int + | SnmpExceptionMismatchedBinding !ObjectIdentifier !ObjectIdentifier + | SnmpExceptionUnspecified -- ^ Should not happen + | SnmpExceptionNoSuchObject !ObjectIdentifier + | SnmpExceptionNoSuchInstance !ObjectIdentifier + | SnmpExceptionEndOfMibView + | SnmpExceptionMissedResponse !RequestId !RequestId + | SnmpExceptionNonPduResponseV2 !MessageV2 + | SnmpExceptionNonPduResponseV3 !MessageV3 + | SnmpExceptionDecoding !String + | SnmpExceptionSocketClosed + | SnmpExceptionAuthenticationFailure !ByteString !ByteString + | SnmpExceptionBadEngineId !MessageV3 !MessageV3 + | SnmpExceptionDecryptionFailure + deriving (Show,Eq) + +instance Exception SnmpException + +fini :: TVar Bool -> STM () +fini = check <=< readTVar + +nextRequestId :: TVar RequestId -> IO RequestId +nextRequestId requestIdVar = atomically $ do + RequestId i1 <- readTVar requestIdVar + let !i2 = mod (i1 + 1) 100000000 + !i3 = if i2 == 0 then 1 else i2 + writeTVar requestIdVar (RequestId i3) + return (RequestId i3) + +mySockFd :: NS.Socket -> System.Posix.Types.Fd +mySockFd s = System.Posix.Types.Fd (NS.fdSocket s) + +hexByteStringInternal :: ByteString -> String +hexByteStringInternal = ByteString.foldr (\w xs -> printf "%02X" w ++ xs) [] + +inDebugMode :: Bool +inDebugMode = False + diff --git a/src/Snmp/Decoding.hs b/src/Snmp/Decoding.hs new file mode 100644 --- /dev/null +++ b/src/Snmp/Decoding.hs @@ -0,0 +1,160 @@ +{-# language BangPatterns #-} +{-# language LambdaCase #-} +{-# language OverloadedStrings #-} + +module Snmp.Decoding where + +import Data.Bifunctor (first) +import Data.Coerce (coerce) +import Language.Asn.Decoding +import Language.Asn.Types +import Snmp.Types +import qualified Data.Vector as Vector +import qualified Language.Asn.Decoding as AsnDecoding + +import Prelude hiding (sequence,null) + +trapPdu :: AsnDecoding TrapPdu +trapPdu = sequence $ TrapPdu + <$> required "enterprise" objectIdentifier + <*> required "agent-addr" + ( choice + [ option "internet" $ tag Application 0 Implicit octetStringWord32 + ] + ) + <*> required "generic-trap" genericTrap + <*> required "specific-trap" integer + <*> required "time-stamp" (tag Application 3 Implicit integer) + <*> required "variable-bindings" (sequenceOf varBind) + +genericTrap :: AsnDecoding GenericTrap +genericTrap = flip mapFailable integer $ \case + 0 -> Right GenericTrapColdStart + 1 -> Right GenericTrapWarmStart + 2 -> Right GenericTrapLinkDown + 3 -> Right GenericTrapLinkUp + 4 -> Right GenericTrapAuthenticationFailure + 5 -> Right GenericTrapEgpNeighborLoss + 6 -> Right GenericTrapEnterpriseSpecific + _ -> Left "unrecognized generic-trap number" + +messageV2 :: AsnDecoding MessageV2 +messageV2 = sequence $ MessageV2 + <$ required "version" integer -- make this actually demand that it's 1 + <*> required "community" octetString + <*> required "data" pdus + +simpleSyntax :: AsnDecoding SimpleSyntax +simpleSyntax = choice + [ fmap SimpleSyntaxInteger $ option "integer-value" int32 + , fmap SimpleSyntaxString $ option "string-value" octetString + , fmap SimpleSyntaxObjectId $ option "objectID-value" objectIdentifier + ] + +applicationSyntax :: AsnDecoding ApplicationSyntax +applicationSyntax = choice + [ fmap ApplicationSyntaxIpAddress + $ option "ipAddress-value" $ tag Application 0 Implicit octetStringWord32 + , fmap ApplicationSyntaxCounter + $ option "counter-value" $ tag Application 1 Implicit word32 + , fmap ApplicationSyntaxTimeTicks + $ option "timeticks-value" $ tag Application 3 Implicit word32 + , fmap ApplicationSyntaxArbitrary + $ option "arbitrary-value" $ tag Application 4 Implicit octetString + , fmap ApplicationSyntaxBigCounter + $ option "big-counter-value" $ tag Application 6 Implicit word64 + , fmap ApplicationSyntaxUnsignedInteger + $ option "unsigned-integer-value" $ tag Application 2 Implicit word32 + ] + +objectSyntax :: AsnDecoding ObjectSyntax +objectSyntax = choice + [ fmap ObjectSyntaxSimple $ option "simple" simpleSyntax + , fmap ObjectSyntaxApplication $ option "application-wide" applicationSyntax + ] + +bindingResult :: AsnDecoding BindingResult +bindingResult = choice + [ BindingResultValue <$> option "value" objectSyntax + , BindingResultUnspecified <$ option "unSpecified" null + , BindingResultNoSuchObject <$ option "noSuchObject" (tag ContextSpecific 0 Implicit null) + , BindingResultNoSuchInstance <$ option "noSuchInstance" (tag ContextSpecific 1 Implicit null) + , BindingResultEndOfMibView <$ option "endOfMibView" (tag ContextSpecific 2 Implicit null) + ] + +varBind :: AsnDecoding VarBind +varBind = sequence $ VarBind + <$> required "name" objectIdentifier + -- result is not actually named in the RFC + <*> required "result" bindingResult + +pdu :: AsnDecoding Pdu +pdu = sequence $ Pdu + <$> required "request-id" (coerce int) + <*> required "error-status" (coerce integer) + <*> required "error-index" (coerce int32) + <*> required "variable-bindings" (fmap Vector.fromList $ sequenceOf varBind) + +bulkPdu :: AsnDecoding BulkPdu +bulkPdu = sequence $ BulkPdu + <$> required "request-id" (coerce int) + <*> required "non-repeaters" int32 + <*> required "max-repetitions" int32 + <*> required "variable-bindings" (fmap Vector.fromList $ sequenceOf varBind) + +pdus :: AsnDecoding Pdus +pdus = choice + [ PdusGetRequest <$> option "get-request" (tag ContextSpecific 0 Implicit pdu) + , PdusGetNextRequest <$> option "get-next-request" (tag ContextSpecific 1 Implicit pdu) + , PdusGetBulkRequest <$> option "get-bulk-request" (tag ContextSpecific 5 Implicit bulkPdu) + , PdusResponse <$> option "response" (tag ContextSpecific 2 Implicit pdu) + , PdusSetRequest <$> option "set-request" (tag ContextSpecific 3 Implicit pdu) + , PdusInformRequest <$> option "inform-request" (tag ContextSpecific 6 Implicit pdu) + , PdusSnmpTrap <$> option "snmpV2-trap" (tag ContextSpecific 4 Implicit trapPdu) + , PdusReport <$> option "report" (tag ContextSpecific 8 Implicit pdu) + ] + +-- onlyMessageId :: AsnDecoding RequestId +-- onlyMessageId = sequence + +messageV3 :: AsnDecoding MessageV3 +messageV3 = sequence $ MessageV3 + <$ required "msgVersion" integer -- make this actually demand that it's 3 + <*> required "msgGlobalData" headerData + <*> required "msgSecurityParameters" + (mapFailable (first ("while decoding security params" ++) . AsnDecoding.ber usm) octetString) + <*> required "msgData" scopedPduDataDecoding + +headerData :: AsnDecoding HeaderData +headerData = sequence $ HeaderData + <$> required "msgID" (coerce int) + <*> required "msgMaxSize" int32 + <*> required "msgFlags" octetStringWord8 + <* required "msgSecurityModel" integer -- make sure this is actually 3 + +-- else Left $ concat +-- [ "wrong auth flags in header data: " +-- , "expected " ++ printf "%08b" (E.cryptoFlags c) +-- , " but found " ++ printf "%08b" w +-- ] + +scopedPduDataDecoding :: AsnDecoding ScopedPduData +scopedPduDataDecoding = choice + [ fmap ScopedPduDataPlaintext $ option "plaintext" scopedPdu + , fmap ScopedPduDataEncrypted $ option "encryptedPDU" octetString + ] + +scopedPdu :: AsnDecoding ScopedPdu +scopedPdu = sequence $ ScopedPdu + <$> required "contextEngineID" (coerce octetString) + <*> required "contextName" octetString + <*> required "data" pdus + +usm :: AsnDecoding Usm -- ((Crypto,Maybe MessageV3),Usm) +usm = sequence $ Usm + <$> required "msgAuthoritativeEngineID" (coerce octetString) + <*> required "msgAuthoritativeEngineBoots" int32 + <*> required "msgAuthoritativeEngineTime" int32 + <*> required "msgUserName" octetString + <*> required "msgAuthenticationParameters" octetString + <*> required "msgPrivacyParameters" octetString diff --git a/src/Snmp/Encoding.hs b/src/Snmp/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/Snmp/Encoding.hs @@ -0,0 +1,345 @@ +{-# language BangPatterns #-} +{-# language LambdaCase #-} +{-# language OverloadedStrings #-} +{-# language TupleSections #-} + +module Snmp.Encoding where + +import Data.Bits (Bits(..)) +import Data.ByteString (ByteString) +import Data.Coerce (coerce) +import Data.Int (Int32) +import Data.Maybe (fromJust) +import Data.Monoid +import Data.Word (Word64) +import Language.Asn.Encoding +import Language.Asn.Types +import Language.Asn.Types.Internal +import Prelude hiding (sequence,null) +import Snmp.Types +import qualified Crypto.Cipher.AES as Priv +import qualified Crypto.Cipher.DES as Priv +import qualified Crypto.Cipher.Types as Priv +import qualified Crypto.Data.Padding as Pad +import qualified Crypto.Error as Priv +import qualified Crypto.Hash as Hash +import qualified Crypto.MAC.HMAC as HMAC +import qualified Data.ByteArray as BA +import qualified Data.ByteString as B +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Lazy as LB +import qualified Data.List as List +import qualified Data.Vector as Vector +import qualified GHC.Exts as E +import qualified Language.Asn.Encoding as AsnEncoding + +messageV2 :: AsnEncoding MessageV2 +messageV2 = sequence + [ required "version" (const 1) integer + , required "community" messageV2CommunityString octetString + , required "data" messageV2Data pdus + ] + +simpleSyntax :: AsnEncoding SimpleSyntax +simpleSyntax = choice + [ SimpleSyntaxInteger 0 + , SimpleSyntaxString ByteString.empty + , SimpleSyntaxObjectId defaultObjectIdentifier + ] $ \case + SimpleSyntaxInteger n -> option 0 "integer-value" n int32 + SimpleSyntaxString bs -> option 1 "string-value" bs octetString + SimpleSyntaxObjectId oid -> option 2 "objectID-value" oid objectIdentifier + +applicationSyntax :: AsnEncoding ApplicationSyntax +applicationSyntax = choice + [ ApplicationSyntaxIpAddress 0 + , ApplicationSyntaxCounter 0 + , ApplicationSyntaxTimeTicks 0 + , ApplicationSyntaxArbitrary ByteString.empty + , ApplicationSyntaxBigCounter 0 + , ApplicationSyntaxUnsignedInteger 0 + ] $ \case + ApplicationSyntaxIpAddress n -> option 0 "ipAddress-value" n + $ tag Application 0 Implicit octetStringWord32 + ApplicationSyntaxCounter n -> option 1 "counter-value" n + $ tag Application 1 Implicit word32 + ApplicationSyntaxTimeTicks n -> option 2 "timeticks-value" n + $ tag Application 3 Implicit word32 + ApplicationSyntaxArbitrary n -> option 3 "arbitrary-value" n + $ tag Application 4 Implicit octetString + ApplicationSyntaxBigCounter n -> option 4 "big-counter-value" n + $ tag Application 6 Implicit word64 + ApplicationSyntaxUnsignedInteger n -> option 5 "unsigned-integer-value" n + $ tag Application 2 Implicit word32 + +objectSyntax :: AsnEncoding ObjectSyntax +objectSyntax = choice + [ ObjectSyntaxSimple (SimpleSyntaxInteger 0) + , ObjectSyntaxApplication (ApplicationSyntaxCounter 0) + ] $ \case + ObjectSyntaxSimple v -> option 0 "simple" v simpleSyntax + ObjectSyntaxApplication v -> option 1 "application-wide" v applicationSyntax + +bindingResult :: AsnEncoding BindingResult +bindingResult = choice + [ BindingResultValue (ObjectSyntaxSimple (SimpleSyntaxInteger 0)) + , BindingResultUnspecified + , BindingResultNoSuchObject + , BindingResultNoSuchInstance + , BindingResultEndOfMibView + ] $ \case + BindingResultValue obj -> option 0 "value" obj objectSyntax + BindingResultUnspecified -> option 1 "unSpecified" () null + BindingResultNoSuchObject -> option 2 "noSuchObject" () $ implicitTag (tagFromInt 0) null + BindingResultNoSuchInstance -> option 3 "noSuchInstance" () $ implicitTag (tagFromInt 1) null + BindingResultEndOfMibView -> option 4 "endOfMibView" () $ implicitTag (tagFromInt 2) null + +varBind :: AsnEncoding VarBind +varBind = sequence + [ required "name" varBindName objectIdentifier + -- result is not actually named in the RFC + , required "result" varBindResult bindingResult + ] + +pdu :: AsnEncoding Pdu +pdu = sequence + [ required "request-id" pduRequestId (coerce int) + , required "error-status" pduErrorStatus (coerce integer) + , required "error-index" pduErrorIndex (coerce int32) + , required "variable-bindings" pduVariableBindings (sequenceOf varBind) + ] + +trapPdu :: AsnEncoding TrapPdu +trapPdu = error "Net.Snmp.Encoding.trapPdu: not yet implemented" + +bulkPdu :: AsnEncoding BulkPdu +bulkPdu = sequence + [ required "request-id" bulkPduRequestId (coerce int) + , required "non-repeaters" bulkPduNonRepeaters int32 + , required "max-repetitions" bulkPduMaxRepetitions int32 + , required "variable-bindings" bulkPduVariableBindings (sequenceOf varBind) + ] + +pdus :: AsnEncoding Pdus +pdus = choice + [ PdusGetRequest defaultPdu + , PdusGetNextRequest defaultPdu + , PdusGetBulkRequest (BulkPdu (RequestId 0) 0 0 Vector.empty) + , PdusResponse defaultPdu + , PdusSetRequest defaultPdu + , PdusInformRequest defaultPdu + , PdusSnmpTrap (TrapPdu defaultObjectIdentifier 0 GenericTrapColdStart 0 0 []) + , PdusReport defaultPdu + ] $ \case + PdusGetRequest p -> option 0 "get-request" p $ implicitTag (tagFromInt 0) pdu + PdusGetNextRequest p -> option 1 "get-next-request" p $ implicitTag (tagFromInt 1) pdu + PdusGetBulkRequest p -> option 2 "get-bulk-request" p $ implicitTag (tagFromInt 5) bulkPdu + PdusResponse p -> option 3 "response" p $ implicitTag (tagFromInt 2) pdu + PdusSetRequest p -> option 4 "set-request" p $ implicitTag (tagFromInt 3) pdu + PdusInformRequest p -> option 5 "inform-request" p $ implicitTag (tagFromInt 6) pdu + PdusSnmpTrap p -> option 6 "snmpV2-trap" p $ implicitTag (tagFromInt 4) trapPdu + PdusReport p -> option 7 "report" p $ implicitTag (tagFromInt 8) pdu + +defaultObjectIdentifier :: ObjectIdentifier +defaultObjectIdentifier = ObjectIdentifier (E.fromList [1,3,6]) + +defaultPdu :: Pdu +defaultPdu = Pdu (RequestId 0) (ErrorStatus 0) (ErrorIndex 0) Vector.empty + +defaultUsm :: Usm +defaultUsm = Usm defaultEngineId 0 0 ByteString.empty ByteString.empty ByteString.empty + +-- messageV3 :: AsnEncoding ((Crypto,AesSalt),MessageV3) +-- messageV3 = contramap (\(c,m) -> ((c,Just m),m)) internalMessageV3 + +messageV3 :: AsnEncoding MessageV3 +messageV3 = sequence + [ required "msgVersion" (const 3) integer + , required "msgGlobalData" messageV3GlobalData headerData + , required "msgSecurityParameters" + (\msg -> LB.toStrict (AsnEncoding.der usm (messageV3SecurityParameters msg))) + octetString + , required "msgData" messageV3Data scopedPduDataEncoding + ] + +headerData :: AsnEncoding HeaderData +headerData = sequence + [ required "msgID" headerDataId (coerce int) + , required "msgMaxSize" headerDataMaxSize int32 + , required "msgFlags" headerDataFlags octetStringWord8 + , required "msgSecurityModel" (const 3) integer + ] + +scopedPduDataEncoding :: AsnEncoding ScopedPduData +scopedPduDataEncoding = choice + [ ScopedPduDataPlaintext defaultScopedPdu + , ScopedPduDataEncrypted ByteString.empty + ] $ \case + ScopedPduDataPlaintext spdu -> option 0 "plaintext" spdu scopedPdu + ScopedPduDataEncrypted bs -> option 1 "encryptedPDU" bs octetString + +scopedPdu :: AsnEncoding ScopedPdu +scopedPdu = sequence + [ required "contextEngineID" scopedPduContextEngineId (coerce octetString) + , required "contextName" scopedPduContextName octetString + , required "data" scopedPduData pdus + ] + +usm :: AsnEncoding Usm +usm = sequence + [ required "msgAuthoritativeEngineID" usmAuthoritativeEngineId (coerce octetString) + , required "msgAuthoritativeEngineBoots" usmAuthoritativeEngineBoots int32 + , required "msgAuthoritativeEngineTime" usmAuthoritativeEngineTime int32 + , required "msgUserName" usmUserName octetString + , required "msgAuthenticationParameters" usmAuthenticationParameters octetString + , required "msgPrivacyParameters" usmPrivacyParameters octetString + ] + +hmacEncodedMessage :: AuthType -> ByteString -> ByteString -> ByteString +hmacEncodedMessage x key bs = case x of + AuthTypeMd5 -> BA.convert (HMAC.hmac key bs :: HMAC.HMAC Hash.MD5) + AuthTypeSha -> BA.convert (HMAC.hmac key bs :: HMAC.HMAC Hash.SHA1) + +hash :: AuthType -> ByteString -> ByteString +hash AuthTypeMd5 = BA.convert . (Hash.hash :: ByteString -> Hash.Digest Hash.MD5) +hash AuthTypeSha = BA.convert . (Hash.hash :: ByteString -> Hash.Digest Hash.SHA1) + +hashlazy :: AuthType -> LB.ByteString -> ByteString +hashlazy AuthTypeMd5 = BA.convert . (Hash.hashlazy :: LB.ByteString -> Hash.Digest Hash.MD5) +hashlazy AuthTypeSha = BA.convert . (Hash.hashlazy :: LB.ByteString -> Hash.Digest Hash.SHA1) + +passwordToKey :: AuthType -> ByteString -> EngineId -> ByteString +passwordToKey at pass (EngineId eid) = + hash at (authKey <> eid <> authKey) + where + mkAuthKey = hashlazy at . LB.take 1048576 . LB.fromChunks . List.repeat + !authKey = mkAuthKey pass + +defaultAuthParams :: AuthParameters +defaultAuthParams = AuthParameters AuthTypeSha ByteString.empty + +defaultPrivParams :: PrivParameters +defaultPrivParams = PrivParameters PrivTypeDes ByteString.empty + +defaultScopedPdu :: ScopedPdu +defaultScopedPdu = ScopedPdu defaultEngineId ByteString.empty (PdusGetRequest defaultPdu) + +defaultEngineId :: EngineId +defaultEngineId = EngineId ByteString.empty + +desEncrypt :: + ByteString + -> Int32 + -> Int32 + -> ByteString + -> (ByteString,ByteString) +desEncrypt privKey eb et = + (,salt) . Priv.cbcEncrypt cipher iv . Pad.pad Pad.PKCS5 + where + preIV = B.drop 8 (B.take 16 privKey) + salt = toSalt eb et + iv :: Priv.IV Priv.DES + !iv = fromJust $! Priv.makeIV (B.pack $ B.zipWith xor preIV salt) + !cipher = mkCipher (B.take 8 privKey) + +desDecrypt :: ByteString -> ByteString -> ByteString -> Maybe ByteString +desDecrypt privKey salt d = do + iv <- iv' + pure $ stripBS $ Priv.cbcDecrypt cipher iv d + where + preIV = B.drop 8 (B.take 16 privKey) + iv' :: Maybe (Priv.IV Priv.DES) + !iv' = Priv.makeIV (B.pack $ B.zipWith xor preIV salt) + !cipher = mkCipher (B.take 8 privKey) + +aesDecrypt :: ByteString -> ByteString -> Int32 -> Int32 -> ByteString -> Maybe ByteString +aesDecrypt privKey salt eb et b = do + iv <- iv' + pure $ stripBS $ Priv.cfbDecrypt cipher iv b + where + iv' :: Maybe (Priv.IV Priv.AES128) + !iv' = Priv.makeIV (toSalt eb et <> salt) + !cipher = mkCipher (B.take 16 privKey) + +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 -> error "something bad happened while decrypting" + 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 + +aesEncrypt :: ByteString -> Int32 -> Int32 -> AesSalt -> ByteString -> (ByteString,ByteString) +aesEncrypt privKey eb et (AesSalt rcounter) = + (,salt) . Priv.cfbEncrypt cipher iv + where + salt = wToBs rcounter + iv :: Priv.IV Priv.AES128 + !iv = unJust $ Priv.makeIV (toSalt eb et <> salt) + !cipher = mkCipher (B.take 16 privKey) + unJust = \case + Nothing -> error "Net.Snmp.Encoding: aesEncrypt: bad salt" + Just a -> a + +wToBs :: Word64 -> 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) + ] + +mkCipher :: (Priv.Cipher c) => ByteString -> c +mkCipher = (\(Priv.CryptoPassed x) -> x) . Priv.cipherInit +{-# INLINE mkCipher #-} + +mkSign :: AuthType -> ByteString -> ByteString -> ByteString +mkSign at key = B.take 12 . hmacEncodedMessage at key +{-# INLINE mkSign #-} + +-- mkSign :: AuthType -> ByteString -> ByteString -> ByteString +-- mkSign = error "mkSign: write this" + +checkSign :: AuthType -> ByteString -> MessageV3 -> Maybe (ByteString,ByteString) +checkSign at key msg = if expected == actual + then Nothing + else Just (expected,actual) + where + raw = LB.toStrict (AsnEncoding.der messageV3 (resetAuthParams msg)) + expected = mkSign at key raw + actual = usmAuthenticationParameters (messageV3SecurityParameters msg) + +resetAuthParams :: MessageV3 -> MessageV3 +resetAuthParams m = m + { messageV3SecurityParameters = (messageV3SecurityParameters m) + { usmAuthenticationParameters = ByteString.replicate 12 0x00 + } + } + +tagFromInt :: Int -> Tag +tagFromInt !i = Tag ContextSpecific i +{-# inline tagFromInt #-} + diff --git a/src/Snmp/Types.hs b/src/Snmp/Types.hs new file mode 100644 --- /dev/null +++ b/src/Snmp/Types.hs @@ -0,0 +1,184 @@ +{-# language BangPatterns #-} +{-# language LambdaCase #-} + +module Snmp.Types where + +import Language.Asn.Types +import Data.Int (Int32) +import Data.Word (Word8,Word32,Word64) +import Data.ByteString (ByteString) +import Data.Vector (Vector) + +newtype RequestId = RequestId { getRequestId :: Int } + deriving (Eq,Ord,Show,Read) +newtype ErrorIndex = ErrorIndex { getErrorIndex :: Int32 } + deriving (Eq,Show) +newtype ErrorStatus = ErrorStatus { getErrorStatus :: Integer } + deriving (Eq,Show) + +data ObjectSyntax + = ObjectSyntaxSimple !SimpleSyntax + | ObjectSyntaxApplication !ApplicationSyntax + deriving (Eq,Show) + +data SimpleSyntax + = SimpleSyntaxInteger !Int32 + | SimpleSyntaxString !ByteString + | SimpleSyntaxObjectId !ObjectIdentifier + deriving (Eq,Show) + +data ApplicationSyntax + = ApplicationSyntaxIpAddress !Word32 + | ApplicationSyntaxCounter !Word32 + | ApplicationSyntaxTimeTicks !Word32 + | ApplicationSyntaxArbitrary !ByteString + | ApplicationSyntaxBigCounter !Word64 + | ApplicationSyntaxUnsignedInteger !Word32 + deriving (Eq,Show) + +data VarBind = VarBind + { varBindName :: !ObjectIdentifier + , varBindResult :: !BindingResult + } deriving (Eq,Show) + +data BindingResult + = BindingResultValue !ObjectSyntax + | BindingResultUnspecified + | BindingResultNoSuchObject + | BindingResultNoSuchInstance + | BindingResultEndOfMibView + deriving (Eq,Show) + +data Pdus + = PdusGetRequest !Pdu + | PdusGetNextRequest !Pdu + | PdusGetBulkRequest !BulkPdu + | PdusResponse !Pdu + | PdusSetRequest !Pdu + | PdusInformRequest !Pdu + | PdusSnmpTrap !TrapPdu + | PdusReport !Pdu + deriving (Eq,Show) + +-- | A message as defined by RFC1157. The @version@ field is omitted +-- since it is required to be 1. The encoding and decoding of 'Message' +-- do have this field present though. +data MessageV2 = MessageV2 + { messageV2CommunityString :: !ByteString + , messageV2Data :: !Pdus + -- ^ In the ASN.1 definition of @Message@, this field is an @ANY@. + -- In practice, it is always @PDUs@. + } deriving (Eq,Show) + +data MessageV3 = MessageV3 + { messageV3GlobalData :: !HeaderData + , messageV3SecurityParameters :: !Usm + , messageV3Data :: !ScopedPduData + } deriving (Eq,Show) + +data HeaderData = HeaderData + { headerDataId :: !RequestId + , headerDataMaxSize :: !Int32 + , headerDataFlags :: !Word8 + -- The Security Model is omitted because we only + -- support USM (User Security Model, represented by the number 3), + -- which seems to be the only one actually in use. + -- , headerDataSecurityModel :: !Int + } deriving (Eq,Show) + +data AuthType = AuthTypeMd5 | AuthTypeSha + deriving (Eq,Ord,Show) +data PrivType = PrivTypeDes | PrivTypeAes + deriving (Eq,Ord,Show) + +data Crypto + = NoAuthNoPriv + | AuthNoPriv !AuthParameters + | AuthPriv !AuthParameters !PrivParameters + deriving (Eq,Show) + +data AuthParameters = AuthParameters + { authParametersType :: !AuthType + , authParametersKey :: !ByteString + } deriving (Eq,Show) + +data PrivParameters = PrivParameters + { privParametersType :: !PrivType + , privParametersKey :: !ByteString + } deriving (Eq,Show) + +newtype AesSalt = AesSalt { getAesSalt :: Word64 } + +cryptoFlags :: Crypto -> Word8 +cryptoFlags = \case + NoAuthNoPriv -> 0 + AuthNoPriv _ -> 1 + AuthPriv _ _ -> 3 + +cryptoAuth :: Crypto -> Maybe AuthParameters +cryptoAuth = \case + NoAuthNoPriv -> Nothing + AuthNoPriv a -> Just a + AuthPriv a _ -> Just a + +cryptoPriv :: Crypto -> Maybe PrivParameters +cryptoPriv = \case + NoAuthNoPriv -> Nothing + AuthNoPriv _ -> Nothing + AuthPriv _ a -> Just a + +data ScopedPduData + = ScopedPduDataPlaintext !ScopedPdu + | ScopedPduDataEncrypted !ByteString + deriving (Eq,Show) + +newtype EngineId = EngineId { getEngineId :: ByteString } + deriving (Eq,Ord,Show) + +data ScopedPdu = ScopedPdu + { scopedPduContextEngineId :: !EngineId + , scopedPduContextName :: !ByteString + , scopedPduData :: !Pdus + } deriving (Eq,Show) + +data Usm = Usm + { usmAuthoritativeEngineId :: !EngineId + , usmAuthoritativeEngineBoots :: !Int32 + , usmAuthoritativeEngineTime :: !Int32 + , usmUserName :: !ByteString + , usmAuthenticationParameters :: !ByteString + , usmPrivacyParameters :: !ByteString + } deriving (Eq,Show) + +data Pdu = Pdu + { pduRequestId :: !RequestId + , pduErrorStatus :: !ErrorStatus + , pduErrorIndex :: !ErrorIndex + , pduVariableBindings :: !(Vector VarBind) + } deriving (Eq,Show) + +data BulkPdu = BulkPdu + { bulkPduRequestId :: !RequestId + , bulkPduNonRepeaters :: !Int32 + , bulkPduMaxRepetitions :: !Int32 + , bulkPduVariableBindings :: !(Vector VarBind) + } deriving (Eq,Show) + +data TrapPdu = TrapPdu + { trapPduEnterprise :: !ObjectIdentifier + , trapPduAgentAddress :: !Word32 + , trapPduGenericTrap :: !GenericTrap + , trapPduSpecificTrap :: !Integer + , trapPduTimeStamp :: !Integer + , trapPduVariableBindings :: [VarBind] + } deriving (Eq,Show) + +data GenericTrap + = GenericTrapColdStart + | GenericTrapWarmStart + | GenericTrapLinkDown + | GenericTrapLinkUp + | GenericTrapAuthenticationFailure + | GenericTrapEgpNeighborLoss + | GenericTrapEnterpriseSpecific + deriving (Eq,Show)