diff --git a/BUGS b/BUGS new file mode 100644 --- /dev/null +++ b/BUGS @@ -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. + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/NetSNMP.cabal b/NetSNMP.cabal new file mode 100644 --- /dev/null +++ b/NetSNMP.cabal @@ -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 +Maintainer: John Dorsey +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 + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Network/Protocol/NetSNMP.hsc b/src/Network/Protocol/NetSNMP.hsc new file mode 100644 --- /dev/null +++ b/src/Network/Protocol/NetSNMP.hsc @@ -0,0 +1,857 @@ + +{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} + +---------------------------------------------------------------------- +-- | +-- Module : Network.Protocol.NetSNMP +-- Copyright : 2009 John Dorsey +-- +-- Maintainer : John Dorsey +-- Portability : portable +-- Stability : provisional +-- +-- This is a binding to Net-SNMP version 5, . + +-- 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 +#include + +-- +-- 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 +