NetSNMP (empty) → 0.1.0
raw patch · 6 files changed
+1026/−0 lines, 6 filesdep +basesetup-changed
Dependencies added: base
Files
- BUGS +76/−0
- LICENSE +34/−0
- NetSNMP.cabal +30/−0
- README +27/−0
- Setup.hs +2/−0
- src/Network/Protocol/NetSNMP.hsc +857/−0
+ BUGS view
@@ -0,0 +1,76 @@++**+** BUGS file for the Haskell binding to net-snmp+**++The binding is new and largely untested; there are sure to be bugs and+many omissions.++** +** SECURITY CONSIDERATIONS+** ++This code has not undergone any security review, and is very immature.+It would be inappropriate to use this binding where security is a+priority, without taking appropriate measures.++** +** MISSING FEATURES+** ++This binding only supports a subset of the NetSNMP library's+"single-session" api. Only synchronous queries are supported, and only+the get, next, and walk operations.++No support for bulk get requests.++No support (and none planned) for snmp traps.++Many SNMP / ASN.1 data types are unsupported as yet.++This binding only addresses use of the library for an snmp client. No+effort is made to support snmp agent or proxy operations.++No support for snmpv3; currently only snmpv1 and snmpv2c with admittedly+insecure SNMP community strings.++This binding doesn't do anything with the library's log handling, and+the library's default action is to spam stderr. There should at least+be a way to prevent this, and it should possibly suppress the logs by+default.++This code should be publicly hosted, perhaps on code.haskell.org. It+should use a public trac.++** +** BROKENNESS+** ++Looking up OIDs by name doesn't seem to work yet. Once it's fixed+snmpwalk probably needs to be fixed as well. It uses `isPrefixOf` to+determine when the walk is over, which won't work if the original+oid isn't dotted-decimal.++This binding's exception checking is spotty and amateurish. Some of this+is because I haven't found any decent API docs for the net-snmp library.++There are too many things called 'session' in the library, and in the+binding:+- the C struct snmp_session. The 'single session' examples use *3* of+ these, with subtly different purposes, never fully explained.+- data SnmpSession, the binding's representation of 'struct snmp_session'+- data Session, the binding's abstract session container, holding+ the above and managing C memory (de)allocation++snmpWalk doesn't check for cyclical responses from an agent; reportedly+there are agents with this misfeature. Currently if it happens snmpWalk+will happily follow the cycle until it runs out of memory or stack.++I don't know how to intelligently set the alignment parameter for data+types representing C structs in their Storable instances. I'm using 16+bytes as a (hopefully) conservative setting, but isn't there a way to+detect and mimic what C uses?++The binding is currently one monolithic .hsc file. It should probably+be organized into a few modules.+
+ LICENSE view
@@ -0,0 +1,34 @@++Copyright (c) 2009, John A. Dorsey.+All rights reserved.++Redistribution and use of this software in source and binary forms,+with or without modification, are permitted provided that the+following conditions are met:++* Redistributions of source code must retain the above+ copyright notice, this list of conditions and the+ following disclaimer.++* Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the+ following disclaimer in the documentation and/or other+ materials provided with the distribution.++* Neither the name of John Dorsey 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 OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ NetSNMP.cabal view
@@ -0,0 +1,30 @@++Name: NetSNMP+Version: 0.1.0+Synopsis: Bindings for net-snmp's C API for clients+Description: Network.Protocol.NetSNMP is a partial binding to the+ library portion of the net-snmp package. It uses the+ 'single-session api', which is claimed to be+ thread-safe. Not all operations are supported yet;+ please contact the maintainer if you're in need of+ expanded functionality, and especially if you would+ like to contribute.+Category: Network+Copyright: (c) John Dorsey 2009+Cabal-Version: >= 1.2+License: BSD3+License-file: LICENSE+Author: John Dorsey <haskell@colquitt.org>+Maintainer: John Dorsey <haskell@colquitt.org>+Stability: alpha+Build-type: Simple+Bug-reports: mailto:haskell@colquitt.org++library+ hs-source-dirs: src+ build-depends: base+ build-tools: hsc2hs+ exposed-modules: Network.Protocol.NetSNMP+ extensions: ForeignFunctionInterface, CPP, EmptyDataDecls+ extra-libraries: netsnmp+
+ README view
@@ -0,0 +1,27 @@++The (Haskell) NetSNMP package is a binding for a subset of the libsnmp+api provided by the NetSNMP project. It is initially being developed+against NetSNMP version 5.4.1, but probably works with most or all 5.*+versions.++Currently supported protocol versions:+ SNMPv1 -- original SNMP+ SNMPv2c -- v2 protocol with old community-based security++Not yet supported:+ SNMPv3 -- v2 protocol plus new v3 party-based security++Other versions are not supported by the underlying library, and are+unlikely to ever be supported by this package.+ SNMPsec -- first attempt to add strong security to SNMPv1+ SNMPv2p -- initial SNMPv2, with v2 party-based security+ SNMPv2u -- v2 protocol with user-based security+ SNMPv2* -- proprietary hybrid variant of v2c and v2p++This binding requires that net-snmp be built without+NETSNMP_DISABLE_SNMPV1 or NETSNMP_DISABLE_SNMPV2C. I'd love to support+those options, since they may encourage better security, but haven't+made the effort.++See also: BUGS+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Network/Protocol/NetSNMP.hsc view
@@ -0,0 +1,857 @@++{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}++----------------------------------------------------------------------+-- |+-- Module : Network.Protocol.NetSNMP+-- Copyright : 2009 John Dorsey+-- +-- Maintainer : John Dorsey <haskell@colquitt.org>+-- Portability : portable+-- Stability : provisional+-- +-- This is a binding to Net-SNMP version 5, <http://www.net-snmp.org/>.++-- FIXME:+-- issue better errors using info from snmpError and snmpSessError+-- make better use of catchT+-- write bracketT++{- License: BSD3. See included LICENSE and README files. -}++module Network.Protocol.NetSNMP (+ -- * Types+ ASNValue(..), SnmpResult(..), SnmpVersion(..),+ Hostname, Community,+ -- * Constants+ snmp_version_1, snmp_version_2c, snmp_version_3,+ -- * Functions+ -- ** Library Initialization+ initialize,+ -- ** Queries+ snmpGet, snmpNext, snmpWalk,+ -- ** Miscellany+ showASNValue,+ -- + -- Unexposed:+ --+ -- Trouble(..), SnmpSession, SnmpPDU, OIDPart, readyCommunitySession,+ -- snmp_msg_get, rawvar2cstring, buildPDU, max_oid_len, snmp_stat_success,+ -- snmp_err_noerror, extractVar,+ -- c_init_snmp, c_snmp_sess_init, c_snmp_sess_open, c_snmp_sess_session,+ -- c_snmp_pdu_create, c_get_node, c_read_objid, c_snmp_parse_oid,+ -- c_snmp_add_null_var, c_snmp_sess_synch_response, c_snmp_free_pdu,+ -- c_snmp_sess_close, c_snmp_sess_send, c_print_variable, c_snprint_by_type,+ -- t_init_snmp, t_snmp_sess_init, t_snmp_sess_open, t_snmp_sess_session,+ -- t_snmp_pdu_create, t_get_node, t_read_objid, t_snmp_parse_oid,+ -- t_snmp_add_null_var, t_snmp_sess_synch_response, t_snmp_free_pdu,+ -- t_snmp_sess_close, t_snmp_sess_send, t_print_variable, t_snprint_by_type,+ )+where++import Control.Applicative+import Control.Monad+import Data.List+import Foreign+import Foreign.C.String+import Foreign.C.Types+import Foreign.ForeignPtr+-- import System.IO++#include <net-snmp/net-snmp-config.h>+#include <net-snmp/net-snmp-includes.h>++--+-- types and constants+--++-- max length of description string returned from the library+-- this can be safely tweaked up or down+max_string_len = 1023++-- Haskell-land session info, including various C snmp_session pointers+-- and session parameters. Meeting place for managing session memory.+data Session = Session+ { getVersion :: SnmpVersion+ , getSession :: ForeignPtr SnmpSession+ , getSessp :: Ptr SnmpSession+ , getSptr :: Ptr SnmpSession+ , sessionHostname :: ForeignPtr CChar+ , sessionCommunity :: ForeignPtr CChar+ }++data SnmpSession -- C struct snmp_session+instance Storable SnmpSession where+ sizeOf _ = #size struct snmp_session+ alignment _ = 16++data SnmpPDU -- C struct snmp_pdu+instance Storable SnmpPDU where+ sizeOf _ = #size struct snmp_pdu+ alignment _ = 16++#ifdef EIGHTBIT_SUBIDS+type OIDpart = CUChar -- C typedef oid+#else+type OIDpart = CULong+#endif++-- I don't know whether (or which of) net-snmp's library functions+-- account for bytesex; there may be endian bugs lurking here.+data CVarList -- C struct variable_list++-- |Typed representation of atomic ASN.1 data types. Some types are+-- returned in more than one format for different uses. Some+-- include a descriptive string built by the underlying C library.+data ASNValue+ = OctetString String [Word8] -- ^@ASN_OCTET_STR@ Returned as a character+ -- string, and as opaque data.+ | OID String String [Word32] -- ^@ASN_OBJECT_ID@ Returned as the C library's+ -- description, a dotted-decimal string, and+ -- a numeric list+ | Integer32 Int32 -- ^@ASN_INTEGER@ 32bit signed+ | Integer64 Int64 -- ^@ASN_INTEGER64@ 64bit signed+ | Counter32 Word32 -- ^@ASN_COUNTER@ 32bit nondecreasing+ | Counter64 Word64 -- ^@ASN_COUNTER64@ 64bit nondecreasing+ | Unsigned32 Word32 -- ^@ASN_UNSIGNED@ 32bit unsigned+ | Unsigned64 Word64 -- ^@ASN_UNSIGNED64@ 64bit unsigned+ | Gauge32 Word32 -- ^@ASN_GAUGE@ 32bit signed with min and max+ | IpAddress String [Word8] -- ^@ASN_IPADDRESS@ IP address in string+ -- and numeric form. Example:+ -- (IpAddress \"1.2.3.4\" [1,2,3,4])+ | Opaque [Word8] -- ^@ASN_OPAQUE@ (Deprecated) application+ -- specific data. Use OctetString instead.+ | TimeTicks String Word32 -- ^@ASN_TIMETICKS@ Time interval in 1/100 sec+ -- ticks. The C library's description is+ -- returned along with the raw value.+ | Boolean Bool -- ^@ASN_BOOLEAN@ Unimplemented.+ | IEEEFloat Float -- ^@ASN_FLOAT@ IEEE float. Unimplemented.+ | IEEEDouble Double -- ^@ASN_DOUBLE@ IEEE double. Unimplemented.+ | Null -- ^@ASN_NULL@ Null value+ | Unsupported Int String -- ^Unsupported type from an agent. Returns+ -- the numeric type and the C library's+ -- description of the value.+ deriving (Eq, Show)++-- |An SNMP value together with its OID. Returned by the query+-- routines 'snmpGet', 'snmpNext', and 'snmpWalk'.+data SnmpResult = SnmpResult {+ oid :: String, -- ^Dotted-decimal ObjectId of the value+ value :: ASNValue -- ^Typed representation of the value+ } deriving (Eq, Show)++-- |SNMP Protocol version. It is recommended to use the constants+-- 'snmp_version_1', 'snmp_version_2c', and 'snmp_version_3'.+newtype SnmpVersion = SnmpVersion {+ unSnmpVersion :: CLong -- ^Numeric version. Generally unneeded.+ } deriving (Eq, Show)++type Hostname = String+type Community = String++-- SNMP protocol versions, omitting those that will never be supported+-- (see README)+-- I'd prefer to use the more compact #{enum} in place of multiple+-- #{const}'s, but I don't know how to mix #{enum} with haddock.+-- #{enum SnmpVersion, SnmpVersion+-- , snmp_version_1 = SNMP_VERSION_1+-- , snmp_version_2c = SNMP_VERSION_2c+-- , snmp_version_3 = SNMP_VERSION_3+-- }++-- |SNMPv1. The first SNMP standard, using cleartext passwords+-- (\"communities\")+snmp_version_1 :: SnmpVersion+snmp_version_1 = SnmpVersion #{const SNMP_VERSION_1 }++-- |SNMPv2c. Updated SMI and wire protocol, but still uses communities.+snmp_version_2c :: SnmpVersion+snmp_version_2c = SnmpVersion #{const SNMP_VERSION_2c }++-- |SNMPv3. Same SMI and protocol as SNMPv2c; stronger authentication.+-- Unimplemented.+snmp_version_3 :: SnmpVersion+snmp_version_3 = SnmpVersion #{const SNMP_VERSION_3 }+++-- |ASN.1 constants from snmp_impl.h and asn1.h+#{enum CInt ,+ , asn_boolean = ASN_BOOLEAN+ , asn_integer = ASN_INTEGER+ , asn_bit_str = ASN_BIT_STR+ , asn_octet_str = ASN_OCTET_STR+ , asn_null = ASN_NULL+ , asn_object_id = ASN_OBJECT_ID+ , asn_sequence = ASN_SEQUENCE+ , asn_set = ASN_SET+ , asn_universal = ASN_UNIVERSAL+ , asn_application = ASN_APPLICATION+ , asn_context = ASN_CONTEXT+ , asn_private = ASN_PRIVATE+ , asn_primitive = ASN_PRIMITIVE+ , asn_constructor = ASN_CONSTRUCTOR+ , asn_long_len = ASN_LONG_LEN+ , asn_extension_id = ASN_EXTENSION_ID+ , asn_bit8 = ASN_BIT8+ , asn_ipaddress = ASN_IPADDRESS+ , asn_counter = ASN_COUNTER+ , asn_gauge = ASN_GAUGE+ , asn_unsigned = ASN_UNSIGNED+ , asn_timeticks = ASN_TIMETICKS+ , asn_opaque = ASN_OPAQUE+ , asn_nsap = ASN_NSAP+ , asn_counter64 = ASN_COUNTER64+ , asn_uinteger = ASN_UINTEGER+ , asn_float = ASN_FLOAT+ , asn_double = ASN_DOUBLE+ , asn_integer64 = ASN_INTEGER64+ , asn_unsigned64 = ASN_UNSIGNED64+ }++-- PDUType: used with: v1 v2c v3+-- SNMP_MSG_GET Yes Yes Yes+-- SNMP_MSG_GETNEXT Yes Yes Yes+-- SNMP_MSG_RESPONSE Yes Yes Yes+-- SNMP_MSG_SET Yes Yes Yes+-- SNMP_MSG_TRAP Yes - - +-- SNMP_MSG_GETBULK - Yes Yes+-- SNMP_MSG_INFORM - Yes Yes+-- SNMP_MSG_TRAP2 - Yes Yes+-- SNMP_MSG_REPORT - - Yes+newtype SnmpPDUType = SnmpPDUType { unSnmpPDUType :: CInt }+#{enum SnmpPDUType, SnmpPDUType+ , snmp_msg_get = SNMP_MSG_GET+ , snmp_msg_getnext = SNMP_MSG_GETNEXT+ , snmp_msg_response = SNMP_MSG_RESPONSE+ , snmp_msg_set = SNMP_MSG_SET+ , snmp_msg_trap = SNMP_MSG_TRAP+ , snmp_msg_getbulk = SNMP_MSG_GETBULK+ , snmp_msg_inform = SNMP_MSG_INFORM+ , snmp_msg_trap2 = SNMP_MSG_TRAP2+ , snmp_msg_report = SNMP_MSG_REPORT+ }++-- Miscellaneous return codes+-- NB: zero return is success in some functions, failure in others,+-- both within this api.++#{enum CInt,+ , snmp_stat_success = STAT_SUCCESS+ , snmp_err_noerror = SNMP_ERR_NOERROR+ }++max_oid_len = #{const MAX_OID_LEN} :: CInt++--+-- The Haskell abstraction layer+--++-- |Initialize the Net-SNMP library. This must be called before any+-- other NetSNMP functions, and before starting extra threads, as the+-- mib compiler is not thread-safe.+initialize :: IO ()+initialize = withCString "Haskell bindings" c_init_snmp++-- |Create an abstract session, suitable for reuse, responsible+-- for freeing the string components+readyCommunitySession+ :: SnmpVersion+ -> Hostname+ -> Community+ -> Trouble Session -- return abstract session+readyCommunitySession version hostname community = do+ session <- mallocT+ hostname_cstr <- hoistT $ newCString hostname+ community_cstr <- hoistT $ newCString community+ community_len <- t_strlen community_cstr+ session_foreign <- hoistT $ newForeignPtr finalizerFree session+ hostname_foreign <- hoistT $ newForeignPtr finalizerFree hostname_cstr+ community_foreign <- hoistT $ newForeignPtr finalizerFree community_cstr+ t_snmp_sess_init session+ pokeSessPeername session hostname_cstr+ pokeSessVersion session (unSnmpVersion version)+ pokeSessCommunity session community_cstr+ pokeSessCommLen session community_len+ sessp <- t_snmp_sess_open session+ sptr <- t_snmp_sess_session sessp+ return $ Session version session_foreign sessp sptr+ hostname_foreign community_foreign++-- |Immediately destroy/free the Session.+closeSession :: Session -> Trouble ()+closeSession session = hoistT $ do+ c_snmp_sess_close (getSessp session)+ finalizeForeignPtr (sessionCommunity session)+ finalizeForeignPtr (sessionHostname session)+ finalizeForeignPtr (getSession session)++-- |Simple community-authenticated SNMP get. Returns the object+-- queried, or a descriptive error message.+--+-- Examples:+--+-- * snmpGet \"localhost\" \"public\" \".1.3.6.1.2.1.1.1.0\"+--+-- * snmpGet \"tcp:localhost:5161\" \"mypassword\" \".1.3.6.1.2.1.1.1.0\"+snmpGet+ :: SnmpVersion -- ^'snmp_version_1' or 'snmp_version_2c'+ -> Hostname -- ^IP or hostname of the agent to be queried. May have+ -- prefix of @tcp:@ or suffix of @:port@+ -> Community -- ^SNMP community (password)+ -> String -- ^OID to be queried+ -> IO (Either String SnmpResult)+snmpGet version hostname community oid = runTrouble $ do+ session <- readyCommunitySession version hostname community+ let get = mkSnmpGet snmp_msg_get session+ result <- get oid+ closeSession session+ return result++-- |Simple community-authenticated SNMP getnext. Returns the first object+-- after the OID queried, or a descriptive error message.+--+-- Examples:+--+-- * snmpNext \"localhost\" \"public\" \".1.3.6.1.2.1.1.1.0\"+--+-- * snmpNext \"tcp:localhost:5161\" \"mypassword\" \".1.3.6.1.2.1.1.1.0\"+snmpNext+ :: SnmpVersion -- ^'snmp_version_1' or 'snmp_version_2c'+ -> Hostname -- ^IP or hostname of the agent to be queried. May have+ -- prefix of @tcp:@ or suffix of @:port@+ -> Community -- ^SNMP community (password)+ -> String -- ^OID to be queried+ -> IO (Either String SnmpResult)+snmpNext version hostname community oid = runTrouble $ do+ session <- readyCommunitySession version hostname community+ let next = mkSnmpGet snmp_msg_getnext session+ result <- next oid+ closeSession session+ return result++-- |Simple community-authenticated SNMP walk. Returns a list of objects,+-- starting with the object after the OID queried, and continuing+-- through all objects underneath that OID in the mib tree.+-- On failure, returns a descriptive error message.+--+-- The current implementation uses a series of next operations, but an+-- implementation using bulk requests would be more efficient.+--+-- Examples:+--+-- * snmpWalk \"localhost\" \"public\" \".1.3.6.1.2.1.1\"+--+-- * snmpWalk \"tcp:localhost:5161\" \"mypassword\" \".1.3.6.1.2.1.1\"+snmpWalk+ :: SnmpVersion -- ^'snmp_version_1' or 'snmp_version_2c'+ -> Hostname -- ^IP or hostname of the agent to be queried. May have+ -- prefix of @tcp:@ or suffix of @:port@+ -> Community -- ^SNMP community (password)+ -> String -- ^OID to be queried+ -> IO (Either String [SnmpResult])+snmpWalk version hostname community walkoid = runTrouble $ do+ session <- readyCommunitySession version hostname community+ let next = mkSnmpGet snmp_msg_getnext session+ result <- go next walkoid+ closeSession session+ return result+ where+ go :: (String -> Trouble SnmpResult) -> String -> Trouble [SnmpResult]+ -- go next oid = flip catchT (const $ return []) $ do+ go next oid = do+ v@(SnmpResult nextoid val) <- next oid+ case () of+ _ | nextoid == oid -> return [] -- throwT "end of mib" -- return []+ | walkoid `isPrefixOf` nextoid -> do+ vs <- go next nextoid+ return (v:vs)+ | otherwise -> return [] -- throwT "end of walk" -- return []++-- get or getnext, using session info from a 'data Session' and+-- the supplied oid+-- It is the caller's obligation to ensure the session's validity.+mkSnmpGet :: SnmpPDUType -> Session -> String -> Trouble SnmpResult+mkSnmpGet pdutype session oid =+ allocaT $ \response_ptr -> do+ allocaArrayT (fromIntegral max_oid_len) $ \oids -> do+ let version = getVersion session+ let sessp = getSessp session+ let sptr = getSptr session+ pokeT response_ptr nullPtr -- probably not needed+ pdu_req <- buildPDU pdutype oid oids version+ t_snmp_sess_synch_response sessp sptr pdu_req response_ptr+ pdu_resp <- peekT response_ptr+ errstat <- peekPDUErrstat pdu_resp+ when (errstat /= snmp_err_noerror) (throwT "response PDU error")+ rawvars <- peekPDUVariables pdu_resp+ vars <- extractVar rawvars+ unless (pdu_resp == nullPtr) $ t_snmp_free_pdu pdu_resp >> return ()+ return vars++-- caller is obliged to ensure rv is valid and non-null+vlist2oid :: Ptr CVarList -> Trouble String+vlist2oid rv = do+ oidptr <- peekVariableName rv+ len <- peekVariableLen rv+ oids <- peekArrayT (fromIntegral len) oidptr :: Trouble [OIDpart]+ return $ concatMap (('.':) . show) oids++extractVars :: Ptr CVarList -> Trouble [SnmpResult]+extractVars rv+ | rv == nullPtr = return []+ | otherwise = do+ v <- extractVar rv+ nextrv <- peekVariableNext rv+ vs <- extractVars nextrv+ return (v : vs)++extractVar :: Ptr CVarList -> Trouble SnmpResult+extractVar rv = do+ oid <- vlist2oid rv+ t <- peekVariableType rv+ v <- case () of+ _ | t == asn_octet_str -> extractOctetStr rv+ _ | t == asn_ipaddress -> extractIpAddress rv+ _ | t == asn_counter -> extractIntegralType rv Counter32+ _ | t == asn_gauge -> extractIntegralType rv Gauge32+ _ | t == asn_timeticks -> extractTimeTicks rv+ _ | t == asn_opaque -> extractOpaque rv+ _ | t == asn_integer -> extractIntegralType rv Integer32+ _ | t == asn_unsigned -> extractIntegralType rv Unsigned32+ _ | t == asn_counter64 -> extractIntegralType rv Counter64+ _ | t == asn_integer64 -> extractIntegralType rv Integer64+ _ | t == asn_unsigned64 -> extractIntegralType rv Unsigned64+ _ | t == asn_object_id -> extractOID rv+ -- _ | t == asn_boolean -> extractBoolean rv+ -- _ | t == asn_double -> extractDouble rv+ -- _ | t == asn_float -> extractFloat rv+ _ | t == asn_null -> return Null+ _ -> do+ descr <- rawvar2cstring rv+ return $ Unsupported (fromIntegral t) descr+ return (SnmpResult oid v)++extractOctetStr rv = do+ ptr <- peekVariableValString rv+ len <- peekVariableValLen rv+ s <- peekCStringLenT (ptr , (fromIntegral len))+ octets <- peekArrayT (fromIntegral len) (castPtr ptr)+ return (OctetString s octets)++extractOpaque rv = do+ ptr <- peekVariableValBits rv+ len <- peekVariableValLen rv+ arr <- peekArrayT (fromIntegral len) ptr+ return (Opaque (map fromIntegral arr))++extractIntegralType rv constructor = do+ intptr <- peekVariableValInt rv+ n <- fromIntegral <$> peekT intptr+ return (constructor n)++extractIpAddress rv = do+ ptr <- peekVariableValInt rv+ octets <- peekArrayT 4 (castPtr ptr) :: Trouble [Word8]+ let str = foldr1 (\a b -> (a++"."++b)) (map show octets)+ return (IpAddress str octets)++extractOID :: Ptr CVarList -> Trouble ASNValue+extractOID rv = do+ oidptr <- peekVariableValObjid rv :: Trouble (Ptr OIDpart)+ len <- peekVariableValLen rv+ let oidlen = (fromIntegral len) `div` #{size oid}+ oids <- peekArrayT oidlen oidptr :: Trouble [OIDpart]+ let str = concatMap (('.':) . show) oids+ descr <- rawvar2cstring rv+ return (OID descr str (map fromIntegral oids))++extractTimeTicks rv = do+ intptr <- peekVariableValInt rv+ ticks <- fromIntegral <$> peekT intptr+ descr <- rawvar2cstring rv+ return (TimeTicks descr ticks)++-- |Show ASNValue contents in a simple string, losing type differentiation.+-- Callers should not rely on the format of the message returned,+-- and this function may disappear in a future version.+showASNValue :: ASNValue -> String+showASNValue v = case v of+ OctetString s _ -> s+ IpAddress s _ -> s+ Counter32 c -> show c + Gauge32 c -> show c + OID d os ol -> os+ Opaque cs -> show cs+ Integer32 c -> show c+ Unsigned32 c -> show c + Counter64 c -> show c + Integer64 c -> show c+ Unsigned64 c -> show c + TimeTicks s _ -> s+ Boolean c -> show c+ IEEEDouble c -> show c+ IEEEFloat c -> show c+ Null -> "ASN_NULL"+ Unsupported t s -> "Unknown type " ++ show t ++ ": " ++ s++buildPDU+ :: SnmpPDUType -- eg. snmp_msg_get+ -> String -- eg. ".1.3.6.1.2.1.1.1.0"+ -> Ptr OIDpart -- OIDpart array passed in b/c I don't know when it dallocs+ -> SnmpVersion -- eg. snmp_version_1 or snmp_version_2c+ -> Trouble (Ptr SnmpPDU) -- returns pdu and oid length+buildPDU pdutype oid oids version =+ withCStringT oid $ \oid_cstr ->+ allocaT $ \oidlen_ptr -> do+ pdu_req <- t_snmp_pdu_create pdutype+ pokePDUVersion pdu_req (unSnmpVersion version)+ pokePDUCommand pdu_req (unSnmpPDUType pdutype)+ pokeT oidlen_ptr (fromIntegral max_oid_len)+ t_read_objid oid_cstr oids oidlen_ptr -- or t_get_node+ oidlen <- peekT oidlen_ptr+ t_snmp_add_null_var pdu_req oids oidlen+ return pdu_req++rawvar2cstring :: Ptr CVarList -> Trouble String+rawvar2cstring rv =+ allocaArray0T max_string_len $ \buf -> do+ rc <- t_snprint_by_type buf (fromIntegral max_string_len) rv+ nullPtr nullPtr nullPtr+ peekCStringT buf++allocaT :: (Storable a) => (Ptr a -> Trouble b) -> Trouble b+allocaT f = Trouble $ alloca $ \p -> runTrouble (f p)++allocaArrayT :: (Storable a) => Int -> (Ptr a -> Trouble b) -> Trouble b+allocaArrayT n f = Trouble $ allocaArray n $ \p -> runTrouble (f p)++allocaArray0T :: (Storable a) => Int -> (Ptr a -> Trouble b) -> Trouble b+allocaArray0T n f = Trouble $ allocaArray0 n $ \p -> runTrouble (f p)++withCStringT :: String -> (CString -> Trouble b) -> Trouble b+withCStringT s f = Trouble $ withCString s $ \p -> runTrouble (f p)++peekCStringT = hoistT1 peekCString+peekCStringLenT = hoistT1 peekCStringLen++-- Is it worth putting the error check here? No, for now.+mallocT :: (Storable a) => Trouble (Ptr a)+mallocT = hoistT malloc++mallocArrayT :: (Storable a) => Int -> Trouble (Ptr a)+mallocArrayT = hoistT1 mallocArray++mallocArray0T :: (Storable a) => Int -> Trouble (Ptr a)+mallocArray0T = hoistT1 mallocArray0++peekT :: (Storable a) => Ptr a -> Trouble a+peekT = hoistT1 peek++pokeT :: (Storable a) => Ptr a -> a -> Trouble ()+pokeT = hoistT2 poke++peekArrayT :: (Storable a) => Int -> Ptr a -> Trouble [a]+peekArrayT = hoistT2 peekArray++peekPDUErrstat :: Ptr SnmpPDU -> Trouble CInt+peekPDUErrstat p = hoistT $ #{peek struct snmp_pdu , errstat} p++peekPDUVariables :: Ptr SnmpPDU -> Trouble (Ptr CVarList)+peekPDUVariables p = hoistT $ #{peek struct snmp_pdu , variables} p++peekVariableName :: Ptr CVarList -> Trouble (Ptr OIDpart)+peekVariableName rv = hoistT $ #{peek struct variable_list , name} rv++peekVariableLen :: Ptr CVarList -> Trouble CSize+peekVariableLen rv = hoistT $ #{peek struct variable_list , name_length} rv++peekVariableNext :: Ptr CVarList -> Trouble (Ptr CVarList)+peekVariableNext rv = hoistT $ #{peek struct variable_list , next_variable} rv++peekVariableType :: Ptr CVarList -> Trouble CInt+peekVariableType rv = hoistT $ #{peek struct variable_list , type} rv++peekVariableValBits :: Ptr CVarList -> Trouble (Ptr CUChar)+peekVariableValBits rv = hoistT $ #{peek struct variable_list, val.bitstring} rv++peekVariableValInt :: Ptr CVarList -> Trouble (Ptr CLong)+peekVariableValInt rv = hoistT $ #{peek struct variable_list, val.integer} rv++peekVariableValString :: Ptr CVarList -> Trouble CString+peekVariableValString rv = hoistT $ #{peek struct variable_list, val.string} rv++peekVariableValObjid :: Ptr CVarList -> Trouble (Ptr OIDpart)+peekVariableValObjid rv = hoistT $ #{peek struct variable_list, val.objid} rv++peekVariableValLen :: Ptr CVarList -> Trouble CSize+peekVariableValLen rv = hoistT $ #{peek struct variable_list, val_len} rv++pokeSessPeername :: Ptr SnmpSession -> CString -> Trouble ()+pokeSessPeername s h = hoistT $ #{poke struct snmp_session , peername} s h++pokeSessVersion :: Ptr SnmpSession -> CLong -> Trouble ()+pokeSessVersion s v = hoistT $ #{poke struct snmp_session , version} s v++pokeSessCommunity :: Ptr SnmpSession -> CString -> Trouble ()+pokeSessCommunity s c = hoistT $ #{poke struct snmp_session , community} s c++pokeSessCommLen :: Ptr SnmpSession -> CSize -> Trouble ()+pokeSessCommLen s l = hoistT $ #{poke struct snmp_session , community_len} s l++pokePDUVersion :: Ptr SnmpPDU -> CLong -> Trouble ()+pokePDUVersion p v = hoistT $ #{poke struct snmp_pdu , version} p v++pokePDUCommand :: Ptr SnmpPDU -> CInt -> Trouble ()+pokePDUCommand p t = hoistT $ #{poke struct snmp_pdu , command} p t++--+-- The C library layer+--+-- FFI C import statements, together with wrappers to put them+-- in the (Trouble a) exception handling monad+--++-- initialize the library+-- This must be called before any other library functions, and before+-- any threads are forked, because the initialization is not thread-safe,+-- specifically the mib tree compiler.+foreign import ccall unsafe "net-snmp/net-snmp-includes.h init_snmp"+ c_init_snmp :: CString -> IO ()++-- t_init_snmp = hoistT1 c_init_snmp++-- "init session"+-- JD: Apparently this only sets parameters in the struct snmp_session.+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_init"+ c_snmp_sess_init :: Ptr SnmpSession -> IO ()++t_snmp_sess_init = hoistT1 c_snmp_sess_init++-- "open session". How does this differ from the above? I haven't+-- found any clarifying api docs.+-- JD: Apparently this allocates a socket for UDP, or opens a TCP connection.+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_open"+ c_snmp_sess_open :: Ptr SnmpSession -> IO (Ptr SnmpSession)++t_snmp_sess_open = hoistTE1+ (predToMaybe (== nullPtr) "snmp_sess_open failed") c_snmp_sess_open++-- Third and final session initialization routine.+-- JD: This seems to be used to coordinate asynchronous queries in the+-- (thread safe) session, and in error tracking/reporting.+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_session"+ c_snmp_sess_session :: Ptr SnmpSession -> IO (Ptr SnmpSession)++t_snmp_sess_session = hoistTE1+ (predToMaybe (== nullPtr) "snmp_sess_session failed") c_snmp_sess_session++-- Create PDU structure with defaults by type+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_pdu_create"+ c_snmp_pdu_create :: SnmpPDUType -> IO (Ptr SnmpPDU)++t_snmp_pdu_create = hoistTE1+ (predToMaybe (== nullPtr) "snmp_pdu_create failed")+ c_snmp_pdu_create++-- Parse string argument as OID; populate OIDpart array and size+foreign import ccall unsafe "net-snmp/net-snmp-includes.h get_node"+ c_get_node :: CString -> Ptr OIDpart -> Ptr CSize -> IO CInt++t_get_node = hoistTE3+ (predToMaybe (not . (>0)) "get_node failed")+ -- (\i -> if (i <= 0) then Just "get_node failed" else Nothing)+ c_get_node++-- OID parser/builder script. How does this differ from get_node?+foreign import ccall unsafe "net-snmp/net-snmp-includes.h read_objid"+ c_read_objid :: CString -> Ptr OIDpart -> Ptr CSize -> IO CInt++t_read_objid = hoistTE3+ (predToMaybe (not . (>0)) "read_objid failed")+ -- (\i -> if (i <= 0) then Just "read_objid failed" else Nothing)+ c_read_objid++-- OID parser/builder script. How does this differ from get_node?+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_parse_oid"+ c_snmp_parse_oid :: CString -> Ptr OIDpart -> Ptr CSize -> IO CInt++t_snmp_parse_oid = hoistTE3+ (predToMaybe (not . (>0)) "snmp_parse_oid failed")+ -- (\i -> if (i <= 0) then Just "snmp_parse_oid failed" else Nothing)+ c_snmp_parse_oid++-- Add oid with void result; suitable for building a query+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_add_null_var"+ c_snmp_add_null_var :: Ptr SnmpPDU -> Ptr OIDpart -> CSize -> IO ()++t_snmp_add_null_var = hoistT3 c_snmp_add_null_var++-- Send request PDU and wait for response.+foreign import ccall unsafe+ "net-snmp/net-snmp-includes.h snmp_sess_synch_response"+ c_snmp_sess_synch_response :: Ptr SnmpSession -> Ptr SnmpPDU+ -> Ptr (Ptr SnmpPDU) -> IO CInt++-- t_snmp_sess_synch_response = hoistTE3+-- (predToMaybe (/= snmp_stat_success) "snmp_sess_synch_response failed")+-- c_snmp_sess_synch_response++-- improved (?) version with fuller error handling+t_snmp_sess_synch_response :: Ptr SnmpSession -> Ptr SnmpSession+ -> Ptr SnmpPDU -> Ptr (Ptr SnmpPDU) -> Trouble ()+t_snmp_sess_synch_response sessp sptr pdu_req response_ptr = Trouble $ do+ success <- c_snmp_sess_synch_response sessp pdu_req response_ptr+ if (success == snmp_stat_success)+ then return (Right ())+ else Left <$> snmpSessError sptr++-- Deallocate PDU struct+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_free_pdu"+ c_snmp_free_pdu :: Ptr SnmpPDU -> IO ()++t_snmp_free_pdu = hoistT1 c_snmp_free_pdu++-- Deallocate session and free associated resources.+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_close"+ c_snmp_sess_close :: Ptr SnmpSession -> IO ()++t_snmp_sess_close = hoistT1 c_snmp_sess_close++-- Send and enqueue request PDU for asynch use, not currently supported.+-- foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_sess_send"+-- c_snmp_sess_send :: Ptr SnmpSession -> Ptr SnmpPDU -> IO CInt++-- Print result value to stdout+foreign import ccall unsafe "net-snmp/net-snmp-includes.h print_variable"+ c_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> IO ()++t_print_variable = hoistT3 c_print_variable++-- t_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> Trouble ()+-- t_print_variable o s r = Trouble $ Right <$> c_print_variable o s r+++-- Return library error description+-- This one should only be used for failure of snmp_sess_open; use+-- the (void *) return by that function at other times.+-- library/snmp_api.h+-- void snmp_error(netsnmp_session *, int *, int *, char **);+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_error"+ c_snmp_error :: Ptr SnmpSession -> Ptr CInt -> Ptr CInt+ -> Ptr CString -> IO ()++snmpError :: Ptr SnmpSession -> IO String+snmpError p = do+ alloca $ \libp -> do -- pointer to library error code+ alloca $ \sysp -> do -- pointer to system error code+ alloca $ \errp -> do -- pointer to error CString+ c_snmp_error p libp sysp errp+ liberr <- peek libp+ syserr <- peek sysp+ cserr <- peek errp+ err <- peekCString cserr+ free cserr+ return $ "snmpError: lib:" ++ show liberr ++ " ; sys:" ++ show syserr+ ++ " ; " ++ err++-- Return library error description+-- This one is preferred for all single-session api failures except+-- snmp_sess_open failure. +-- library/snmp_api.h+-- void snmp_sess_error(void *, int *, int *, char **);+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_error"+ c_snmp_sess_error :: Ptr SnmpSession -> Ptr CInt -> Ptr CInt+ -> Ptr CString -> IO ()++snmpSessError :: Ptr SnmpSession -> IO String+snmpSessError p = do+ alloca $ \libp -> do -- pointer to library error code+ alloca $ \sysp -> do -- pointer to system error code+ alloca $ \errp -> do -- pointer to error CString+ c_snmp_sess_error p libp sysp errp+ liberr <- peek libp+ syserr <- peek sysp+ cserr <- peek errp+ err <- peekCString cserr+ free cserr+ return $ "snmpSessError: lib:" ++ show liberr ++ " ; sys:" ++ show syserr+ ++ " ; " ++ err++-- int snprint_by_type(char *buf, size_t buf_len, netsnmp_variable_list * var,+-- const struct enum_list *enums, const char *hint, const char *units);+foreign import ccall unsafe "net-snmp/net-snmp-includes.h snprint_by_type"+ c_snprint_by_type :: CString -> CSize -> Ptr CVarList ->+ Ptr () -> Ptr () -> Ptr () -> IO CInt++t_snprint_by_type = hoistT6 c_snprint_by_type++foreign import ccall unsafe "string.h strlen"+ c_strlen :: Ptr CChar -> IO CSize++t_strlen = hoistT1 c_strlen++--+-- Trouble a+--+-- A simple exception handling monad+--++-- Better would be to use ErrorT from the mtl (or other transformer+-- library) but I don't want the dependency before the dust has settled+-- between them; it smells like a compatibility tarpit.+-- type Trouble = ErrorT String IO++newtype Trouble a = Trouble { runTrouble :: IO (Either String a) }++instance Functor Trouble where+ fmap f m = Trouble $ do+ r <- runTrouble m+ case r of (Left s) -> return (Left s)+ (Right v) -> return (Right (f v))++instance Monad Trouble where+ return a = Trouble $ return (Right a)+ m >>= f = Trouble $ do+ r <- runTrouble m+ case r of (Left s) -> return (Left s)+ (Right v) -> runTrouble (f v)++throwT :: String -> Trouble a+throwT s = Trouble $ return (Left s)++catchT :: Trouble a -> (String -> Trouble a) -> Trouble a+catchT m h = Trouble $ do+ r <- runTrouble m+ case r of (Left s) -> runTrouble (h s)+ (Right v) -> return r++-- Routines to 'hoist' anything with IO return type into the+-- equivalent with (Trouble a) ie. IO (Either String a) return type.++hoistT :: IO t -> Trouble t+hoistT f = Trouble $ Right <$> f++hoistT1 :: (a -> IO t) -> a -> Trouble t+hoistT1 f a = hoistT (f a)+hoistT2 f a = hoistT1 (f a)+hoistT3 f a = hoistT2 (f a)+hoistT4 f a = hoistT3 (f a)+hoistT5 f a = hoistT4 (f a)+hoistT6 f a = hoistT5 (f a)++-- hoist from IO with success check(s)+hoistTE0 :: (t -> Maybe String) -> IO t -> Trouble t+hoistTE0 e f = Trouble $ do+ t <- f+ return $ maybe (Right t) Left (e t)++hoistTE1 e f a = hoistTE0 e (f a)+hoistTE2 e f a = hoistTE1 e (f a)+hoistTE3 e f a = hoistTE2 e (f a)+hoistTE4 e f a = hoistTE3 e (f a)+hoistTE5 e f a = hoistTE4 e (f a)+hoistTE6 e f a = hoistTE5 e (f a)++predToMaybe :: (a -> Bool) -> b -> a -> Maybe b+predToMaybe p b a = if (p a) then Just b else Nothing+