summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWill Thompson <will@willthompson.co.uk>2020-07-30 14:36:03 +0100
committerWill Thompson <will@willthompson.co.uk>2020-07-30 14:36:03 +0100
commit5a6e13aa7bd0ced279f5935d080f68a160a47354 (patch)
tree527abd759c8568331d42a0015dc9d1f4bcd22c6a
parente506b5ca71e14af3d2ebd0a63c1b8d3ea0fb1795 (diff)
parent2011ade5e6711758ae3213c43c3715f6c884b6e8 (diff)
Merge branch 'reduce-dependencies'
-rw-r--r--Bustle/GDBusMessage.hs298
-rw-r--r--Bustle/GVariant.hs126
-rw-r--r--Bustle/Loader/Pcap.hs217
-rw-r--r--Bustle/Monitor.hs12
-rw-r--r--Bustle/Reader.hs119
-rw-r--r--Bustle/Types.hs12
-rw-r--r--Bustle/UI.hs6
-rw-r--r--Bustle/UI/DetailsView.hs43
-rw-r--r--Bustle/VariantFormatter.hs150
-rw-r--r--Makefile10
-rw-r--r--Test/Renderer.hs46
-rw-r--r--Test/data/log-with-h.bustlebin39595 -> 39595 bytes
-rw-r--r--bustle.cabal37
-rw-r--r--c-sources/bustle-pcap.c18
-rw-r--r--c-sources/pcap-monitor.c147
-rw-r--r--c-sources/pcap-reader.c307
-rw-r--r--c-sources/pcap-reader.h43
-rw-r--r--flatpak/org.freedesktop.Bustle.yaml45
18 files changed, 1164 insertions, 472 deletions
diff --git a/Bustle/GDBusMessage.hs b/Bustle/GDBusMessage.hs
new file mode 100644
index 0000000..5aa68c0
--- /dev/null
+++ b/Bustle/GDBusMessage.hs
@@ -0,0 +1,298 @@
+{-
+Bustle.GDBusMessage: bindings for GDBusMessage
+Copyright © 2020 Will Thompson
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Bustle.GDBusMessage
+ (
+-- * Types
+ GDBusMessage
+ , MessageType(..)
+ , Serial
+
+ , BusName
+ , formatBusName
+ , busName_
+
+ , ObjectPath
+ , formatObjectPath
+ , objectPath_
+
+ , InterfaceName
+ , formatInterfaceName
+ , interfaceName_
+
+ , MemberName
+ , formatMemberName
+ , memberName_
+
+-- * Constructors
+ , makeNewGDBusMessage
+ , wrapNewGDBusMessage
+ , messageNewSignal
+
+-- * Methods
+ , messageType
+ , messageSerial
+ , messageReplySerial
+ , messageSender
+ , messageDestination
+ , messageErrorName
+ , messagePath
+ , messageInterface
+ , messageMember
+
+ , messagePrintBody
+ , messageGetBodyString
+ )
+where
+
+import Data.Word
+import Data.String
+
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.C
+import Foreign.Marshal.Alloc
+
+import System.Glib.GObject
+import System.Glib.UTFString
+
+import Control.Monad.Trans (liftIO)
+import Control.Monad.Trans.Maybe
+
+import Bustle.GVariant
+
+data MessageType = MessageTypeInvalid
+ | MessageTypeMethodCall
+ | MessageTypeMethodReturn
+ | MessageTypeError
+ | MessageTypeSignal
+ deriving
+ (Show, Ord, Eq, Enum)
+
+-- 0 is unused in the wire protocol so indicates "no serial"
+type Serial = Word32
+
+newtype BusName = BusName String
+ deriving (Eq, Ord, Show)
+
+instance IsString BusName where
+ fromString = busName_
+
+newtype ObjectPath = ObjectPath String
+ deriving (Eq, Ord, Show)
+
+instance IsString ObjectPath where
+ fromString = objectPath_
+
+newtype InterfaceName = InterfaceName String
+ deriving (Eq, Ord, Show)
+
+newtype MemberName = MemberName String
+ deriving (Eq, Ord, Show)
+
+instance IsString MemberName where
+ fromString = memberName_
+
+-- TODO: validate
+busName_ :: String
+ -> BusName
+busName_ = BusName
+
+formatBusName :: BusName
+ -> String
+formatBusName (BusName n) = n
+
+objectPath_ :: String
+ -> ObjectPath
+objectPath_ = ObjectPath
+
+formatObjectPath :: ObjectPath
+ -> String
+formatObjectPath (ObjectPath n) = n
+
+interfaceName_ :: String
+ -> InterfaceName
+interfaceName_ = InterfaceName
+
+formatInterfaceName :: InterfaceName
+ -> String
+formatInterfaceName (InterfaceName n) = n
+
+memberName_ :: String
+ -> MemberName
+memberName_ = MemberName
+
+formatMemberName :: MemberName
+ -> String
+formatMemberName (MemberName n) = n
+
+newtype GDBusMessage = GDBusMessage { unGDBusMessage :: ForeignPtr GDBusMessage }
+ deriving (Eq, Ord, Show)
+
+mkGDBusMessage :: (ForeignPtr GDBusMessage -> GDBusMessage, FinalizerPtr a)
+mkGDBusMessage = (GDBusMessage, objectUnref)
+
+instance GObjectClass GDBusMessage where
+ toGObject = GObject . castForeignPtr . unGDBusMessage
+ unsafeCastGObject = GDBusMessage . castForeignPtr . unGObject
+
+
+makeNewGDBusMessage :: IO (Ptr GDBusMessage)
+ -> IO GDBusMessage
+makeNewGDBusMessage = makeNewGObject mkGDBusMessage
+
+wrapNewGDBusMessage :: IO (Ptr GDBusMessage)
+ -> IO GDBusMessage
+wrapNewGDBusMessage = wrapNewGObject mkGDBusMessage
+
+-- Foreign imports
+foreign import ccall unsafe "g_dbus_message_new_signal"
+ g_dbus_message_new_signal :: CString
+ -> CString
+ -> CString
+ -> IO (Ptr GDBusMessage)
+
+foreign import ccall unsafe "g_dbus_message_get_message_type"
+ g_dbus_message_get_message_type :: Ptr GDBusMessage
+ -> IO Int
+
+foreign import ccall unsafe "g_dbus_message_get_serial"
+ g_dbus_message_get_serial :: Ptr GDBusMessage
+ -> IO Word32
+
+foreign import ccall unsafe "g_dbus_message_get_reply_serial"
+ g_dbus_message_get_reply_serial :: Ptr GDBusMessage
+ -> IO Word32
+
+foreign import ccall unsafe "g_dbus_message_get_sender"
+ g_dbus_message_get_sender :: Ptr GDBusMessage
+ -> IO CString
+
+foreign import ccall unsafe "g_dbus_message_get_destination"
+ g_dbus_message_get_destination :: Ptr GDBusMessage
+ -> IO CString
+
+foreign import ccall unsafe "g_dbus_message_get_error_name"
+ g_dbus_message_get_error_name :: Ptr GDBusMessage
+ -> IO CString
+
+foreign import ccall unsafe "g_dbus_message_get_path"
+ g_dbus_message_get_path :: Ptr GDBusMessage
+ -> IO CString
+
+foreign import ccall unsafe "g_dbus_message_get_interface"
+ g_dbus_message_get_interface :: Ptr GDBusMessage
+ -> IO CString
+
+foreign import ccall unsafe "g_dbus_message_get_member"
+ g_dbus_message_get_member :: Ptr GDBusMessage
+ -> IO CString
+
+foreign import ccall unsafe "g_dbus_message_get_body"
+ g_dbus_message_get_body :: Ptr GDBusMessage
+ -> IO (Ptr GVariant)
+
+-- Bindings
+
+messageNewSignal :: ObjectPath
+ -> InterfaceName
+ -> MemberName
+ -> IO GDBusMessage
+messageNewSignal (ObjectPath o) (InterfaceName i) (MemberName m) =
+ withCString o $ \o_ptr ->
+ withCString i $ \i_ptr ->
+ withCString m $ \m_ptr ->
+ wrapNewGDBusMessage $ g_dbus_message_new_signal o_ptr i_ptr m_ptr
+
+messageType :: GDBusMessage
+ -> IO MessageType
+messageType message =
+ withForeignPtr (unGDBusMessage message) $ \c_message ->
+ toEnum <$> g_dbus_message_get_message_type c_message
+
+messageSerial :: GDBusMessage
+ -> IO Serial
+messageSerial message =
+ withForeignPtr (unGDBusMessage message) $ \c_message ->
+ g_dbus_message_get_serial c_message
+
+messageReplySerial :: GDBusMessage
+ -> IO Serial
+messageReplySerial message =
+ withForeignPtr (unGDBusMessage message) $ \c_message ->
+ g_dbus_message_get_reply_serial c_message
+
+messageStr :: (String -> a)
+ -> (Ptr GDBusMessage -> IO CString)
+ -> GDBusMessage
+ -> IO (Maybe a)
+messageStr ctor f message =
+ withForeignPtr (unGDBusMessage message) $ \c_message -> do
+ c_str <- f c_message
+ if c_str == nullPtr
+ then return Nothing
+ else Just . ctor <$> peekUTFString c_str
+
+messageSender :: GDBusMessage
+ -> IO (Maybe BusName)
+messageSender = messageStr BusName g_dbus_message_get_sender
+
+messageDestination :: GDBusMessage
+ -> IO (Maybe BusName)
+messageDestination = messageStr BusName g_dbus_message_get_destination
+
+messageErrorName :: GDBusMessage
+ -> IO (Maybe String)
+messageErrorName = messageStr id g_dbus_message_get_error_name
+
+messagePath :: GDBusMessage
+ -> IO (Maybe ObjectPath)
+messagePath = messageStr ObjectPath g_dbus_message_get_path
+
+messageInterface :: GDBusMessage
+ -> IO (Maybe InterfaceName)
+messageInterface = messageStr InterfaceName g_dbus_message_get_interface
+
+messageMember :: GDBusMessage
+ -> IO (Maybe MemberName)
+messageMember = messageStr MemberName g_dbus_message_get_member
+
+messageGetBody :: GDBusMessage
+ -> IO (Maybe GVariant)
+messageGetBody message = do
+ body <- liftIO $ withForeignPtr (unGDBusMessage message) g_dbus_message_get_body
+ if body == nullPtr
+ then return Nothing
+ else Just <$> makeNewGVariant (return body)
+
+messagePrintBody :: GDBusMessage
+ -> IO String
+messagePrintBody message = do
+ body <- messageGetBody message
+ case body of
+ Nothing -> return ""
+ Just b -> variantPrint b WithAnnotations
+
+messageGetBodyString :: GDBusMessage
+ -> Word
+ -> IO (Maybe String)
+messageGetBodyString message i = runMaybeT $ do
+ body <- MaybeT $ messageGetBody message
+ child <- MaybeT $ variantGetChild body i
+ MaybeT $ variantGetString child
diff --git a/Bustle/GVariant.hs b/Bustle/GVariant.hs
new file mode 100644
index 0000000..1e89769
--- /dev/null
+++ b/Bustle/GVariant.hs
@@ -0,0 +1,126 @@
+{-
+Bustle.GVariant: bindings for GVariant
+Copyright © 2020 Will Thompson
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Bustle.GVariant
+ (
+-- * Types
+ GVariant
+ , TypeAnnotate(..)
+
+-- * Constructors
+ , makeNewGVariant
+ , wrapNewGVariant
+
+-- * Methods
+ , variantGetChild
+ , variantGetString
+ , variantPrint
+
+ )
+where
+
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.C
+
+import System.Glib.UTFString
+
+import Control.Monad (guard)
+import Control.Monad.Trans (liftIO)
+import Control.Monad.Trans.Maybe
+
+data TypeAnnotate = NoAnnotations
+ | WithAnnotations
+ deriving
+ (Show, Ord, Eq, Enum)
+
+newtype GVariant = GVariant { unGVariant :: ForeignPtr GVariant }
+ deriving (Eq, Ord, Show)
+
+makeNewGVariant :: IO (Ptr GVariant)
+ -> IO GVariant
+makeNewGVariant act = wrapNewGVariant (act >>= g_variant_ref)
+
+wrapNewGVariant :: IO (Ptr GVariant)
+ -> IO GVariant
+wrapNewGVariant act = do
+ vPtr <- act
+ v <- newForeignPtr g_variant_unref vPtr
+ return $ GVariant v
+
+-- Foreign imports
+foreign import ccall unsafe "g_variant_is_of_type"
+ g_variant_is_of_type :: Ptr a
+ -> CString
+ -> IO CInt
+
+foreign import ccall unsafe "g_variant_n_children"
+ g_variant_n_children :: Ptr a
+ -> IO CSize
+
+foreign import ccall unsafe "g_variant_get_child_value"
+ g_variant_get_child_value :: Ptr a
+ -> CSize
+ -> IO (Ptr a)
+
+foreign import ccall unsafe "g_variant_get_string"
+ g_variant_get_string :: Ptr a
+ -> Ptr CSize
+ -> IO CString
+
+foreign import ccall unsafe "g_variant_print"
+ g_variant_print :: Ptr a
+ -> CInt
+ -> IO CString
+
+foreign import ccall unsafe "g_variant_ref"
+ g_variant_ref :: Ptr GVariant
+ -> IO (Ptr GVariant)
+
+foreign import ccall unsafe "&g_variant_unref"
+ g_variant_unref :: FunPtr (Ptr GVariant -> IO ())
+
+-- Bindings
+variantNChildren :: GVariant
+ -> IO Word
+variantNChildren v = withForeignPtr (unGVariant v) $ \vPtr -> do
+ fromIntegral <$> g_variant_n_children vPtr
+
+variantGetChild :: GVariant
+ -> Word
+ -> IO (Maybe GVariant)
+variantGetChild v i = withForeignPtr (unGVariant v) $ \vPtr -> runMaybeT $ do
+ n <- liftIO $ variantNChildren v
+ guard (i < n)
+ liftIO $ wrapNewGVariant $ g_variant_get_child_value vPtr (fromIntegral i)
+
+variantGetString :: GVariant
+ -> IO (Maybe String)
+variantGetString v = withForeignPtr (unGVariant v) $ \vPtr -> runMaybeT $ do
+ r <- liftIO $ withCString "s" $ g_variant_is_of_type vPtr
+ guard (r /= 0)
+ s <- liftIO $ g_variant_get_string vPtr nullPtr
+ liftIO $ peekUTFString s
+
+variantPrint :: GVariant
+ -> TypeAnnotate
+ -> IO String
+variantPrint v annotate = withForeignPtr (unGVariant v) $ \vPtr -> do
+ cstr <- g_variant_print vPtr (fromIntegral $ fromEnum annotate)
+ readUTFString cstr
diff --git a/Bustle/Loader/Pcap.hs b/Bustle/Loader/Pcap.hs
index 88eacb3..e82ea82 100644
--- a/Bustle/Loader/Pcap.hs
+++ b/Bustle/Loader/Pcap.hs
@@ -32,17 +32,13 @@ import qualified Data.Map as Map
import Data.Map (Map)
import Control.Exception (try)
import Control.Monad.State
-import System.IO.Error ( mkIOError
- , userErrorType
- )
+import Control.Monad.Trans.Maybe
-import Network.Pcap
-
-import DBus
-
-import qualified Data.ByteString as BS
+import System.Glib (GError)
import qualified Bustle.Types as B
+import Bustle.GDBusMessage
+import Bustle.Reader
-- Conversions from dbus-core's types into Bustle's more stupid types. This
-- whole section is pretty upsetting.
@@ -63,23 +59,23 @@ convertBusName fallback n =
where
fallback_ = busName_ fallback
-convertMember :: (a -> ObjectPath)
- -> (a -> Maybe InterfaceName)
- -> (a -> MemberName)
- -> a
- -> B.Member
-convertMember getObjectPath getInterfaceName getMemberName m =
- B.Member (getObjectPath m)
- (getInterfaceName m)
- (getMemberName m)
+convertMember :: MonadIO m
+ => GDBusMessage
+ -> m B.Member
+convertMember m = liftIO $ do
+ p <- fromMaybe (objectPath_ "") <$> messagePath m
+ i <- messageInterface m
+ member <- fromMaybe (memberName_ "") <$> messageMember m
+ return $ B.Member p i member
+
type PendingMessages = Map (Maybe BusName, Serial)
- (MethodCall, B.Detailed B.Message)
+ (B.Detailed B.Message)
popMatchingCall :: (MonadState PendingMessages m)
=> Maybe BusName
-> Serial
- -> m (Maybe (MethodCall, B.Detailed B.Message))
+ -> m (Maybe (B.Detailed B.Message))
popMatchingCall name serial = do
ret <- tryPop (name, serial)
case (ret, name) of
@@ -98,27 +94,30 @@ popMatchingCall name serial = do
insertPending :: MonadState PendingMessages m
=> Maybe BusName
-> Serial
- -> MethodCall
-> B.Detailed B.Message
-> m ()
-insertPending n s rawCall b = modify $ Map.insert (n, s) (rawCall, b)
-
-isNOC :: Maybe BusName -> Signal -> Maybe (BusName, Maybe BusName, Maybe BusName)
-isNOC (Just sender) s | looksLikeNOC =
- case names of
- [Just n, old, new] -> Just (n, old, new)
- _ -> Nothing
+insertPending n s b = modify $ Map.insert (n, s) b
+
+isNOC :: MonadIO m
+ => Maybe BusName
+ -> GDBusMessage
+ -> m (Maybe (BusName, Maybe BusName, Maybe BusName))
+isNOC maybeSender message = liftIO $ runMaybeT $ do
+ sender <- MaybeT . return $ maybeSender
+ guard (sender == B.dbusName)
+ type_ <- liftIO $ messageType message
+ guard (type_ == MessageTypeSignal)
+ iface <- MaybeT $ messageInterface message
+ guard (iface == B.dbusInterface)
+ member <- MaybeT $ messageMember message
+ guard (formatMemberName member == "NameOwnerChanged")
+ n <- MaybeT $ messageGetBodyString message 0
+ old <- MaybeT $ messageGetBodyString message 1
+ new <- MaybeT $ messageGetBodyString message 2
+ return (busName_ n, asBusName old, asBusName new)
where
- names :: [Maybe BusName]
- names = map fromVariant $ signalBody s
-
- looksLikeNOC =
- (sender == B.dbusName) &&
- (signalInterface s == B.dbusInterface) &&
- (formatMemberName (signalMember s) == "NameOwnerChanged")
-
-isNOC _ _ = Nothing
-
+ asBusName "" = Nothing
+ asBusName name = Just $ busName_ name
bustlifyNOC :: (BusName, Maybe BusName, Maybe BusName)
-> B.NOC
@@ -138,130 +137,118 @@ bustlifyNOC ns@(name, oldOwner, newOwner)
uniquify = B.UniqueName
otherify = B.OtherName
-tryBustlifyGetNameOwnerReply :: Maybe (MethodCall, a)
- -> MethodReturn
- -> Maybe B.NOC
-tryBustlifyGetNameOwnerReply maybeCall mr = do
+tryBustlifyGetNameOwnerReply :: MonadIO m
+ => Maybe (B.Detailed a)
+ -> GDBusMessage
+ -> m (Maybe B.NOC)
+tryBustlifyGetNameOwnerReply maybeCall reply = liftIO $ runMaybeT $ do
-- FIXME: obviously this should be more robust:
-- • check that the service really is the bus daemon
-- • don't crash if the body of the call or reply doesn't contain one bus name.
- (rawCall, _) <- maybeCall
- guard (formatMemberName (methodCallMember rawCall) == "GetNameOwner")
- ownedName <- fromVariant (head (methodCallBody rawCall))
- return $ bustlifyNOC ( ownedName
+ call <- MaybeT . return $ B.deReceivedMessage <$> maybeCall
+ member <- MaybeT $ messageMember call
+ guard (formatMemberName member == "GetNameOwner")
+ ownedName <- MaybeT $ messageGetBodyString call 0
+ owner <- MaybeT $ messageGetBodyString reply 0
+ return $ bustlifyNOC ( busName_ ownedName
, Nothing
- , fromVariant (head (methodReturnBody mr))
+ , Just $ busName_ owner
)
-bustlify :: MonadState PendingMessages m
+bustlify :: (MonadIO m, MonadState PendingMessages m)
=> B.Microseconds
-> Int
- -> ReceivedMessage
+ -> GDBusMessage
-> m B.DetailedEvent
bustlify µs bytes m = do
- bm <- buildBustledMessage
- return $ B.Detailed µs bm bytes m
- where
- sender = receivedMessageSender m
+ sender <- liftIO $ messageSender m
-- FIXME: can we do away with the un-Maybe-ing and just push that Nothing
-- means 'the monitor' downwards? Or skip the message if sender is Nothing.
- wrappedSender = convertBusName "sen.der" sender
-
- buildBustledMessage = case m of
- (ReceivedMethodCall serial mc) -> do
+ let wrappedSender = convertBusName "sen.der" sender
+ serial <- liftIO $ messageSerial m
+ replySerial <- liftIO $ messageReplySerial m
+ destination <- liftIO $ messageDestination m
+
+ let detailed x = B.Detailed µs x bytes m
+ type_ <- liftIO $ messageType m
+ detailed <$> case type_ of
+ MessageTypeMethodCall -> do
+ member <- convertMember m
let call = B.MethodCall
- { B.serial = serialValue serial
+ { B.serial = serial
, B.sender = wrappedSender
- , B.destination = convertBusName "method.call.destination" $ methodCallDestination mc
- , B.member = convertMember methodCallPath methodCallInterface methodCallMember mc
+ , B.destination = convertBusName "method.call.destination" destination
+ , B.member = member
}
- -- FIXME: we shouldn't need to construct almost the same thing here
- -- and 10 lines above maybe?
- insertPending sender serial mc (B.Detailed µs call bytes m)
+ insertPending sender serial (detailed call)
return $ B.MessageEvent call
- (ReceivedMethodReturn _serial mr) -> do
- call <- popMatchingCall (methodReturnDestination mr) (methodReturnSerial mr)
-
- return $ case tryBustlifyGetNameOwnerReply call mr of
+ MessageTypeMethodReturn -> do
+ call <- popMatchingCall destination replySerial
+ noc_ <- tryBustlifyGetNameOwnerReply call m
+ return $ case noc_ of
Just noc -> B.NOCEvent noc
Nothing -> B.MessageEvent $ B.MethodReturn
- { B.inReplyTo = fmap snd call
+ { B.inReplyTo = call
, B.sender = wrappedSender
- , B.destination = convertBusName "method.return.destination" $ methodReturnDestination mr
+ , B.destination = convertBusName "method.return.destination" destination
}
- (ReceivedMethodError _serial e) -> do
- call <- popMatchingCall (methodErrorDestination e) (methodErrorSerial e)
+ MessageTypeError -> do
+ call <- popMatchingCall destination replySerial
return $ B.MessageEvent $ B.Error
- { B.inReplyTo = fmap snd call
+ { B.inReplyTo = call
, B.sender = wrappedSender
- , B.destination = convertBusName "method.error.destination" $ methodErrorDestination e
+ , B.destination = convertBusName "method.error.destination" destination
}
- (ReceivedSignal _serial sig)
- | Just names <- isNOC sender sig -> return $ B.NOCEvent $ bustlifyNOC names
- | otherwise -> return $ B.MessageEvent $
- B.Signal { B.sender = wrappedSender
- , B.member = convertMember signalPath (Just . signalInterface) signalMember sig
- , B.signalDestination = stupifyBusName <$> signalDestination sig
- }
+ MessageTypeSignal -> do
+ names_ <- isNOC sender m
+ member <- convertMember m
+ return $ case names_ of
+ Just names -> B.NOCEvent $ bustlifyNOC names
+ Nothing -> B.MessageEvent $
+ B.Signal { B.sender = wrappedSender
+ , B.member = member
+ , B.signalDestination = stupifyBusName <$> destination
+ }
_ -> error "woah there! someone added a new message type."
-convert :: MonadState PendingMessages m
+convert :: (MonadIO m, MonadState PendingMessages m)
=> B.Microseconds
- -> BS.ByteString
+ -> Int
+ -> GDBusMessage
-> m (Either String B.DetailedEvent)
-convert µs body =
- case unmarshal body of
- Left e -> return $ Left $ unmarshalErrorMessage e
- Right m -> Right <$> bustlify µs (BS.length body) m
-
-data Result e a =
- EOF
- | Packet (Either e a)
- deriving Show
+convert µs bytes message = Right <$> bustlify µs bytes message
readOne :: (MonadState s m, MonadIO m)
- => PcapHandle
- -> (B.Microseconds -> BS.ByteString -> m (Either e a))
- -> m (Result e a)
+ => Reader
+ -> (B.Microseconds -> Int -> GDBusMessage -> m (Either e a))
+ -> m (Maybe (Either e a))
readOne p f = do
- (hdr, body) <- liftIO $ nextBS p
- -- No really, nextBS just returns null packets when you hit the end of the
- -- file.
- --
- -- It occurs to me that we could stream by just polling this every second
- -- or something?
- if hdrCaptureLength hdr == 0
- then return EOF
- else Packet <$> f (fromIntegral (hdrTime hdr)) body
+ ret <- liftIO $ readerReadOne p
+ case ret of
+ Nothing -> return Nothing
+ Just (µsec, bytes, body) -> Just <$> f µsec bytes body
-- This shows up as the biggest thing on the heap profile. Which is kind of a
-- surprise. It's supposedly the list.
mapBodies :: (MonadState s m, MonadIO m)
- => PcapHandle
- -> (B.Microseconds -> BS.ByteString -> m (Either e a))
+ => Reader
+ -> (B.Microseconds -> Int -> GDBusMessage -> m (Either e a))
-> m [Either e a]
mapBodies p f = do
ret <- readOne p f
case ret of
- EOF -> return []
- Packet x -> do
+ Nothing -> return []
+ Just x -> do
xs <- mapBodies p f
return $ x:xs
readPcap :: MonadIO m
=> FilePath
- -> m (Either IOError ([String], [B.DetailedEvent]))
+ -> m (Either GError ([String], [B.DetailedEvent]))
readPcap path = liftIO $ try $ do
- p <- openOffline path
- dlt <- datalink p
- -- DLT_NULL for extremely old logs.
- -- DLT_DBUS is missing: https://github.com/bos/pcap/pull/8
- unless (dlt `elem` [DLT_NULL, DLT_UNKNOWN 231]) $ do
- let message = "Incorrect link type " ++ show dlt
- ioError $ mkIOError userErrorType message Nothing (Just path)
-
+ p <- readerOpen path
partitionEithers <$> evalStateT (mapBodies p convert) Map.empty
diff --git a/Bustle/Monitor.hs b/Bustle/Monitor.hs
index cb9d4ef..0977990 100644
--- a/Bustle/Monitor.hs
+++ b/Bustle/Monitor.hs
@@ -44,6 +44,7 @@ import System.Glib.GObject
import System.Glib.GError
import System.Glib.Signals
+import Bustle.GDBusMessage
import Bustle.Types (Microseconds)
-- Gtk2HS boilerplate
@@ -98,19 +99,20 @@ monitorStop :: Monitor
monitorStop monitor =
withForeignPtr (unMonitor monitor) bustle_pcap_monitor_stop
-messageLoggedHandler :: (Microseconds -> BS.ByteString -> IO ())
+messageLoggedHandler :: (Microseconds -> Int -> GDBusMessage -> IO ())
-> a
-> CLong
-> CLong
-> Ptr CChar
-> CUInt
+ -> Ptr GDBusMessage
-> IO ()
-messageLoggedHandler user _obj sec usec blob blobLength = do
- blobBS <- BS.packCStringLen (blob, fromIntegral blobLength)
+messageLoggedHandler user _obj sec usec _blob blobLength messagePtr = do
let µsec = fromIntegral sec * (10 ^ (6 :: Int)) + fromIntegral usec
- failOnGError $ user µsec blobBS
+ message <- makeNewGDBusMessage (return messagePtr)
+ failOnGError $ user µsec (fromIntegral blobLength) message
-monitorMessageLogged :: Signal Monitor (Microseconds -> BS.ByteString -> IO ())
+monitorMessageLogged :: Signal Monitor (Microseconds -> Int -> GDBusMessage -> IO ())
monitorMessageLogged =
Signal $ \after_ obj user ->
connectGeneric "message-logged" after_ obj $ messageLoggedHandler user
diff --git a/Bustle/Reader.hs b/Bustle/Reader.hs
new file mode 100644
index 0000000..6a0b519
--- /dev/null
+++ b/Bustle/Reader.hs
@@ -0,0 +1,119 @@
+{-
+Bustle.Reader: Haskell binding for pcap-reader.c
+Copyright © 2020 Will Thompson
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Bustle.Reader
+ (
+-- * Types
+ Reader
+
+-- * Methods
+ , readerOpen
+ , readerReadOne
+ , readerClose
+ , withReader
+ )
+where
+
+import Control.Exception (bracket)
+
+import Foreign.C
+import Foreign.ForeignPtr
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+
+import System.Glib.GObject
+import System.Glib.GError
+
+import Bustle.GDBusMessage
+import Bustle.Types (Microseconds)
+
+-- Gtk2HS boilerplate
+newtype Reader = Reader { unReader :: ForeignPtr Reader }
+ deriving (Eq, Ord)
+
+mkReader :: (ForeignPtr Reader -> Reader, FinalizerPtr a)
+mkReader = (Reader, objectUnref)
+
+instance GObjectClass Reader where
+ toGObject = GObject . castForeignPtr . unReader
+ unsafeCastGObject = Reader . castForeignPtr . unGObject
+
+-- Foreign imports
+foreign import ccall "bustle_pcap_reader_open"
+ bustle_pcap_reader_open :: CString
+ -> Ptr (Ptr ())
+ -> IO (Ptr Reader)
+
+-- Foreign imports
+foreign import ccall "bustle_pcap_reader_read_one"
+ bustle_pcap_reader_read_one :: Ptr Reader
+ -> Ptr CLong
+ -> Ptr CLong
+ -> Ptr (Ptr CChar)
+ -> Ptr CUInt
+ -> Ptr (Ptr GDBusMessage)
+ -> Ptr (Ptr ())
+ -> IO CInt
+
+foreign import ccall "bustle_pcap_reader_close"
+ bustle_pcap_reader_close :: Ptr Reader
+ -> IO ()
+
+-- Throws a GError if the file can't be opened
+readerOpen :: FilePath
+ -> IO Reader
+readerOpen filename =
+ wrapNewGObject mkReader $
+ propagateGError $ \gerrorPtr ->
+ withCString filename $ \c_filename ->
+ bustle_pcap_reader_open c_filename gerrorPtr
+
+readerReadOne :: Reader
+ -> IO (Maybe (Microseconds, Int, GDBusMessage))
+readerReadOne reader =
+ withForeignPtr (unReader reader) $ \c_reader ->
+ alloca $ \secPtr ->
+ alloca $ \usecPtr ->
+ alloca $ \blobPtrPtr ->
+ alloca $ \lengthPtr ->
+ alloca $ \messagePtr -> do
+ poke messagePtr nullPtr
+ propagateGError $ bustle_pcap_reader_read_one c_reader secPtr usecPtr blobPtrPtr lengthPtr messagePtr
+ blob <- peek blobPtrPtr
+ if blob == nullPtr
+ then return Nothing
+ else do
+ sec <- peek secPtr
+ usec <- peek usecPtr
+ blobLength <- peek lengthPtr
+ let µsec = fromIntegral sec * (10 ^ (6 :: Int)) + fromIntegral usec
+ message <- wrapNewGDBusMessage $ peek messagePtr
+ return $ Just (µsec, fromIntegral blobLength, message)
+
+readerClose :: Reader
+ -> IO ()
+readerClose reader =
+ withForeignPtr (unReader reader) bustle_pcap_reader_close
+
+withReader :: FilePath
+ -> (Reader -> IO a)
+ -> IO a
+withReader filename f = do
+ bracket (readerOpen filename) readerClose f
diff --git a/Bustle/Types.hs b/Bustle/Types.hs
index 78306c4..36a4e8c 100644
--- a/Bustle/Types.hs
+++ b/Bustle/Types.hs
@@ -65,20 +65,12 @@ module Bustle.Types
)
where
-import Data.Word (Word32)
-import DBus ( ObjectPath, formatObjectPath
- , InterfaceName, formatInterfaceName, interfaceName_
- , MemberName, formatMemberName
- , BusName, formatBusName, busName_
- , ReceivedMessage
- )
+import Bustle.GDBusMessage
import Data.Maybe (maybeToList)
import Data.Either (partitionEithers)
import Data.Set (Set)
import qualified Data.Set as Set
-type Serial = Word32
-
newtype UniqueName = UniqueName BusName
deriving (Ord, Show, Eq)
newtype OtherName = OtherName BusName
@@ -195,7 +187,7 @@ data Detailed e =
Detailed { deTimestamp :: Microseconds
, deEvent :: e
, deMessageSize :: MessageSize
- , deReceivedMessage :: ReceivedMessage
+ , deReceivedMessage :: GDBusMessage
}
deriving (Show, Eq, Functor)
diff --git a/Bustle/UI.hs b/Bustle/UI.hs
index 7eda4f7..efcb8f7 100644
--- a/Bustle/UI.hs
+++ b/Bustle/UI.hs
@@ -41,6 +41,7 @@ import Bustle.Application.Monad
import Bustle.Renderer
import Bustle.Types
import Bustle.Diagram
+import Bustle.GDBusMessage
import qualified Bustle.Marquee as Marquee
import Bustle.Monitor
import Bustle.Util
@@ -284,9 +285,10 @@ recorderRun wi target filename r = C.handle newFailed $ do
loaderStateRef <- newIORef Map.empty
pendingRef <- newIORef []
- let updateLabel µs body = do
+ let updateLabel :: Microseconds -> Int -> GDBusMessage -> IO ()
+ updateLabel µs l msg = do
s <- readIORef loaderStateRef
- (m, s') <- runStateT (convert µs body) s
+ (m, s') <- runStateT (convert µs l msg) s
s' `seq` writeIORef loaderStateRef s'
case m of
diff --git a/Bustle/UI/DetailsView.hs b/Bustle/UI/DetailsView.hs
index 820aff0..7b8ef63 100644
--- a/Bustle/UI/DetailsView.hs
+++ b/Bustle/UI/DetailsView.hs
@@ -24,16 +24,14 @@ module Bustle.UI.DetailsView
)
where
-import Data.List (intercalate)
-import Graphics.UI.Gtk hiding (Signal)
+import Control.Monad.Trans (liftIO)
+import Control.Monad.Trans.Maybe (MaybeT(..))
-import qualified DBus as D
-import DBus.Internal.Message (MethodError(..))
-import DBus.Internal.Types (ErrorName(..))
+import Graphics.UI.Gtk hiding (Signal)
import Bustle.Types
import Bustle.Marquee
-import Bustle.VariantFormatter
+import Bustle.GDBusMessage
type OptionalRow = (Label, Label)
@@ -91,21 +89,20 @@ getDestination (Detailed _ m _ _) = case m of
Signal { signalDestination = d } -> d
_ -> Just (destination m)
-getErrorName :: Detailed a -> Maybe String
-getErrorName (Detailed _ _ _ rm) = case rm of
- D.ReceivedMethodError _ MethodError{ methodErrorName = ErrorName en} -> Just en
- _ -> Nothing
-
-formatMessage :: Detailed Message -> String
-formatMessage (Detailed _ _ _ rm) =
- case (rm, D.fromVariant <$> body) of
- -- Special-case errors, which (are supposed to) have a single
- -- human-readable string argument
- (D.ReceivedMethodError _ _, [Just message]) -> message
- _ -> formatted
+getErrorName :: Detailed a -> IO (Maybe String)
+getErrorName (Detailed _ _ _ m) = messageErrorName m
+
+formatMessage :: Detailed Message -> IO String
+formatMessage (Detailed _ _ _ m) = do
+ errorMessage <- formatErrorMessage
+ case errorMessage of
+ Just message -> return message
+ Nothing -> messagePrintBody m
where
- body = D.receivedMessageBody rm
- formatted = intercalate "\n" $ map (format_Variant VariantStyleSignature) body
+ formatErrorMessage :: IO (Maybe String)
+ formatErrorMessage = runMaybeT $ do
+ MessageTypeError <- liftIO $ messageType m
+ MaybeT $ messageGetBodyString m 0
detailsViewGetTop :: DetailsView -> Widget
detailsViewGetTop = toWidget . detailsGrid
@@ -133,10 +130,10 @@ detailsViewUpdate d m = do
-- to/from well-known names and show both
labelSetText (detailsSender d) (unBusName . sender . deEvent $ m)
setOptionalRow (detailsDestination d) (unBusName <$> getDestination m)
- setOptionalRow (detailsErrorName d) (getErrorName m)
+ setOptionalRow (detailsErrorName d) =<< getErrorName m
- labelSetText (detailsPath d) (maybe unknown (D.formatObjectPath . path) member_)
+ labelSetText (detailsPath d) (maybe unknown (formatObjectPath . path) member_)
labelSetMarkup (detailsMember d) (maybe unknown getMemberMarkup member_)
- textBufferSetText buf (formatMessage m)
+ textBufferSetText buf =<< formatMessage m
where
unknown = ""
diff --git a/Bustle/VariantFormatter.hs b/Bustle/VariantFormatter.hs
deleted file mode 100644
index 4fd730d..0000000
--- a/Bustle/VariantFormatter.hs
+++ /dev/null
@@ -1,150 +0,0 @@
-{-
-Bustle.VariantFormatter: produces GVariant strings representing D-Bus values
-Copyright © 2011 Will Thompson
-
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
-
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
--}
-module Bustle.VariantFormatter
- ( format_Variant
- , VariantStyle(..)
- )
-where
-
-import Data.Word
-import Data.Int
-import Data.List (intercalate)
-import Data.Char (chr, isPrint)
--- :'(
-import Data.Maybe (fromJust)
-
-import DBus
-
-format_Bool :: Bool -> String
-format_Bool = show
-
-format_Word8 :: Word8 -> String
-format_Word8 = show
-
-format_ByteArray :: Array -> String
-format_ByteArray ay =
- if all isPrintish chars
- then 'b':show chars
- else format_Array ay
- where
- bytes = map (fromJust . fromVariant) (arrayItems ay) :: [Word8]
- chars = map (chr . fromIntegral) bytes
- isPrintish '\0' = True
- isPrintish c = isPrint c
-
-
-format_Int16 :: Int16 -> String
-format_Int16 = show
-format_Int32 :: Int32 -> String
-format_Int32 = show
-format_Int64 :: Int64 -> String
-format_Int64 = show
-
-format_Word16 :: Word16 -> String
-format_Word16 = show
-format_Word32 :: Word32 -> String
-format_Word32 = show
-format_Word64 :: Word64 -> String
-format_Word64 = show
-
-format_Double :: Double -> String
-format_Double = show
-
-format_String :: String -> String
-format_String = show
-
-format_Signature :: Signature -> String
-format_Signature = show . formatSignature
-
-format_ObjectPath :: ObjectPath -> String
-format_ObjectPath = show . formatObjectPath
-
-format_Array :: Array -> String
-format_Array a = "[" ++ intercalate ", " items ++ "]"
- where
- items = map (format_Variant VariantStyleBare) $ arrayItems a
-
-format_Dictionary :: Dictionary -> String
-format_Dictionary d = "{" ++ intercalate ", " items ++ "}"
- where
- items = map (\(k, v) -> format_Variant VariantStyleBare k ++ ": " ++ format_Variant VariantStyleBare v) $ dictionaryItems d
-
--- FIXME…
-format_Structure :: Structure -> String
-format_Structure s = case structureItems s of
- [] -> "()"
- [v] -> "(" ++ format_Variant VariantStyleBare v ++ ",)"
- vs -> "(" ++ intercalate ", " items ++ ")"
- where
- items = map (format_Variant VariantStyleBare) vs
-
-data VariantStyle =
- VariantStyleBare
- | VariantStyleSignature
- | VariantStyleAngleBrackets
-
--- why did you remove typeCode from the public API, John…
-typeCode :: Type -> String
-typeCode TypeBoolean = "b"
-typeCode TypeWord8 = "y"
-typeCode TypeWord16 = "q"
-typeCode TypeWord32 = "u"
-typeCode TypeWord64 = "t"
-typeCode TypeInt16 = "n"
-typeCode TypeInt32 = "i"
-typeCode TypeInt64 = "x"
-typeCode TypeDouble = "d"
-typeCode TypeString = "s"
-typeCode TypeSignature = "g"
-typeCode TypeObjectPath = "o"
-typeCode TypeUnixFd = "h"
-typeCode TypeVariant = "v"
-typeCode (TypeArray t) = 'a':typeCode t
-typeCode (TypeDictionary kt vt) = concat [ "a{", typeCode kt , typeCode vt, "}"]
-typeCode (TypeStructure ts) = concat ["(", concatMap typeCode ts, ")"]
-
-format_Variant :: VariantStyle -> Variant -> String
-format_Variant style v =
- case style of
- VariantStyleBare -> formatted
- VariantStyleSignature -> typeSignature ++ " " ++ formatted
- VariantStyleAngleBrackets -> "<" ++ typeSignature ++ " " ++ formatted ++ ">"
- where
- ty = variantType v
- typeSignature = ('@':) . typeCode $ ty
- format = case ty of
- TypeBoolean -> format_Bool . fromJust . fromVariant
- TypeInt16 -> format_Int16 . fromJust . fromVariant
- TypeInt32 -> format_Int32 . fromJust . fromVariant
- TypeInt64 -> format_Int64 . fromJust . fromVariant
- TypeWord8 -> format_Word8 . fromJust . fromVariant
- TypeWord16 -> format_Word16 . fromJust . fromVariant
- TypeWord32 -> format_Word32 . fromJust . fromVariant
- TypeWord64 -> format_Word64 . fromJust . fromVariant
- TypeDouble -> format_Double . fromJust . fromVariant
- TypeString -> format_String . fromJust . fromVariant
- TypeSignature -> format_Signature . fromJust . fromVariant
- TypeObjectPath -> format_ObjectPath . fromJust . fromVariant
- TypeUnixFd -> const "<fd>"
- TypeVariant -> format_Variant VariantStyleAngleBrackets . fromJust . fromVariant
- TypeArray TypeWord8 -> format_ByteArray . fromJust . fromVariant
- TypeArray _ -> format_Array . fromJust . fromVariant
- TypeDictionary _ _ -> format_Dictionary . fromJust . fromVariant
- TypeStructure _ -> format_Structure . fromJust . fromVariant
- formatted = format v
diff --git a/Makefile b/Makefile
index 7a6370a..79b447e 100644
--- a/Makefile
+++ b/Makefile
@@ -24,9 +24,15 @@ SCALABLE_ICONS = \
all: $(BINARIES) $(MANPAGE) $(DESKTOP_FILE) $(APPDATA_FILE) $(SCALABLE_ICONS)
-BUSTLE_PCAP_SOURCES = c-sources/pcap-monitor.c c-sources/bustle-pcap.c
+BUSTLE_PCAP_SOURCES = \
+ c-sources/pcap-reader.c \
+ c-sources/pcap-monitor.c \
+ c-sources/bustle-pcap.c
BUSTLE_PCAP_GENERATED_HEADERS = dist/build/autogen/version.h
-BUSTLE_PCAP_HEADERS = c-sources/pcap-monitor.h $(BUSTLE_PCAP_GENERATED_HEADERS)
+BUSTLE_PCAP_HEADERS = \
+ c-sources/pcap-reader.h \
+ c-sources/pcap-monitor.h \
+ $(BUSTLE_PCAP_GENERATED_HEADERS)
bustle-pcap.1: dist/build/bustle-pcap
help2man --output=$@ --no-info --name='Generate D-Bus logs for bustle' $<
diff --git a/Test/Renderer.hs b/Test/Renderer.hs
index 388c849..45defc0 100644
--- a/Test/Renderer.hs
+++ b/Test/Renderer.hs
@@ -13,10 +13,10 @@ import qualified Data.Set as Set
import Data.Monoid
import Data.List
import System.Exit (exitFailure)
-import DBus (objectPath_, busName_, ReceivedMessage(ReceivedMethodReturn), firstSerial, methodReturn)
import Bustle.Types
import Bustle.Renderer
+import Bustle.GDBusMessage
main :: IO ()
main = defaultMain tests
@@ -39,9 +39,18 @@ main = defaultMain tests
-- disconnect from the bus before the end of the log. This is a regression test
-- for a bug I almost introduced.
activeService = UniqueName ":1.1"
-dummyReceivedMessage = ReceivedMethodReturn firstSerial (methodReturn firstSerial)
-swaddle messages timestamps = map (\(e, ts) -> Detailed ts e 0 dummyReceivedMessage)
- (zip messages timestamps)
+dummyReceivedMessage :: IO GDBusMessage
+dummyReceivedMessage = messageNewSignal o i m
+ where
+ o = objectPath_ "/"
+ i = interfaceName_ "com.example"
+ m = memberName_ "Signal"
+
+swaddle :: [Event] -> [Microseconds] -> IO [DetailedEvent]
+swaddle messages timestamps = forM (zip messages timestamps) $ \(e, ts) -> do
+ m <- dummyReceivedMessage
+ return $ Detailed ts e 0 m
+
sessionLogWithoutDisconnect =
[ NOCEvent $ Connected activeService
, MessageEvent $ Signal (U activeService) Nothing $ Member (objectPath_ "/") Nothing "Hello"
@@ -49,10 +58,12 @@ sessionLogWithoutDisconnect =
sessionLogWithDisconnect = sessionLogWithoutDisconnect ++ [ NOCEvent $ Disconnected activeService ]
expectedParticipants = [ (activeService, Set.empty) ]
-test_ l expected = expected @=? ps
- where
- rr = process (swaddle l [1..]) []
- ps = sessionParticipants (rrApplications rr)
+-- test_ :: a -> b -> Assertion
+test_ l expected = do
+ events <- swaddle l [1..]
+ let rr = process events []
+ let ps = sessionParticipants (rrApplications rr)
+ expected @=? ps
test_participants = test_ sessionLogWithoutDisconnect expectedParticipants
test_participants_with_disconnect = test_ sessionLogWithDisconnect expectedParticipants
@@ -73,7 +84,10 @@ bareLog = [ NOCEvent $ Connected u1
++ map (\o -> NOCEvent (NameChanged o (Claimed u2))) os ++
[ MessageEvent $ MethodCall 0 (U u1) (O (head os)) m ]
+sessionLog :: IO [DetailedEvent]
sessionLog = swaddle bareLog [1,3..]
+
+systemLog :: IO [DetailedEvent]
systemLog = swaddle bareLog [2,4..]
test_incremental_simple :: (Show b, Eq b)
@@ -100,13 +114,19 @@ test_incremental :: ( RendererResult Participants
-> Assertion
)
-> Assertion
-test_incremental f = f fullRR incrementalRR
+test_incremental f = do
+ events <- sessionLog
+ let full = fullRR events
+ let incremental = incrementalRR events
+ f full incremental
-- TODO: it should be possible to make this work for side-by-side logs too.
-- Currently it doesn't seem to...
-fullRR, incrementalRR :: RendererResult Participants
-fullRR = process sessionLog []
-incrementalRR = mconcat rrs
+fullRR, incrementalRR :: [DetailedEvent]
+ -> RendererResult Participants
+fullRR events = process events []
+
+incrementalRR events = mconcat rrs
where
processOne m = state $ processSome [m] []
- (rrs, _) = runState (mapM processOne sessionLog) rendererStateNew
+ (rrs, _) = runState (mapM processOne events) rendererStateNew
diff --git a/Test/data/log-with-h.bustle b/Test/data/log-with-h.bustle
index 734b69d..c630050 100644
--- a/Test/data/log-with-h.bustle
+++ b/Test/data/log-with-h.bustle
Binary files differ
diff --git a/bustle.cabal b/bustle.cabal
index 3220392..32cd1bf 100644
--- a/bustle.cabal
+++ b/bustle.cabal
@@ -1,7 +1,7 @@
+Cabal-Version: 2.2
Name: bustle
Category: Network, Desktop
Version: 0.7.5.1
-Cabal-Version: 2.0
Tested-With: GHC == 8.4.3
Synopsis: Draw sequence diagrams of D-Bus traffic
Description: Bustle records and draws sequence diagrams of D-Bus activity, showing signal emissions, method calls and their corresponding returns, with timestamps for each individual event and the duration of each method call. This can help you check for unwanted D-Bus traffic, and pinpoint why your D-Bus-based application isn't performing as well as you like. It also provides statistics like signal frequencies and average method call times.
@@ -19,6 +19,7 @@ Build-type: Custom
Extra-source-files:
-- C bits
c-sources/bustle-pcap.c,
+ c-sources/pcap-reader.h,
c-sources/pcap-monitor.h,
c-sources/config.h,
Makefile,
@@ -79,12 +80,15 @@ Executable bustle
Main-is: Bustle.hs
Other-modules: Bustle.Application.Monad
, Bustle.Diagram
+ , Bustle.GDBusMessage
+ , Bustle.GVariant
, Bustle.Loader
, Bustle.Loader.Pcap
, Bustle.Marquee
, Bustle.Missing
, Bustle.Monitor
, Bustle.Noninteractive
+ , Bustle.Reader
, Bustle.Regions
, Bustle.Renderer
, Bustle.StatisticsPane
@@ -100,7 +104,6 @@ Executable bustle
, Bustle.UI.RecordAddressDialog
, Bustle.UI.Recorder
, Bustle.Util
- , Bustle.VariantFormatter
, Paths_bustle
autogen-modules: Paths_bustle
default-language: Haskell2010
@@ -108,15 +111,16 @@ Executable bustle
-fno-warn-unused-do-bind
if flag(threaded)
ghc-options: -threaded
- C-sources: c-sources/pcap-monitor.c
+ C-sources: c-sources/pcap-reader.c
+ , c-sources/pcap-monitor.c
cc-options: -fPIC -g
+ extra-libraries: pcap
pkgconfig-depends: glib-2.0 >= 2.54,
gio-unix-2.0
Build-Depends: base >= 4.11 && < 5
, bytestring
, cairo
, containers
- , dbus >= 0.10
, directory
, filepath
, glib
@@ -124,10 +128,10 @@ Executable bustle
, gtk3
, mtl >= 2.2.1
, pango
- , pcap
, process
, text
, time
+ , transformers
if flag(hgettext)
Build-Depends: hgettext >= 0.1.5
, setlocale
@@ -150,10 +154,9 @@ Executable dump-messages
Build-Depends: base
, bytestring
, containers
- , dbus >= 0.10
, mtl
- , pcap
, text
+ , transformers
if flag(hgettext)
Build-Depends: hgettext >= 0.1.5
@@ -169,17 +172,24 @@ Executable dump-messages
Test-suite test-pcap-crash
type: exitcode-stdio-1.0
main-is: Test/PcapCrash.hs
- other-modules: Bustle.Loader.Pcap
+ other-modules: Bustle.GDBusMessage
+ , Bustle.GVariant
+ , Bustle.Loader.Pcap
+ , Bustle.Reader
, Bustle.Translation
, Bustle.Types
default-language: Haskell2010
Build-Depends: base
, bytestring
, containers
- , dbus >= 0.10
+ , glib
, mtl
- , pcap
, text
+ , transformers
+ C-sources: c-sources/pcap-reader.c
+ pkgconfig-depends: glib-2.0 >= 2.54,
+ gio-unix-2.0
+ extra-libraries: pcap
if flag(hgettext)
Build-Depends: hgettext >= 0.1.5
, setlocale
@@ -203,6 +213,8 @@ Test-suite test-renderer
type: exitcode-stdio-1.0
main-is: Test/Renderer.hs
other-modules: Bustle.Diagram
+ , Bustle.GDBusMessage
+ , Bustle.GVariant
, Bustle.Marquee
, Bustle.Regions
, Bustle.Renderer
@@ -210,21 +222,20 @@ Test-suite test-renderer
, Bustle.Types
, Bustle.Util
-
-
default-language: Haskell2010
Build-Depends: base
, cairo
, containers
- , dbus >= 0.10
, directory
, filepath
+ , glib
, gtk3
, mtl
, text
, pango
, test-framework
, test-framework-hunit
+ , transformers
, HUnit
if flag(hgettext)
Build-Depends: hgettext >= 0.1.5
diff --git a/c-sources/bustle-pcap.c b/c-sources/bustle-pcap.c
index 93c6f95..2a39797 100644
--- a/c-sources/bustle-pcap.c
+++ b/c-sources/bustle-pcap.c
@@ -181,20 +181,14 @@ message_logged_cb (
glong usec,
guint8 *data,
guint len,
+ GDBusMessage *message,
gpointer user_data)
{
- g_autoptr(GError) error = NULL;
- g_autoptr(GDBusMessage) message = g_dbus_message_new_from_blob (
- data, len, G_DBUS_CAPABILITY_FLAGS_UNIX_FD_PASSING, &error);
-
- if (message == NULL)
- g_warning ("%s", error->message);
- else
- g_print ("%s -> %s: %d %s\n",
- g_dbus_message_get_sender (message),
- g_dbus_message_get_destination (message),
- g_dbus_message_get_message_type (message),
- g_dbus_message_get_member (message));
+ g_print ("%s -> %s: %d %s\n",
+ g_dbus_message_get_sender (message),
+ g_dbus_message_get_destination (message),
+ g_dbus_message_get_message_type (message),
+ g_dbus_message_get_member (message));
}
static void
diff --git a/c-sources/pcap-monitor.c b/c-sources/pcap-monitor.c
index 9800cc4..2a5c022 100644
--- a/c-sources/pcap-monitor.c
+++ b/c-sources/pcap-monitor.c
@@ -31,12 +31,12 @@
#include <sys/stat.h>
#include <sys/types.h>
-#include <pcap/pcap.h>
-
#include <glib.h>
#include <glib/gstdio.h>
#include <gio/gunixinputstream.h>
+#include "pcap-reader.h"
+
/* Prefix of name claimed by the connection that collects name owners. */
const char *BUSTLE_MONITOR_NAME_PREFIX = "org.freedesktop.Bustle.Monitor.";
@@ -99,13 +99,12 @@ typedef struct _BustlePcapMonitor {
GSubprocess *dbus_monitor;
/* If >= 0, master side of controlling terminal for dbus_monitor */
int pt_master;
- GSource *dbus_monitor_source;
- pcap_t *pcap_in;
+ GSubprocess *tee_proc;
+ GSource *tee_source;
+ BustlePcapReader *reader;
/* output */
gchar *filename;
- pcap_t *pcap_out;
- pcap_dumper_t *dumper;
/* errors */
GError *pcap_error;
@@ -206,16 +205,6 @@ bustle_pcap_monitor_set_property (
}
static void
-close_dump (BustlePcapMonitor *self)
-{
- if (self->dumper != NULL)
- pcap_dump_flush (self->dumper);
-
- g_clear_pointer (&self->dumper, pcap_dump_close);
- g_clear_pointer (&self->pcap_out, pcap_close);
-}
-
-static void
bustle_pcap_monitor_dispose (GObject *object)
{
BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (object);
@@ -229,12 +218,11 @@ bustle_pcap_monitor_dispose (GObject *object)
}
g_clear_object (&self->cancellable);
- g_clear_pointer (&self->dbus_monitor_source, g_source_destroy);
- g_clear_pointer (&self->pcap_in, pcap_close);
+ g_clear_pointer (&self->tee_source, g_source_destroy);
+ g_clear_object (&self->tee_proc);
+ g_clear_object (&self->reader);
g_clear_object (&self->dbus_monitor);
- close_dump (self);
-
if (parent_class->dispose != NULL)
parent_class->dispose (object);
}
@@ -300,15 +288,17 @@ bustle_pcap_monitor_class_init (BustlePcapMonitorClass *klass)
* #GValue.)
* @blob: an array of bytes containing the serialized message.
* @length: the size in bytes of @blob.
+ * @message: @blob as a #GDBusMessage.
*/
signals[SIG_MESSAGE_LOGGED] = g_signal_new ("message-logged",
BUSTLE_TYPE_PCAP_MONITOR, G_SIGNAL_RUN_FIRST,
0, NULL, NULL,
- NULL, G_TYPE_NONE, 4,
+ NULL, G_TYPE_NONE, 5,
G_TYPE_LONG,
G_TYPE_LONG,
G_TYPE_POINTER,
- G_TYPE_UINT);
+ G_TYPE_UINT,
+ G_TYPE_DBUS_MESSAGE);
/**
* BustlePcapMonitor::stopped:
@@ -405,7 +395,6 @@ handle_error (BustlePcapMonitor *self)
}
self->state = STATE_STOPPED;
- close_dump (self);
g_debug ("%s: emitting ::stopped(%s, %d, %s)", G_STRFUNC,
g_quark_to_string (error->domain), error->code, error->message);
@@ -652,9 +641,8 @@ start_pcap (
GInputStream *stdout_pipe = NULL;
gint stdout_fd = -1;
FILE *dbus_monitor_filep = NULL;
- char errbuf[PCAP_ERRBUF_SIZE] = {0};
- stdout_pipe = g_subprocess_get_stdout_pipe (self->dbus_monitor);
+ stdout_pipe = g_subprocess_get_stdout_pipe (self->tee_proc);
g_return_val_if_fail (stdout_pipe != NULL, FALSE);
stdout_fd = g_unix_input_stream_get_fd (G_UNIX_INPUT_STREAM (stdout_pipe));
@@ -674,24 +662,17 @@ start_pcap (
* fread(). It's safe to do this on the main thread, since we know the pipe
* is readable. On short read, pcap_fopen_offline() fails immediately.
*/
- self->pcap_in = pcap_fopen_offline (dbus_monitor_filep, errbuf);
- if (self->pcap_in == NULL)
+ self->reader = bustle_pcap_reader_fopen (g_steal_pointer (&dbus_monitor_filep), error);
+ if (self->reader == NULL)
{
- g_set_error (error, G_IO_ERROR, G_IO_ERROR_FAILED,
- "Couldn't read messages from dbus-monitor: %s",
- errbuf);
-
- /* Cause dbus-monitor to exit next time it tries to write a message */
- g_clear_pointer (&dbus_monitor_filep, fclose);
+ g_prefix_error (error, "Couldn't read messages from dbus-monitor: ");
- /* And try to terminate it immediately. */
+ /* Try to terminate dbus-monitor immediately. The reader closes the FILE * on error. */
send_sigint (self);
return FALSE;
}
- /* pcap_close() will call fclose() on the FILE * passed to
- * pcap_fopen_offline() */
dump_names_async (self);
self->state = STATE_RUNNING;
return TRUE;
@@ -702,35 +683,28 @@ read_one (
BustlePcapMonitor *self,
GError **error)
{
- struct pcap_pkthdr *hdr;
+ glong sec, usec;
const guchar *blob;
- int ret;
+ guint length;
+ g_autoptr(GDBusMessage) message = NULL;
- ret = pcap_next_ex (self->pcap_in, &hdr, &blob);
- switch (ret)
+ if (!bustle_pcap_reader_read_one (self->reader, &sec, &usec, &blob, &length, &message, error))
{
- case 1:
- g_signal_emit (self, signals[SIG_MESSAGE_LOGGED], 0,
- hdr->ts.tv_sec, hdr->ts.tv_usec, blob, hdr->caplen);
-
- /* cast necessary because pcap_dump has a type matching the callback
- * argument to pcap_loop()
- * TODO don't block
- */
- pcap_dump ((u_char *) self->dumper, hdr, blob);
- return TRUE;
-
- case -2:
- /* EOF; shouldn't happen since we waited for the FD to be readable */
- g_set_error (error, G_IO_ERROR, G_IO_ERROR_CONNECTION_CLOSED,
- "EOF when reading from dbus-monitor");
- return FALSE;
+ return FALSE;
+ }
+ else if (message == NULL)
+ {
+ /* EOF; shouldn't happen since we waited for the FD to be readable */
+ g_set_error (error, G_IO_ERROR, G_IO_ERROR_CONNECTION_CLOSED,
+ "EOF when reading from dbus-monitor");
+ return FALSE;
+ }
+ else
+ {
+ g_signal_emit (self, signals[SIG_MESSAGE_LOGGED], 0,
+ sec, usec, blob, length, message);
- default:
- g_set_error (error, G_IO_ERROR, G_IO_ERROR_FAILED,
- "Error %i reading dbus-monitor stream: %s",
- ret, pcap_geterr (self->pcap_in));
- return FALSE;
+ return TRUE;
}
}
@@ -824,7 +798,7 @@ cancellable_cancelled_cb (GCancellable *cancellable,
/* Closes the stream; should cause dbus-monitor to quit in due course when it
* tries to write to the other end of the pipe.
*/
- g_clear_pointer (&self->pcap_in, pcap_close);
+ bustle_pcap_reader_close (self->reader);
/* And try to terminate it immediately. */
send_sigint (self);
@@ -931,6 +905,27 @@ spawn_monitor (BustlePcapMonitor *self,
return child;
}
+static GSubprocess *
+spawn_tee (BustlePcapMonitor *self,
+ GError **error)
+{
+ g_autoptr(GSubprocessLauncher) launcher =
+ g_subprocess_launcher_new (G_SUBPROCESS_FLAGS_STDOUT_PIPE);
+ GInputStream *stdout_pipe = NULL;
+ gint stdout_fd = -1;
+
+ stdout_pipe = g_subprocess_get_stdout_pipe (self->dbus_monitor);
+ g_return_val_if_fail (stdout_pipe != NULL, FALSE);
+
+ stdout_fd = g_unix_input_stream_get_fd (G_UNIX_INPUT_STREAM (stdout_pipe));
+ g_return_val_if_fail (stdout_fd >= 0, FALSE);
+
+ g_subprocess_launcher_take_stdin_fd (launcher, stdout_fd);
+
+ return g_subprocess_launcher_spawn (launcher, error,
+ "tee", self->filename, NULL);
+}
+
static gboolean
initable_init (
GInitable *initable,
@@ -957,36 +952,24 @@ initable_init (
G_CALLBACK (cancellable_cancelled_cb),
self, NULL);
- self->pcap_out = pcap_open_dead (DLT_DBUS, 1 << 27);
- if (self->pcap_out == NULL)
- {
- g_set_error (error, G_IO_ERROR, G_IO_ERROR_FAILED,
- "pcap_open_dead failed. wtf");
- return FALSE;
- }
-
- self->dumper = pcap_dump_open (self->pcap_out, self->filename);
- if (self->dumper == NULL)
- {
- g_set_error (error, G_IO_ERROR, G_IO_ERROR_FAILED,
- "Couldn't open target file %s", pcap_geterr (self->pcap_out));
- return FALSE;
- }
-
self->dbus_monitor = spawn_monitor (self, (const char * const *) argv, error);
if (self->dbus_monitor == NULL)
return FALSE;
- stdout_pipe = g_subprocess_get_stdout_pipe (self->dbus_monitor);
+ self->tee_proc = spawn_tee (self, error);
+ if (self->tee_proc == NULL)
+ return FALSE;
+
+ stdout_pipe = g_subprocess_get_stdout_pipe (self->tee_proc);
g_return_val_if_fail (stdout_pipe != NULL, FALSE);
g_return_val_if_fail (G_IS_POLLABLE_INPUT_STREAM (stdout_pipe), FALSE);
g_return_val_if_fail (G_IS_UNIX_INPUT_STREAM (stdout_pipe), FALSE);
- self->dbus_monitor_source = g_pollable_input_stream_create_source (
+ self->tee_source = g_pollable_input_stream_create_source (
G_POLLABLE_INPUT_STREAM (stdout_pipe), self->cancellable);
- g_source_set_callback (self->dbus_monitor_source,
+ g_source_set_callback (self->tee_source,
(GSourceFunc) dbus_monitor_readable, self, NULL);
- g_source_attach (self->dbus_monitor_source, NULL);
+ g_source_attach (self->tee_source, NULL);
g_subprocess_wait_check_async (
self->dbus_monitor,
diff --git a/c-sources/pcap-reader.c b/c-sources/pcap-reader.c
new file mode 100644
index 0000000..cc12f24
--- /dev/null
+++ b/c-sources/pcap-reader.c
@@ -0,0 +1,307 @@
+/*
+ * pcap-reader.c - reads DBus messages from a pcap stream
+ * Copyright © 2011–2012 Collabora Ltd.
+ * Copyright © 2018–2020 Will Thompson
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#define _GNU_SOURCE
+
+#include "config.h"
+#include "pcap-reader.h"
+
+#include <errno.h>
+#include <fcntl.h>
+#include <signal.h>
+#include <string.h>
+#include <sys/ioctl.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+
+#include <pcap/pcap.h>
+
+typedef struct _BustlePcapReader {
+ GObject parent;
+
+ gchar *filename;
+ FILE *filep;
+
+ pcap_t *pcap_in;
+} BustlePcapReader;
+
+typedef enum {
+ PROP_FILENAME = 1,
+ PROP_FILEP
+} BustlePcapReaderProp;
+
+static void initable_iface_init (
+ gpointer g_class,
+ gpointer unused);
+
+G_DEFINE_TYPE_WITH_CODE (BustlePcapReader, bustle_pcap_reader, G_TYPE_OBJECT,
+ G_IMPLEMENT_INTERFACE (G_TYPE_INITABLE, initable_iface_init);
+ )
+
+/* A sad echo of the functions in libglnx. */
+static inline void *
+throw_errno (GError **error,
+ const gchar *prefix)
+{
+ int errsv = errno;
+ g_set_error (error, G_IO_ERROR, g_io_error_from_errno (errsv),
+ "%s: %s", prefix, g_strerror (errsv));
+ return NULL;
+}
+
+static void
+bustle_pcap_reader_init (BustlePcapReader *self)
+{
+}
+
+static void
+bustle_pcap_reader_set_property (
+ GObject *object,
+ guint property_id,
+ const GValue *value,
+ GParamSpec *pspec)
+{
+ BustlePcapReader *self = BUSTLE_PCAP_READER (object);
+
+ switch ((BustlePcapReaderProp) property_id)
+ {
+ case PROP_FILENAME:
+ self->filename = g_value_dup_string (value);
+ break;
+ case PROP_FILEP:
+ self->filep = g_value_get_pointer (value);
+ break;
+ default:
+ G_OBJECT_WARN_INVALID_PROPERTY_ID (object, property_id, pspec);
+ }
+}
+
+static void
+bustle_pcap_reader_finalize (GObject *object)
+{
+ BustlePcapReader *self = BUSTLE_PCAP_READER (object);
+ GObjectClass *parent_class = bustle_pcap_reader_parent_class;
+
+ g_clear_pointer (&self->filename, g_free);
+ g_clear_pointer (&self->filep, fclose);
+ g_clear_pointer (&self->pcap_in, pcap_close);
+
+ if (parent_class->finalize != NULL)
+ parent_class->finalize (object);
+}
+
+static void
+bustle_pcap_reader_class_init (BustlePcapReaderClass *klass)
+{
+ GObjectClass *object_class = G_OBJECT_CLASS (klass);
+ GParamSpec *param_spec;
+
+ object_class->set_property = bustle_pcap_reader_set_property;
+ object_class->finalize = bustle_pcap_reader_finalize;
+
+ param_spec = g_param_spec_string ("filename", "Filename",
+ "Path to pcap file to read",
+ NULL,
+ G_PARAM_CONSTRUCT_ONLY | G_PARAM_WRITABLE | G_PARAM_STATIC_STRINGS);
+ g_object_class_install_property (object_class, PROP_FILENAME, param_spec);
+
+ param_spec = g_param_spec_pointer ("filep", "FILE *",
+ "FILE * to read pcap stream from",
+ G_PARAM_CONSTRUCT_ONLY | G_PARAM_WRITABLE | G_PARAM_STATIC_STRINGS);
+ g_object_class_install_property (object_class, PROP_FILEP, param_spec);
+}
+
+/**
+ * bustle_pcap_reader_read_one:
+ * @self:
+ * @hdr: (out) (transfer none): location to store pcap header (or %NULL on EOF)
+ * @blob: (out) (transfer none): location to store raw message (or %NULL on EOF)
+ * @message: (out) (transfer full): location to store parsed message (or %NULL on EOF)
+ * @error:
+ *
+ * Returns: %FALSE on error; %TRUE on success or end-of-file.
+ */
+gboolean
+bustle_pcap_reader_read_one (BustlePcapReader *self,
+ glong *sec,
+ glong *usec,
+ const guchar **blob,
+ guint *length,
+ GDBusMessage **message,
+ GError **error)
+{
+ struct pcap_pkthdr *hdr;
+ int ret;
+
+ g_return_val_if_fail (BUSTLE_IS_PCAP_READER (self), FALSE);
+ g_return_val_if_fail (sec != NULL, FALSE);
+ g_return_val_if_fail (usec != NULL, FALSE);
+ g_return_val_if_fail (blob != NULL, FALSE);
+ g_return_val_if_fail (length != NULL, FALSE);
+ g_return_val_if_fail (message == NULL || *message == NULL, FALSE);
+ g_return_val_if_fail (error == NULL || *error == NULL, FALSE);
+
+ if (self->pcap_in == NULL)
+ {
+ g_set_error (error, G_IO_ERROR, G_IO_ERROR_CLOSED, "Already closed");
+ return FALSE;
+ }
+
+ ret = pcap_next_ex (self->pcap_in, &hdr, blob);
+ switch (ret)
+ {
+ case 1:
+ if (message != NULL)
+ {
+ *message = g_dbus_message_new_from_blob ((guchar *) *blob, hdr->caplen, G_DBUS_CAPABILITY_FLAGS_UNIX_FD_PASSING, error);
+ if (*message == NULL)
+ {
+ g_prefix_error (error, "Error while parsing message from dbus-monitor: ");
+ return FALSE;
+ }
+ }
+
+ *sec = hdr->ts.tv_sec;
+ *usec = hdr->ts.tv_usec;
+ *length = hdr->caplen;
+ return TRUE;
+
+ case -2:
+ /* EOF */
+ *sec = 0;
+ *usec = 0;
+ *blob = NULL;
+ *length = 0;
+ if (message != NULL)
+ *message = NULL;
+ return TRUE;
+
+ default:
+ g_set_error (error, G_IO_ERROR, G_IO_ERROR_FAILED,
+ "Error %i reading dbus-monitor stream: %s",
+ ret, pcap_geterr (self->pcap_in));
+ return FALSE;
+ }
+}
+
+
+/**
+ * bustle_pcap_reader_close:
+ * @self: a #BustlePcapReader
+ *
+ * Closes the underlying file or stream.
+ *
+ * If @self is reading from a pipe to `dbus-monitor`, this will cause
+ * `dbus-monitor` to quit in due course when it next tries to write to the
+ * pipe.
+ */
+void
+bustle_pcap_reader_close (BustlePcapReader *self)
+{
+ g_return_if_fail (BUSTLE_IS_PCAP_READER (self));
+
+ g_clear_pointer (&self->pcap_in, pcap_close);
+ g_clear_pointer (&self->filep, fclose);
+}
+
+static gboolean
+initable_init (
+ GInitable *initable,
+ GCancellable *cancellable,
+ GError **error)
+{
+ BustlePcapReader *self = BUSTLE_PCAP_READER (initable);
+ char errbuf[PCAP_ERRBUF_SIZE] = {0};
+
+ g_return_val_if_fail ((self->filename == NULL) ^ (self->filep == NULL),
+ FALSE);
+
+ if (self->filename != NULL)
+ {
+ self->pcap_in = pcap_open_offline (self->filename, errbuf);
+ }
+ else /* self->filep != NULL */
+ {
+ self->pcap_in = pcap_fopen_offline (self->filep, errbuf);
+ }
+
+ if (self->pcap_in == NULL)
+ {
+ g_set_error_literal (error, G_IO_ERROR, G_IO_ERROR_FAILED, errbuf);
+ return FALSE;
+ }
+
+ /* Now owned by pcap_in */
+ self->filep = NULL;
+
+ int dlt = pcap_datalink (self->pcap_in);
+ if (dlt != DLT_DBUS)
+ {
+ g_set_error (error, G_IO_ERROR, G_IO_ERROR_NOT_SUPPORTED,
+ "Unexpected link type %s",
+ pcap_datalink_val_to_name (dlt));
+ bustle_pcap_reader_close (self);
+ return FALSE;
+ }
+
+ return TRUE;
+}
+
+static void
+initable_iface_init (
+ gpointer g_class,
+ gpointer unused)
+{
+ GInitableIface *iface = g_class;
+
+ iface->init = initable_init;
+}
+
+BustlePcapReader *
+bustle_pcap_reader_open (const gchar *filename,
+ GError **error)
+{
+ g_return_val_if_fail (filename != NULL, NULL);
+ g_return_val_if_fail (error == NULL || *error == NULL, NULL);
+
+ return g_initable_new (
+ BUSTLE_TYPE_PCAP_READER, NULL, error,
+ "filename", filename,
+ NULL);
+}
+
+/**
+ * bustle_pcap_reader_fopen:
+ * @filep: (transfer full):
+ *
+ * Returns: a reader, or %NULL on error
+ */
+BustlePcapReader *
+bustle_pcap_reader_fopen (FILE *filep,
+ GError **error)
+{
+ g_return_val_if_fail (filep != NULL, NULL);
+ g_return_val_if_fail (error == NULL || *error == NULL, NULL);
+
+ return g_initable_new (
+ BUSTLE_TYPE_PCAP_READER, NULL, error,
+ "filep", filep,
+ NULL);
+}
diff --git a/c-sources/pcap-reader.h b/c-sources/pcap-reader.h
new file mode 100644
index 0000000..7485427
--- /dev/null
+++ b/c-sources/pcap-reader.h
@@ -0,0 +1,43 @@
+/*
+ * pcap-reader.h - reads DBus messages from a pcap stream
+ * Copyright © 2011–2012 Collabora Ltd.
+ * Copyright © 2018–2020 Will Thompson
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+#pragma once
+
+#include <glib/gstdio.h>
+#include <glib-object.h>
+#include <gio/gio.h>
+#include <pcap/pcap.h>
+
+#define BUSTLE_TYPE_PCAP_READER bustle_pcap_reader_get_type ()
+G_DECLARE_FINAL_TYPE (BustlePcapReader, bustle_pcap_reader, BUSTLE, PCAP_READER, GObject)
+
+BustlePcapReader *bustle_pcap_reader_open (const gchar *filename,
+ GError **error);
+BustlePcapReader *bustle_pcap_reader_fopen (FILE *filep,
+ GError **error);
+gboolean bustle_pcap_reader_read_one (BustlePcapReader *self,
+ glong *sec,
+ glong *usec,
+ const guchar **blob,
+ guint *length,
+ GDBusMessage **message,
+ GError **error);
+void bustle_pcap_reader_close (BustlePcapReader *self);
+
diff --git a/flatpak/org.freedesktop.Bustle.yaml b/flatpak/org.freedesktop.Bustle.yaml
index e0eec12..ade7a30 100644
--- a/flatpak/org.freedesktop.Bustle.yaml
+++ b/flatpak/org.freedesktop.Bustle.yaml
@@ -86,13 +86,6 @@ modules:
- type: archive
url: https://www.tcpdump.org/release/libpcap-1.9.0.tar.gz
sha256: 2edb88808e5913fdaa8e9c1fcaf272e19b2485338742b5074b9fe44d68f37019
- - name: haskell-pcap
- sources:
- - type: archive
- url: https://hackage.haskell.org/package/pcap-0.4.5.2/pcap-0.4.5.2.tar.gz
- sha256: e7e92e6ff4bffa22102335a38dabb97fd0771fdf3b75d45cd7c1708c85e1cd5f
- - type: file
- path: Makefile
# gtk2hs dependencies begin here
- name: haskell-hashtables
@@ -134,44 +127,6 @@ modules:
- build-gtk # this is the gtk3 version
no-autogen: true
- # dbus dependencies begin here
- - name: haskell-xml-types
- sources:
- - type: archive
- url: https://hackage.haskell.org/package/xml-types-0.3.6/xml-types-0.3.6.tar.gz
- sha256: 9937d440072552c03c6d8ad79f61e61467dc28dcd5adeaad81038b9b94eef8c9
- - type: file
- path: Makefile
- no-autogen: true
- - name: haskell-libxml-sax
- sources:
- - type: archive
- url: https://hackage.haskell.org/package/libxml-sax-0.7.5/libxml-sax-0.7.5.tar.gz
- sha256: 99141784cc0d6c5749f0df618b2d46922391eede09f4f9ccfc36fb58a9c16d51
- - type: file
- path: Makefile
- no-autogen: true
- - name: haskell-cereal
- sources:
- - type: archive
- url: https://hackage.haskell.org/package/cereal-0.5.5.0/cereal-0.5.5.0.tar.gz
- sha256: 0b97320ffbfa6df2e5679022215dbd0fe6e3b5ae8428c2ff4310d9e1acf16822
- - type: file
- path: Makefile
- no-autogen: true
- # TODO: bump dependency to dbus 1.0.1, and revise licensing info: it's now
- # Apache-2, which is compatible with LGPL-3, rather than GPL-3. However, it
- # brings with it tens of new dependencies, at which point it is probably
- # worth generating this manifest.
- - name: haskell-dbus
- sources:
- - type: archive
- url: https://hackage.haskell.org/package/dbus-0.10.13/dbus-0.10.13.tar.gz
- sha256: aa94aefba8a0be240faddec88442afd8db1fa4e994423d474b112ec1c67e7aca
- - type: file
- path: Makefile
- no-autogen: true
-
# for the man page!
- name: help2man
sources: