snmp 0.2.1.1 → 0.3.0.0

raw patch · 15 files changed

+1222/−1887 lines, 15 filesdep +cryptonitedep +ipdep +language-asndep −asn1-encodingdep −asn1-parsedep −asn1-typesdep ~basedep ~bytestringdep ~containerssetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptonite, ip, language-asn, memory, stm, vector

Dependencies removed: asn1-encoding, asn1-parse, asn1-types, async, binary, cipher-aes, cipher-des, crypto-cipher-types, cryptohash, mtl, network-info, random, securemem, text, time

Dependency ranges changed: base, bytestring, containers, network

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• LICENSE +19/−20
• Setup.hs +0/−2
• snmp.cabal +51/−40
• src/Network/Protocol/Snmp.hs +0/−1059
• src/Network/Snmp/Client.hs +0/−58
• src/Network/Snmp/Client/Internal.hs +0/−67
• src/Network/Snmp/Client/Types.hs +0/−56
• src/Network/Snmp/Client/Version2.hs +0/−125
• src/Network/Snmp/Client/Version3.hs +0/−272
• src/Network/Snmp/Example.hs +0/−188
• src/Snmp/Client.hs +451/−0
• src/Snmp/Decoding.hs +160/−0
• src/Snmp/Encoding.hs +345/−0
• src/Snmp/Types.hs +184/−0

@@ -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

@@ -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.

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -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 <chemistmail@gmail.com>--- 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

@@ -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-

@@ -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      -

@@ -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)---

@@ -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--

@@ -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-        } -

@@ -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-

@@ -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]-

@@ -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+

@@ -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

@@ -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 #-}+

@@ -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)