Haskell `龙格过早退出

我使用Data.Binary对二进制文件进行解码，发现

runGet

函数会抛出异常“字节不足”，即使它没有消耗所有输入

具体地说，在循环中，我反复尝试解析二进制文件，直到它消耗了所有的输入

parsePCAP = do 
    gHeader <- parseGHeader 
    packets <- parsePPackets [] 
    let packets' = catMaybes packets 
    return (Pcap gHeader packets')
  where 
    parsePPackets xs = do 
    empty <- isEmpty 
    if empty 
        then return xs 
        else do p <- parseB6034 
                parsePPackets (p:xs)

---

我不确定这是否是解决问题的正确方法。如果没有，请指出正确的方法

---

基本问题是，我使用

Word32

表示包长度，其中一个pcap包短于47。从47中减去较短的数字将导致算术溢出，并导致

Get

monad跳过

Word32

可以表示的最大字节数

尝试使用Debug.Trace来了解代码在实践中的作用。一种可能性是，您在某个点上与二进制格式不同步，因此可能“plen”最终是一个非常大的数字，您的“skip”（plen-47）“然后会尝试遵守。但是如果没有更多的线索，就很难说了。@PaulJohnson谢谢你的建议！发生错误的原因是其中一个包的长度为46，小于47，这将导致算术溢出。

module Header (
  PGlobalHeader(..)
, Transaction(..)
, MarketData(..)
, Pcap(..)

, parsePCAP 
) where 

import Data.Int 
import Data.Word 
import Control.Monad
import Data.Maybe 
import Control.Monad.IO.Class

import qualified Data.ByteString as BS 
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as Char8
import Data.Binary.Get 
import Data.Text (Text)
import Data.Text.Encoding 

import Lib (source)

data PGlobalHeader = PGHeader { 
  magic_number  :: Word32 
, version_major :: Word16 
, version_minor :: Word16 
, timezone      :: Int32  -- GMT to local correction 
, sigfigs       :: Word32 -- accuracy of timestamps 
, snaplen       :: Word32 -- max length of captured packets 
, network       :: Word32 -- data link type 
} deriving (Show, Eq)

data Transaction = Trans { 
  qty   :: Text
, price :: Text
} deriving (Show, Eq)

data MarketData = B6034 {
  issCode :: Text -- issue code (ISIN code) 
, accTime :: Text -- accepted time 
, bids    :: [Transaction] -- from 1st to 5th
, asks    :: [Transaction]
} deriving (Show, Eq)

data Pcap = Pcap PGlobalHeader [MarketData] 
deriving Show

parseGHeader :: Get PGlobalHeader 
parseGHeader = PGHeader <$> 
           getWord32le <*> 
           getWord16le <*> 
           getWord16le <*>
           getInt32le <*>
           getWord32le <*> 
           getWord32le <*> 
           getWord32le 

parsePPacket :: (BS.ByteString -> Bool) -> -- discard the packet?
            Get a -> -- packet parser 
            Get (Maybe a) 
parsePPacket f p = do 
    skip 12
    plen <- getWord32le -- length of pcap packet 
    skip 42 -- skip the IP/UDP header 
    code <- getByteString 5 
    if f code 
        then do r <- p 
                return (Just r)
        else do skip' (plen - 47)
                return Nothing 
  where 
    skip' = skip . fromIntegral 
    getByteString' = getByteString . fromIntegral

parseB6034 :: Get (Maybe MarketData)
parseB6034 = parsePPacket (BS.isPrefixOf quote) parseB6034' 
 where 
  quote :: BS.ByteString
  quote = Char8.pack "B6034"

  parseB6034' :: Get MarketData 
  parseB6034' = do
      issCode <- mkText 12 
      skip 12 
      bids <- go 5  
      skip 7
      asks <- go 5  
      skip 50 
      accTime <- mkText 8
      skip 1 
      return (B6034 issCode accTime bids asks)
    where 
      go 0 = return [] 
      go n = do price <- mkText 5  
                qty <- mkText 7
                remains <- go (n-1)  
                return $ (Trans qty price) : remains 

mkText :: Int -> Get Text 
mkText = fmap decodeLatin1 . getByteString 

parsePCAP = do 
    gHeader <- parseGHeader 
    packets <- parsePPackets [] 
    let packets' = catMaybes packets 
    return (Pcap gHeader packets')
  where 
    parsePPackets xs = do 
    empty <- isEmpty 
    if empty 
        then return xs 
        else do p <- parseB6034 
                parsePPackets (p:xs)