module Network.Protocol.Snmp.AgentX.Packet.Get
( getPacket
, bodySizeFromHeader
)
where
import Network.Protocol.Snmp.AgentX.Packet.Types ( bigEndian
, nonDefaultContext
, unTag
, Flags
, mkFlags
, PDU(..)
, VarBind
, mkVarBind
, SearchRange
, mkSearchRange
, Context(..)
, Packet
, mkPacket
, econvert
)
import Network.Protocol.Snmp (Value(..), OID)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Binary hiding (get)
import Data.Binary.Get
import Data.Bits.Bitwise (toListLE)
import Data.Monoid ((<>))
import Control.Applicative hiding (empty)
import Data.Int
import Data.Label
getPacket :: Get Packet
getPacket = do
version <- econvert `fmap` getWord8
pduTag <- getWord8
flags <- decodeFlags <$> getWord8
_reserved <- getWord8
sid <- econvert `fmap` get32 flags
tid <- econvert `fmap` get32 flags
pid <- econvert `fmap` get32 flags
bodySize <- get32 flags
pdu <- parsePdu pduTag flags bodySize
return $ mkPacket version pdu flags sid tid pid
decodeFlags :: Word8 -> Flags
decodeFlags x =
let (i:n:a:nd:nb:_) = toListLE x
in mkFlags i n a nd nb
get16 :: Flags -> Get Word16
get16 f = case get bigEndian f of
True -> getWord16be
False -> getWord16le
get32 :: Flags -> Get Word32
get32 f = case get bigEndian f of
True -> getWord32be
False -> getWord32le
get64 :: Flags -> Get Word64
get64 f = case get bigEndian f of
True -> getWord64be
False -> getWord64le
type Size = Word32
type Include = Bool
getBool :: Get Bool
getBool = do
x <- getWord8
case x of
1 -> return True
0 -> return False
_ -> error "bad getBool"
getOid :: Flags -> Get (OID, Include)
getOid flags = do
nSubId <- getWord8
prefix <- getWord8
include <- getBool
_reserved <- getWord8
end <- sequence $ replicate (fromIntegral nSubId) (get32 flags)
case (nSubId, prefix) of
(0, 0) -> return ([], include)
(_, 0) -> return (map fromIntegral end, include)
(_, x) -> return ([1,3,6,1] <> map fromIntegral (fromIntegral x:end), include)
getString :: Flags -> Get ByteString
getString bo = do
l <- fromIntegral <$> get32 bo
let fullLength = l + (4 l `rem` 4) `rem` 4
s <- getByteString fullLength
return $ B.take l s
getContext :: Flags -> Get (Maybe Context)
getContext f = case (get nonDefaultContext f) of
False -> return Nothing
True -> Just <$> Context <$> getString f
getOidList :: Flags -> [OID] -> Get [OID]
getOidList bo xs = do
(oi, _) <- getOid bo
isEnd <- isEmpty
if isEnd
then return $ reverse (addOi oi xs)
else getOidList bo (addOi oi xs)
where
addOi [] xss = xss
addOi oi xss = oi:xss
getSearchRange :: Flags -> Get SearchRange
getSearchRange bo = do
(first, include) <- getOid bo
(second, _) <- getOid bo
return $ mkSearchRange first second include
getSearchRangeList :: Flags -> [SearchRange] -> Get [SearchRange]
getSearchRangeList bo xs = do
sr <- getSearchRange bo
isEnd <- isEmpty
if isEnd
then return $ reverse (sr:xs)
else getSearchRangeList bo (sr:xs)
getValue :: Flags -> Word16 -> Get Value
getValue _ 0 = return ZeroDotZero
getValue bo 2 = Integer . fromIntegral <$> get32 bo
getValue bo 4 = String <$> getString bo
getValue _ 5 = return Zero
getValue bo 6 = OI . fst <$> getOid bo
getValue _ 64 = do
a <- getWord8
b <- getWord8
c <- getWord8
d <- getWord8
return $ IpAddress a b c d
getValue bo 65 = Counter32 <$> get32 bo
getValue bo 66 = Gauge32 <$> get32 bo
getValue bo 67 = TimeTicks <$> get32 bo
getValue bo 68 = Opaque <$> getString bo
getValue bo 70 = Counter64 <$> get64 bo
getValue _ 128 = return NoSuchObject
getValue _ 129 = return NoSuchInstance
getValue _ 130 = return EndOfMibView
getValue _ v = error $ "getValue bad tag " ++ show v
getVarBind :: Flags -> Get VarBind
getVarBind bo = do
valueTag <- get16 bo
_reserved <- getWord16be
(oi, _) <- getOid bo
v <- getValue bo valueTag
return $ mkVarBind oi v
getVarBindList :: Flags -> [VarBind] -> Get [VarBind]
getVarBindList bo xs = do
vb <- getVarBind bo
isEnd <- isEmpty
if isEnd
then return $ reverse (vb:xs)
else getVarBindList bo (vb:xs)
parsePdu :: Word8 -> Flags -> Size -> Get PDU
parsePdu t f s
| t == 1 = do
time <- getWord8
_reserved <- getWord8
_reserved <- getWord8
_reserved <- getWord8
(o, _) <- getOid f
d <- getString f
return $ Open time o d
| t == 2 = do
reason <- unTag <$> getWord8
_reserved <- getWord8
_reserved <- getWord8
_reserved <- getWord8
return $ Close reason
| t == 3 = do
context <- getContext f
timeout <- getWord8
priority <- getWord8
rsid <- getWord8
_reserved <- getWord8
(oid, _) <- getOid f
case rsid of
0x00 -> return $ Register context timeout priority rsid oid Nothing
_ -> Register context timeout priority rsid oid . Just <$> get32 f
| t == 4 = do
context <- getContext f
priority <- getWord8
rsid <- getWord8
_reserved <- getWord8
(oid, _) <- getOid f
case rsid of
0x00 -> return $ Unregister context priority rsid oid Nothing
_ -> Unregister context priority rsid oid . Just <$> get32 f
| t == 5 = do
context <- getContext f
oil <- getOidList f []
return $ Get context oil
| t == 6 = do
context <- getContext f
srl <- getSearchRangeList f []
return $ GetNext context srl
| t == 7 = do
context <- getContext f
nonRepeaters <- get16 f
maxRepeaters <- get16 f
srl <- getSearchRangeList f []
return $ GetBulk context nonRepeaters maxRepeaters srl
| t == 8 = do
context <- getContext f
vbl <- getVarBindList f []
return $ TestSet context vbl
| t == 9 = return $ CommitSet
| t == 10 = return $ UndoSet
| t == 11 = return $ CleanupSet
| t == 12 = do
context <- getContext f
vbl <- getVarBindList f []
return $ Notify context vbl
| t == 13 = do
context <- getContext f
return $ Ping context
| t == 14 = do
context <- getContext f
vbl <- getVarBindList f []
return $ IndexAllocate context vbl
| t == 15 = do
context <- getContext f
vbl <- getVarBindList f []
return $ IndexDeallocate context vbl
| t == 16 = do
context <- getContext f
(oi, _) <- getOid f
description <- getString f
return $ AddAgentCaps context oi description
| t == 17 = do
context <- getContext f
(oi, _) <- getOid f
return $ RemoveAgentCaps context oi
| t == 18 = do
sysuptime <- get32 f
rerror <- unTag <$> get16 f
index <- get16 f
if (s == 8)
then return $ Response sysuptime rerror index []
else Response sysuptime rerror index <$> (getVarBindList f [])
| otherwise = error "parse pdu unknown tag"
bodySizeFromHeader :: BL.ByteString -> Int64
bodySizeFromHeader "" = 0
bodySizeFromHeader bs =
let flags = decodeFlags (BL.index bs 2)
s = BL.drop 16 bs
in fromIntegral $ runGet (get32 flags) s