module Profiling.Linux.Perf.Parse
( readHeader
, readAttributes
, readAttributeIDs
, readEventHeader
, readEvent
, readEventTypes
) where
import Profiling.Linux.Perf.Types as Types
( FileSection (..), FileHeader (..), EventAttr (..), FileAttr (..), TraceEventType (..)
, EventHeader (..), EventPayload (..), SampleFormat (..), EventType (..), Event (..)
, EventAttrFlag (..), TID (..), PID (..), EventTypeID (..), testEventAttrFlag
, EventSource (..), EventID (..), TimeStamp (..), SampleTypeBitMap (..)
, ByteCount64 (..), ByteCount32 (..), ByteCount16 (..) )
import Data.Word ( Word64, Word8, Word16, Word32 )
import Data.Binary ( Binary (..), getWord8 )
import Control.Monad.Error ( ErrorT (..), lift, replicateM, when, throwError )
import System.IO ( hSeek, Handle, SeekMode (..) )
import Data.ByteString.Lazy as B ( ByteString, hGet )
import Data.Binary.Get
( Get, runGet, getLazyByteString, getLazyByteStringNul, getWord16le,
getWord32le, getWord64le, remaining, getRemainingLazyByteString )
import Data.Bits (testBit)
import Foreign.Storable (sizeOf)
import Data.Int (Int64)
bytesInWord64 :: Int
bytesInWord64 = sizeOf (undefined :: Word64)
type GetEvents a = ErrorT String Get a
getE :: Binary a => GetEvents a
getE = lift get
getBSNul :: GetEvents B.ByteString
getBSNul = lift getLazyByteStringNul
getBS :: Int64 -> GetEvents B.ByteString
getBS = lift . getLazyByteString
getU8 :: GetEvents Word8
getU8 = lift getWord8
getU16 :: GetEvents Word16
getU16 = lift getWord16le
getU32 :: GetEvents Word32
getU32 = lift getWord32le
getU64 :: GetEvents Word64
getU64 = lift getWord64le
getPID :: GetEvents PID
getPID = PID `fmap` getU32
getTID :: GetEvents TID
getTID = TID `fmap` getU32
getEventID :: GetEvents EventID
getEventID = EventID `fmap` getU64
getTimeStamp :: GetEvents TimeStamp
getTimeStamp = TimeStamp `fmap` getU64
getByteCount64 :: GetEvents ByteCount64
getByteCount64 = ByteCount64 `fmap` getU64
getByteCount32 :: GetEvents ByteCount32
getByteCount32 = ByteCount32 `fmap` getU32
getByteCount16 :: GetEvents ByteCount16
getByteCount16 = ByteCount16 `fmap` getU16
runGetEvents :: GetEvents a -> B.ByteString -> Either String a
runGetEvents = runGet . runErrorT
runGetEventsCheck :: GetEvents a -> B.ByteString -> IO a
runGetEventsCheck g b =
case runGetEvents g b of
Left e -> fail e
Right v -> return v
pERF_MAGIC = 0x454c494646524550 :: Word64
hEADER_FEAT_BITS = (256) :: Int
parseFileSection :: GetEvents FileSection
parseFileSection = do
sec_offset <- getByteCount64
sec_size <- getByteCount64
return FileSection{..}
parseFileHeader :: GetEvents FileHeader
parseFileHeader = do
magic <- getU64
when (magic /= pERF_MAGIC) $
throwError "incompatible file format, or not a perf file"
fh_size <- getByteCount64
fh_attr_size <- getByteCount64
FileSection fh_attrs_offset fh_attrs_size <- parseFileSection
FileSection fh_data_offset fh_data_size <- parseFileSection
FileSection fh_event_offset fh_event_size <- parseFileSection
fh_adds_features <- replicateM (hEADER_FEAT_BITS `quot` 32) $ getU32
return FileHeader{..}
readPerfType :: Word32 -> EventSource
readPerfType x
| x < fromIntegral (fromEnum PerfTypeUnknown) = toEnum $ fromIntegral x
| otherwise = PerfTypeUnknown
parseEventSource :: GetEvents EventSource
parseEventSource = readPerfType `fmap` getU32
parseEventAttr :: GetEvents EventAttr
parseEventAttr = do
ea_type <- parseEventSource
ea_size <- getByteCount32
ea_config <- EventTypeID `fmap` getU64
ea_sample_period_or_freq <- getU64
ea_sample_type <- SampleTypeBitMap `fmap` getU64
ea_read_format <- getU64
ea_flags <- getU64
ea_wakeup_events_or_watermark <- getU32
ea_bp_type <- getU32
ea_bp_addr_or_config1 <- getU64
ea_bp_len_or_config2 <- getU64
return EventAttr{..}
parseEventAttrFlags :: Word64 -> [EventAttrFlag]
parseEventAttrFlags word =
foldr testFlag [] ([toEnum 0 ..]::[EventAttrFlag])
where
testFlag :: EventAttrFlag -> [EventAttrFlag] -> [EventAttrFlag]
testFlag flag rest
| testBit word (fromEnum flag) = flag : rest
| otherwise = rest
parseFileAttr :: GetEvents FileAttr
parseFileAttr = do
fa_attr <- parseEventAttr
FileSection fa_ids_offset fa_ids_size <- parseFileSection
return FileAttr{..}
parseTraceEventType :: GetEvents TraceEventType
parseTraceEventType = do
te_event_id <- EventTypeID `fmap` getU64
te_name <- getBSNul
return TraceEventType{..}
parseEventHeader :: GetEvents EventHeader
parseEventHeader = do
eh_type <- (toEnum . fromIntegral) `fmap` getU32
eh_misc <- getU16
eh_size <- getByteCount16
return EventHeader{..}
parseMmapEvent :: GetEvents EventPayload
parseMmapEvent = do
eventPayload_pid <- getPID
eventPayload_tid <- getTID
eventPayload_MmapStart <- getU64
eventPayload_MmapLen <- getU64
eventPayload_MmapPgoff <- getU64
eventPayload_MmapFilename <- getBSNul
return MmapEvent{..}
parseCommEvent :: GetEvents EventPayload
parseCommEvent = do
eventPayload_pid <- getPID
eventPayload_tid <- getTID
eventPayload_CommName <- getBSNul
return CommEvent{..}
parseForkEvent :: GetEvents EventPayload
parseForkEvent = do
eventPayload_pid <- getPID
eventPayload_ppid <- getPID
eventPayload_tid <- getTID
eventPayload_ptid <- getTID
eventPayload_time <- getTimeStamp
return ForkEvent{..}
parseExitEvent :: GetEvents EventPayload
parseExitEvent = do
eventPayload_pid <- getPID
eventPayload_ppid <- getPID
eventPayload_tid <- getTID
eventPayload_ptid <- getTID
eventPayload_time <- getTimeStamp
return ExitEvent{..}
parseLostEvent :: GetEvents EventPayload
parseLostEvent = do
eventPayload_id <- getEventID
eventPayload_Lost <- getU64
return LostEvent{..}
parseThrottleEvent :: GetEvents EventPayload
parseThrottleEvent = do
eventPayload_time <- getTimeStamp
eventPayload_id <- getEventID
eventPayload_stream_id <- getU64
return ThrottleEvent{..}
parseUnThrottleEvent :: GetEvents EventPayload
parseUnThrottleEvent = do
eventPayload_time <- getTimeStamp
eventPayload_id <- getEventID
eventPayload_stream_id <- getU64
return UnThrottleEvent{..}
parseReadEvent :: GetEvents EventPayload
parseReadEvent = do
eventPayload_pid <- getPID
eventPayload_tid <- getTID
eventPayload_ReadValue <- getU64
eventPayload_ReadTimeEnabled <- getU64
eventPayload_ReadTimeRunning <- getU64
eventPayload_id <- getEventID
return ReadEvent{..}
parseSampleType :: SampleTypeBitMap -> SampleFormat -> GetEvents a -> GetEvents (Maybe a)
parseSampleType sampleType format parser
| testBit (sampleTypeBitMap sampleType) (fromEnum format) = Just `fmap` parser
| otherwise = return Nothing
parseSampleEvent :: SampleTypeBitMap -> GetEvents EventPayload
parseSampleEvent sampleType = do
eventPayload_SampleIP <- parseSampleType sampleType PERF_SAMPLE_IP getU64
eventPayload_SamplePID <- parseSampleType sampleType PERF_SAMPLE_TID getPID
eventPayload_SampleTID <- parseSampleType sampleType PERF_SAMPLE_TID getTID
eventPayload_SampleTime <- parseSampleType sampleType PERF_SAMPLE_TIME getTimeStamp
eventPayload_SampleAddr <- parseSampleType sampleType PERF_SAMPLE_ADDR getU64
eventPayload_SampleID <- parseSampleType sampleType PERF_SAMPLE_ID getEventID
eventPayload_SampleStreamID <- parseSampleType sampleType PERF_SAMPLE_STREAM_ID getU64
eventPayload_SampleCPU <- parseSampleType sampleType PERF_SAMPLE_CPU getU32
eventPayload_SamplePeriod <- parseSampleType sampleType PERF_SAMPLE_PERIOD getU64
return SampleEvent{..}
parseEventPayload :: SampleTypeBitMap -> EventType -> GetEvents EventPayload
parseEventPayload sampleType eventType =
case eventType of
PERF_RECORD_MMAP -> parseMmapEvent
PERF_RECORD_LOST -> parseLostEvent
PERF_RECORD_COMM -> parseCommEvent
PERF_RECORD_EXIT -> parseExitEvent
PERF_RECORD_THROTTLE -> parseThrottleEvent
PERF_RECORD_UNTHROTTLE -> parseUnThrottleEvent
PERF_RECORD_FORK -> parseForkEvent
PERF_RECORD_READ -> parseReadEvent
PERF_RECORD_SAMPLE -> parseSampleEvent sampleType
PERF_RECORD_UNKNOWN _ -> return UnknownEvent
parseEvent :: SampleTypeBitMap -> GetEvents Event
parseEvent sampleType = do
ev_header <- parseEventHeader
let eventType = eh_type ev_header
ev_payload <- parseEventPayload sampleType eventType
return Event{..}
readEventHeader :: Handle
-> ByteCount64
-> IO EventHeader
readEventHeader h offset = do
hSeek h AbsoluteSeek $ fromIntegral offset
b <- B.hGet h ((8))
runGetEventsCheck parseEventHeader b
readEvent :: Handle
-> ByteCount64
-> SampleTypeBitMap
-> IO Event
readEvent h offset sampleType = do
hSeek h AbsoluteSeek $ fromIntegral offset
let headerSize = (8)
headerBytes <- B.hGet h headerSize
ev_header <- runGetEventsCheck parseEventHeader headerBytes
let payloadSize = (fromIntegral $ eh_size ev_header) headerSize
payloadBytes <- B.hGet h payloadSize
ev_payload <- runGetEventsCheck (parseEventPayload sampleType $ eh_type ev_header) payloadBytes
return Event{..}
readHeader :: Handle
-> IO FileHeader
readHeader h = do
b <- B.hGet h ((104))
runGetEventsCheck parseFileHeader b
readAttributes :: Handle
-> FileHeader
-> IO [FileAttr]
readAttributes h fh = do
let nr_attrs = fh_attrs_size fh `quot` ((88))
hSeek h AbsoluteSeek (fromIntegral (fh_attrs_offset fh))
b <- B.hGet h (fromIntegral (fh_attrs_size fh))
runGetEventsCheck (replicateM (fromIntegral nr_attrs) parseFileAttr) b
readAttributeIDs :: Handle
-> FileAttr
-> IO [EventID]
readAttributeIDs h attr = do
let offset = fromIntegral $ fa_ids_offset attr
size = fromIntegral $ fa_ids_size attr
hSeek h AbsoluteSeek offset
b <- B.hGet h size
ws <- runGetEventsCheck (replicateM (size `div` bytesInWord64) getU64) b
return $ map EventID ws
readEventTypes :: Handle
-> FileHeader
-> IO [TraceEventType]
readEventTypes h fh = do
hSeek h AbsoluteSeek (fromIntegral (fh_event_offset fh))
loop nr_types []
where
loop 0 acc = return $ reverse acc
loop n acc = do
b <- B.hGet h sizeOfTypeRecord
nextRecord <- runGetEventsCheck parseTraceEventType b
loop (n1) (nextRecord:acc)
sizeOfTypeRecord :: Int
sizeOfTypeRecord = fromIntegral ((72))
nr_types = (fromIntegral $ fh_event_size fh) `quot` sizeOfTypeRecord