diff --git a/BUGS b/BUGS --- a/BUGS +++ b/BUGS @@ -32,7 +32,9 @@ 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. +insecure SNMP community strings. The documentation for the thread-safe API +in the net-snmp C library suggests that the snmpv3 support is probably +not thread-safe. 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 @@ -50,9 +52,6 @@ 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: diff --git a/NetSNMP.cabal b/NetSNMP.cabal --- a/NetSNMP.cabal +++ b/NetSNMP.cabal @@ -1,6 +1,6 @@ Name: NetSNMP -Version: 0.1.2 +Version: 0.1.6 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 diff --git a/README b/README --- a/README +++ b/README @@ -20,8 +20,8 @@ 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. +those options, since they may encourage better security, but I won't be able +to prioritize this in the forseeable future. See also: BUGS diff --git a/src/Network/Protocol/NetSNMP.hsc b/src/Network/Protocol/NetSNMP.hsc --- a/src/Network/Protocol/NetSNMP.hsc +++ b/src/Network/Protocol/NetSNMP.hsc @@ -12,11 +12,6 @@ -- -- 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 ( @@ -32,31 +27,15 @@ 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 +import Control.Applicative +import Control.Monad +import Data.List +import Foreign +import Foreign.C.String +import Foreign.C.Types #include #include @@ -73,11 +52,8 @@ -- 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 @@ -237,6 +213,8 @@ #{enum CInt, , snmp_stat_success = STAT_SUCCESS + , snmp_stat_error = STAT_ERROR + , snmp_stat_timeout = STAT_TIMEOUT , snmp_err_noerror = SNMP_ERR_NOERROR } @@ -250,40 +228,38 @@ -- 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 +initialize = do + withCString "Haskell bindings" c_init_snmp + withCString "127.0.0.1" $ \localhost -> do + withCString "public" $ \public -> do + alloca $ \session -> runTrouble $ + (readyCommunitySession snmp_version_2c localhost public session) + >>= closeSession + return () -- |Create an abstract session, suitable for reuse, responsible -- for freeing the string components readyCommunitySession :: SnmpVersion - -> Hostname - -> Community + -> CString -- Hostname + -> CString -- Community + -> Ptr SnmpSession -- "session" -> 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 +readyCommunitySession version hostname community session = do + community_len <- t_strlen community + t_snmp_sess_init session + pokeSessPeername session hostname pokeSessVersion session (unSnmpVersion version) - pokeSessCommunity session community_cstr + pokeSessCommunity session community 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 + 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 () -closeSession session = hoistT $ do - c_snmp_sess_close (getSessp session) - finalizeForeignPtr (sessionCommunity session) - finalizeForeignPtr (sessionHostname session) - finalizeForeignPtr (getSession session) +-- 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. @@ -300,10 +276,14 @@ -> Community -- ^SNMP community (password) -> String -- ^OID to be queried -> IO (Either String SnmpResult) -snmpGet version hostname community oid = runTrouble $ bracketT - (readyCommunitySession version hostname community) -- session - closeSession - (flip (mkSnmpGet snmp_msg_get) oid) +snmpGet version hostname community oid = + withCString hostname $ \cshost -> + withCString 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. @@ -320,10 +300,14 @@ -> Community -- ^SNMP community (password) -> String -- ^OID to be queried -> IO (Either String SnmpResult) -snmpNext version hostname community oid = runTrouble $ bracketT - (readyCommunitySession version hostname community) -- session - closeSession - (flip (mkSnmpGet snmp_msg_getnext) oid) +snmpNext version hostname community oid = + withCString hostname $ \cshost -> + withCString 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 @@ -345,10 +329,14 @@ -> Community -- ^SNMP community (password) -> String -- ^OID to be queried -> IO (Either String [SnmpResult]) -snmpWalk version hostname community walkoid = runTrouble $ bracketT - (readyCommunitySession version hostname community) -- session - closeSession - (go walkoid . mkSnmpGet snmp_msg_getnext) +snmpWalk version hostname community walkoid = + withCString hostname $ \cshost -> + withCString community $ \cscomm -> + alloca $ \session -> + runTrouble $ bracketT + (readyCommunitySession version cshost cscomm session) + closeSession + (go walkoid . mkSnmpGet snmp_msg_getnext) where go :: String -> (String -> Trouble SnmpResult) -> Trouble [SnmpResult] go oid next = do @@ -370,16 +358,22 @@ 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 + 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") + rawvars <- peekPDUVariables pdu_resp + vars <- extractVar 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 String @@ -487,6 +481,8 @@ Null -> "ASN_NULL" Unsupported t s -> "Unknown type " ++ show t ++ ": " ++ s +-- allocates space for the pdu request; snmp_sess_synch_response +-- appears to free the request pdu buildPDU :: SnmpPDUType -- eg. snmp_msg_get -> String -- eg. ".1.3.6.1.2.1.1.1.0" @@ -495,7 +491,7 @@ -> Trouble (Ptr SnmpPDU) -- returns pdu and oid length buildPDU pdutype oid oids version = withCStringT oid $ \oid_cstr -> - allocaT $ \oidlen_ptr -> do + allocaT $ \oidlen_ptr -> do pdu_req <- t_snmp_pdu_create pdutype pokePDUVersion pdu_req (unSnmpVersion version) pokePDUCommand pdu_req (unSnmpPDUType pdutype) @@ -527,16 +523,6 @@ 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 @@ -611,8 +597,6 @@ 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" @@ -632,6 +616,9 @@ -- 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) @@ -680,23 +667,26 @@ t_snmp_add_null_var = hoistT3 c_snmp_add_null_var -- Send request PDU and wait for response. -foreign import ccall unsafe +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 --- 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 + -- snmpSessError was giving bus errors on x86_64 + -- if (success == snmp_stat_success) + -- then return (Right ()) + -- else Left <$> snmpSessError sptr + return $ case () of + _ | success == snmp_stat_success -> Right () + | success == snmp_stat_error -> Left "snmp_sess_synch_response error" + | success == snmp_stat_timeout -> Left "snmp_sess_synch_response timeout" + | otherwise -> Left + ("snmp_sess_synch_response unknown error code " ++ show success) -- Deallocate PDU struct foreign import ccall unsafe "net-snmp/net-snmp-includes.h snmp_free_pdu" @@ -715,7 +705,7 @@ -- 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" +foreign import ccall safe "net-snmp/net-snmp-includes.h print_variable" c_print_variable :: Ptr OIDpart -> CSize -> Ptr CVarList -> IO () t_print_variable = hoistT3 c_print_variable @@ -752,18 +742,25 @@ -- 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" +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 () +-- Using abbreviated error routine because th c_snmp_sess_error +-- call appears to be giving bus errors on my x86_64 test machine. snmpSessError :: Ptr SnmpSession -> IO String -snmpSessError p = do +snmpSessError sptr = + return ("disabled snmp_sess_error check; sptr=" ++ show sptr) + +_snmpSessError :: Ptr SnmpSession -> IO String +_snmpSessError sptr | sptr == nullPtr = return "snmp error; null sptr" +_snmpSessError sptr = 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 + c_snmp_sess_error sptr libp sysp errp + liberr <- peek libp :: IO CInt + syserr <- peek sysp :: IO CInt cserr <- peek errp err <- peekCString cserr free cserr @@ -821,13 +818,20 @@ 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 +-- handleT (\s -> after a >> throwT s) $ do +-- result <- thing a +-- after a +-- return result + bracketT :: Trouble a -> (a -> Trouble b) -> (a -> Trouble c) -> Trouble c bracketT before after thing = do a <- before - handleT (\s -> after a >> throwT s) $ do - result <- thing a - after a - return result + 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.