{-# LANGUAGE CPP, DoAndIfThenElse, ForeignFunctionInterface, EmptyDataDecls, OverloadedStrings #-} ---------------------------------------------------------------------- -- | -- Module : Network.Protocol.NetSNMP -- -- Maintainer : Pavlo Kerestey -- Portability : portable -- -- This is a binding to Net-SNMP version 5, . {- License: BSD3. See included LICENSE and README files. -} module Network.Protocol.NetSNMP ( -- * Types ASNValue(..), SnmpResult(..), SnmpVersion(..), RawOID, OIDpart, Hostname, Community, -- * Constants snmp_version_1, snmp_version_2c, snmp_version_3, -- * Functions -- ** Library Initialization initialize, -- ** Queries snmpGet, snmpNext, snmpWalk, snmpBulkWalk, snmpBulkWalkN, -- ** Miscellany showASNValue, ) where import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.ByteString.Char8 () import qualified Data.ByteString.Char8 as BC import Data.List import Foreign hiding (void) import Foreign.C.String import Foreign.C.Types #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 , getSessp :: Ptr SnmpSession , getSptr :: Ptr SnmpSession } 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 -- |The net-snmp C library on 64-bit OS X systems still uses 32-bit oid parts in -- the responses. Please make sure that the library produces sane -- results on your system by cloning the source code and running `make test`. #if defined(darwin) type OIDpart = CUInt #else type OIDpart = #{type oid} #endif /* GHC */ type RawOID = [OIDpart] showOid :: RawOID -> String showOid = concatMap (('.':) . show) oidToByteString :: RawOID -> ByteString oidToByteString = BC.pack . showOid -- 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 ByteString [Word8] -- ^@ASN_OCTET_STR@ Returned as a character -- string, and as opaque data. | OID ByteString ByteString [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 ByteString [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 ByteString 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 ByteString -- ^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 :: RawOID, -- ^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 = ByteString type Community = ByteString -- 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 CUChar , , 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_stat_error = STAT_ERROR , snmp_stat_timeout = STAT_TIMEOUT , 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 = do withCString "Haskell bindings" c_init_snmp void $ withCString "127.0.0.1" $ \localhost -> withCString "public" $ \public -> alloca $ \session -> runTrouble $ readyCommunitySession snmp_version_2c localhost public session >>= closeSession -- |Create an abstract session, suitable for reuse, responsible -- for freeing the string components readyCommunitySession :: SnmpVersion -> CString -- Hostname -> CString -- Community -> Ptr SnmpSession -- "session" -> Trouble Session -- return abstract session readyCommunitySession version hostname community session = do community_len <- t_strlen community t_snmp_sess_init session pokeSessRetries session 3 pokeSessTimeout session 10000000 pokeSessPeername session hostname pokeSessVersion session (unSnmpVersion version) pokeSessCommunity session community pokeSessCommLen session community_len sessp <- t_snmp_sess_open session sptr <- t_snmp_sess_session sessp return $ Session version sessp sptr -- |Immediately destroy/free the Session. closeSession :: Session -> Trouble () -- frees the SnmpSession object allocated by readyCommunitySession closeSession session = hoistT (c_snmp_sess_close (getSessp 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) -> RawOID -- ^OID to be queried -> IO (Either String SnmpResult) snmpGet version hostname community oid' = B.useAsCString hostname $ \cshost -> B.useAsCString community $ \cscomm -> alloca $ \session -> runTrouble $ bracketT (readyCommunitySession version cshost cscomm session) closeSession (flip (mkSnmpGet snmp_msg_get) oid') -- |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) -> RawOID -- ^OID to be queried -> IO (Either String SnmpResult) snmpNext version hostname community oid' = B.useAsCString hostname $ \cshost -> B.useAsCString community $ \cscomm -> alloca $ \session -> runTrouble $ bracketT (readyCommunitySession version cshost cscomm session) closeSession (flip (mkSnmpGet snmp_msg_getnext) oid') -- |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. -- -- This implementation uses a series of next operations and is not very -- ressource friendly. Consider using snmpBulkWalk for better performance -- -- Examples: -- -- * snmpWalk snmp_version_2c \"localhost\" \"public\" [1,3,6,1,2,1,1] -- -- * snmpWalk snmp_version_2c \"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) -> RawOID -- ^OID to be queried -> IO (Either String [SnmpResult]) snmpWalk version hostname community walkoid = B.useAsCString hostname $ \cshost -> B.useAsCString community $ \cscomm -> alloca $ \session -> runTrouble $ bracketT (readyCommunitySession version cshost cscomm session) closeSession (go walkoid . mkSnmpGet snmp_msg_getnext) where go :: RawOID -> (RawOID -> Trouble SnmpResult) -> Trouble [SnmpResult] go oid' next = do v@(SnmpResult nextoid _) <- next oid' case () of _ | nextoid == oid' -> return [] -- throwT "end of mib" | walkoid `isPrefixOf` nextoid -> do vs <- go nextoid next return (v:vs) | otherwise -> return [] -- throwT "end of walk" -- |Same as snmpWalk but implemented with bulk requests -- -- Examples: -- -- * snmpBulkWalk \"localhost\" \"public\" [1,3,6,1,2,1,1] -- -- * snmpBulkWalk \"tcp:localhost:5161\" \"mypassword\" [1,3,6,1,2,1,1] snmpBulkWalk :: Hostname -- ^IP or hostname of the agent to be queried. May have -- prefix of @tcp:@ or suffix of @:port@ -> Community -- ^SNMP community (password) -> RawOID -- ^OID to be queried -> IO (Either String [SnmpResult]) snmpBulkWalk hostname community walkoid = snmpBulkWalkN hostname community walkoid 30 snmpBulkWalkN :: Hostname -- ^IP or hostname of the agent to be queried. May have -- prefix of @tcp:@ or suffix of @:port@ -> Community -- ^SNMP community (password) -> RawOID -- ^OID to be queried -> CLong -- ^Max Repititons -> IO (Either String [SnmpResult]) snmpBulkWalkN hostname community walkoid maxReps = B.useAsCString hostname $ \cshost -> B.useAsCString community $ \cscomm -> alloca $ \session -> runTrouble $ bracketT (readyCommunitySession snmp_version_2c cshost cscomm session) closeSession (bulkWalk walkoid walkoid) where bulkWalk :: RawOID -> RawOID -> Session -> Trouble [SnmpResult] bulkWalk rootoid startoid session = do res <- filter (onlySubIds rootoid) <$> mkSnmpBulkGet 0 maxReps startoid session let resOids = map oid res case res of [] -> return [] rs -> if (nub resOids == resOids) then (res ++) <$> bulkWalk rootoid (oid (last rs)) session else throwT "OID do not increase. The server responds in a loop." onlySubIds :: RawOID -> SnmpResult -> Bool onlySubIds rootoid res = rootoid `isPrefixOf` oid res -- getbulk, using session info from a 'data Session' and -- the supplied oid -- It is the caller's obligation to ensure the session's validity. mkSnmpBulkGet :: CLong -> CLong -> RawOID -> Session -> Trouble [SnmpResult] mkSnmpBulkGet non_repeaters max_repetitions oid' session = allocaArrayT (fromIntegral max_oid_len) $ \oids -> do let version = getVersion session pdu_req <- buildPDU snmp_msg_getbulk oid' oids version pokePDUNonRepeaters pdu_req non_repeaters pokePDUMaxRepetitions pdu_req max_repetitions dispatchSnmpReq pdu_req session -- 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 -> RawOID -> Trouble SnmpResult mkSnmpGet pdutype session oid' = do res <- allocaArrayT (fromIntegral max_oid_len) $ \oids -> do let version = getVersion session pdu_req <- buildPDU pdutype oid' oids version dispatchSnmpReq pdu_req session if null res then throwT ("Could not get the snmp value at " ++ showOid oid') else return $ head res dispatchSnmpReq :: Ptr SnmpPDU -> Session -> Trouble [SnmpResult] dispatchSnmpReq pdu_req session = allocaT $ \response_ptr -> do let sessp = getSessp session let sptr = getSptr session pokeT response_ptr nullPtr handleT (\s -> do pdu_resp <- peekT response_ptr unless (pdu_resp == nullPtr) $ t_snmp_free_pdu pdu_resp throwT s) (do 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: "++show errstat)) rawvars <- peekPDUVariables pdu_resp vars <- extractVars rawvars unless (pdu_resp == nullPtr) $ t_snmp_free_pdu pdu_resp return vars) -- caller is obliged to ensure rv is valid and non-null vlist2oid :: Ptr CVarList -> Trouble RawOID vlist2oid rv = do oidptr <- peekVariableName rv len <- peekVariableLen rv peekArrayT (fromIntegral len) oidptr 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 -> extractIntegral64Type rv Counter64 _ | t == asn_integer64 -> extractIntegral64Type rv Integer64 _ | t == asn_unsigned64 -> extractIntegral64Type rv Unsigned64 _ | t == asn_object_id -> extractOID 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) extractIntegral64Type rv constructor = do ptr <- peekVariableValInt rv (high:low:[]) <- peekArrayT 2 (castPtr ptr) :: Trouble [Word64] return (constructor (fromIntegral ((high * (2 ^ (32 :: Word64)) + low) :: Word64))) extractIpAddress rv = do ptr <- peekVariableValInt rv octets <- peekArrayT 4 (castPtr ptr) :: Trouble [Word8] let str = B.intercalate "." (map (BC.pack . 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} oid' <- peekArrayT oidlen oidptr :: Trouble RawOID let str = oidToByteString oid' descr <- rawvar2cstring rv return (OID descr str (map fromIntegral oid')) 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 _ -> show s IpAddress s _ -> show s Counter32 c -> show c Gauge32 c -> show c OID _ os _ -> show 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 _ -> show s Boolean c -> show c IEEEDouble c -> show c IEEEFloat c -> show c Null -> "ASN_NULL" Unsupported t s -> "Unknown type " ++ show t ++ ": " ++ show s -- allocates space for the pdu request; snmp_sess_synch_response -- appears to free the request pdu buildPDU :: SnmpPDUType -- eg. snmp_msg_get -> RawOID -- 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 (showOid 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 ByteString rawvar2cstring rv = allocaArray0T max_string_len $ \buf -> do _ <- 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 B.packCString peekCStringLenT = hoistT1 B.packCStringLen 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 CUChar 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 pokeSessRetries :: Ptr SnmpSession -> CInt -> Trouble () pokeSessRetries s h = hoistT $ #{poke struct snmp_session , retries} s h pokeSessTimeout :: Ptr SnmpSession -> CLong -> Trouble () pokeSessTimeout s h = hoistT $ #{poke struct snmp_session , timeout} s h 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 pokePDUNonRepeaters :: Ptr SnmpPDU -> CLong -> Trouble () pokePDUNonRepeaters p n = hoistT $ #{poke struct snmp_pdu , non_repeaters} p n pokePDUMaxRepetitions :: Ptr SnmpPDU -> CLong -> Trouble () pokePDUMaxRepetitions p r = hoistT $ #{poke struct snmp_pdu , max_repetitions} p r -- -- 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 () -- "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. -- -- from session_api.h: Do NOT free memory returned by snmp_sess_session -- 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 safe "net-snmp/net-snmp-includes.h snmp_sess_synch_response" c_snmp_sess_synch_response :: Ptr SnmpSession -> Ptr SnmpPDU -> Ptr (Ptr SnmpPDU) -> IO CInt -- 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 <$> snmpError 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 safe "net-snmp/net-snmp-includes.h print_variable" -- c_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> IO () -- t_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> Trouble () -- t_print_variable = hoistT3 c_print_variable -- 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 = alloca $ \libp -> -- pointer to library error code alloca $ \sysp -> -- 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_sess_error" -- c_snmp_sess_error :: Ptr SnmpSession -> Ptr CInt -> Ptr CInt -- -> Ptr CString -> IO () -- 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 Applicative Trouble where pure a = Trouble $ pure (Right a) -- (<*>) :: Trouble (a -> b) -> Trouble a -> Trouble b f <*> v = Trouble $ do r <- runTrouble f v' <- runTrouble v case r of (Left s) -> return (Left s) (Right f') -> return (fmap f' v') 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 = pure m >>= f = Trouble $ do r <- runTrouble m case r of (Left s) -> return (Left s) (Right v) -> runTrouble (f v) instance MonadFail Trouble where fail = Trouble . pure . Left 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 _) -> return r handleT :: (String -> Trouble a) -> Trouble a -> Trouble a handleT = flip catchT bracketT :: Trouble a -> (a -> Trouble b) -> (a -> Trouble c) -> Trouble c bracketT before after thing = do a <- before result <- handleT (\s -> after a >> throwT s) (thing a) _ <- after a return result -- 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