bustle-0.8.0/Bustle/0000755000000000000000000000000013711017761012445 5ustar0000000000000000bustle-0.8.0/Bustle/Application/0000755000000000000000000000000013710515615014710 5ustar0000000000000000bustle-0.8.0/Bustle/Loader/0000755000000000000000000000000013710546303013651 5ustar0000000000000000bustle-0.8.0/Bustle/UI/0000755000000000000000000000000013711016460012755 5ustar0000000000000000bustle-0.8.0/Test/0000755000000000000000000000000013710546303012124 5ustar0000000000000000bustle-0.8.0/Test/data/0000755000000000000000000000000013710546303013035 5ustar0000000000000000bustle-0.8.0/c-sources/0000755000000000000000000000000013710546303013110 5ustar0000000000000000bustle-0.8.0/data/0000755000000000000000000000000013711020375012113 5ustar0000000000000000bustle-0.8.0/data/icons/0000755000000000000000000000000013710515615013233 5ustar0000000000000000bustle-0.8.0/data/icons/hicolor/0000755000000000000000000000000013710546274014677 5ustar0000000000000000bustle-0.8.0/data/icons/hicolor/scalable/0000755000000000000000000000000013710515615016440 5ustar0000000000000000bustle-0.8.0/data/icons/hicolor/scalable/apps/0000755000000000000000000000000013710546274017410 5ustar0000000000000000bustle-0.8.0/po/0000755000000000000000000000000013710515615011625 5ustar0000000000000000bustle-0.8.0/src-hgettext/0000755000000000000000000000000013710515615013630 5ustar0000000000000000bustle-0.8.0/src-hgettext/Bustle/0000755000000000000000000000000013710515615015066 5ustar0000000000000000bustle-0.8.0/src-no-hgettext/0000755000000000000000000000000013710515615014242 5ustar0000000000000000bustle-0.8.0/src-no-hgettext/Bustle/0000755000000000000000000000000013710515615015500 5ustar0000000000000000bustle-0.8.0/Test/DumpMessages.hs0000644000000000000000000000104413700421730015047 0ustar0000000000000000module Main where import System.Environment (getArgs) import Control.Monad (forM_) import Bustle.Loader.Pcap (readPcap) main = do args <- getArgs let file = case args of x:_ -> x _ -> error "gimme a filename" r <- readPcap file case r of Left e -> print e Right (warnings, messages) -> do forM_ warnings putStrLn putStrLn "" -- forM_ (zip [1..] messages) $ \(i, message) -> -- putStrLn $ show i ++ ": " ++ show message bustle-0.8.0/Bustle.hs0000644000000000000000000000363213710313246013001 0ustar0000000000000000{- Bustle: a tool to draw charts of D-Bus activity Copyright © 2008–2011 Collabora Ltd. 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 ScopedTypeVariables #-} module Main (main) where import System.IO (hPutStrLn, stderr) import System.Environment (getArgs) import System.Exit (exitFailure) import Control.Monad (when) import System.Glib.Utils (setApplicationName) import Bustle.Noninteractive import Bustle.Translation import Bustle.UI usage :: Bool -> IO () usage fatal = do hPutStrLn stderr "Usage:\n\ \ bustle [LOGFILE [...]]\n\ \ bustle --pair SESSION_LOGFILE SYSTEM_LOGFILE\n\ \\n\ \Or for batch-processing:\n\ \ bustle --count LOGFILE\n\ \ bustle --time LOGFILE\n\ \ bustle --dot LOGFILE" when fatal exitFailure runOne :: (String -> IO ()) -> [String] -> IO () runOne f [filename] = f filename runOne _ _ = usage True main :: IO () main = do initTranslation setApplicationName (__ "Bustle") args <- getArgs case args of ["--help"] -> usage False "--count":rest -> runOne runCount rest "--time":rest -> runOne runTime rest "--dot":rest -> runOne runDot rest _ -> uiMain -- vim: sw=2 sts=2 bustle-0.8.0/Bustle/Application/Monad.hs0000644000000000000000000000642713700421730016304 0ustar0000000000000000{- Bustle.Application.Monad: Implementation of the monad used for the UI Copyright © 2008–2010 Collabora Ltd. 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 GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-} module Bustle.Application.Monad ( -- ^ The Bustle monad Bustle , runB -- ^ Tunnelling goo , BustleEnv -- but not the internals , embedIO , makeCallback ) where import Control.Monad.Reader import Control.Monad.State import Data.IORef {- The goal is to have the standard Reader/State stack for immutable and - mutable application state, but also be able to reconstitute it inside GLib - callbacks (which are in IO). - - We implement this by storing both the configuration and the state in an - IORef, and provide functions to reconstitute the environment inside a - callback. Inspired by this excellent email, titled Monadic Tunnelling: - - - You're intended to write 'type B a = Bustle SomeConfig SomeState a' for - brevity. Then, within a 'B foo' action, if you want to connect to a GLib - signal, you say something like this: - - onDance :: Badger -> IO a -> IO () - dancedCB :: B a - - embedIO $ onDance x . makeCallback dancedCB -} newtype Bustle config state a = B (ReaderT (BustleEnv config state) IO a) deriving (Functor, Applicative, Monad, MonadIO) newtype BustleEnv config state = BustleEnv { unBustleEnv :: (config, IORef state) } readConfig :: MonadIO m => BustleEnv config state -> m config readConfig = return . fst . unBustleEnv readState :: MonadIO m => BustleEnv config state -> m state readState = liftIO . readIORef . snd . unBustleEnv putState :: MonadIO m => state -> BustleEnv config state -> m () putState new e = liftIO $ do let (_, r) = unBustleEnv e liftIO $ writeIORef r new instance MonadState state (Bustle config state) where get = B $ ask >>= readState put x = B $ ask >>= putState x instance MonadReader config (Bustle config state) where ask = B $ ask >>= readConfig local f (B act) = B $ local (mapBustleEnv (\(e, r) -> (f e, r))) act where mapBustleEnv g = BustleEnv . g . unBustleEnv embedIO :: (BustleEnv config state -> IO a) -> Bustle config state a embedIO act = B $ do r <- ask liftIO $ act r makeCallback :: Bustle config state a -> BustleEnv config state -> IO a makeCallback (B act) = runReaderT act runB :: config -> state -> Bustle config state a -> IO a runB config s (B act) = do r <- newIORef s runReaderT act $ BustleEnv (config, r) bustle-0.8.0/Bustle/Diagram.hs0000644000000000000000000004244413700421730014346 0ustar0000000000000000{- Bustle.Diagram: shapes for sequence diagrams Copyright (C) 2008–2009 Collabora Ltd. 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.Diagram ( Diagram -- Shapes, and smart constructors therefore , Shape(..) , memberLabel , timestampLabel , headers , headerHeight -- Attributes of shapes , Arrowhead(..) , Side(..) , Colour(..) , Rect -- Annoying constants that users of this module need. , columnWidth , timestampAndMemberWidth , firstColumnOffset , eventHeight -- Displaying diagrams , diagramDimensions , topLeftJustifyDiagram , translateDiagram , drawDiagram , drawRegion ) where import Data.List (unzip4) import Data.List.NonEmpty (NonEmpty(..), toList) import Control.Arrow ((&&&)) import Control.Monad.Reader import Graphics.Rendering.Cairo (Operator(..), Render, arc, curveTo, fill, getCurrentPoint, lineTo, moveTo, newPath, paint, rectangle, restore, save, setDash, setLineWidth, setOperator, setSourceRGB, stroke) import Graphics.UI.Gtk.Cairo (cairoCreateContext, showLayout) import Graphics.Rendering.Pango.Layout import Graphics.Rendering.Pango.Font import qualified Bustle.Marquee as Marquee import Bustle.Marquee (Marquee) import Bustle.Types (ObjectPath, InterfaceName, MemberName) -- Sorry Mum import System.IO.Unsafe (unsafePerformIO) type Point = (Double, Double) type Rect = (Double, Double, Double, Double) data Arrowhead = Above | Below deriving (Eq, Show, Read, Ord) above, below :: Arrowhead -> Bool above Above = True above Below = False below = not . above voffset :: Num a => Arrowhead -> (a -> a -> a) voffset Above = (-) voffset Below = (+) data Side = L | R deriving (Eq, Show, Read, Ord) offset :: Num a => Side -> (a -> a -> a) offset L = (-) offset R = (+) data Colour = Colour Double Double Double deriving (Eq, Show, Read, Ord) data Shape = Header { strs :: [String] , shapex, shapey :: Double } | MemberLabel { labelPath :: ObjectPath , labelInterface :: Maybe InterfaceName , labelMember :: MemberName , shapeIsReturn :: Bool , shapex :: Double -- The coordinates of the *centre* , shapey :: Double -- of the label } | TimestampLabel { str :: String , shapex :: Double -- The coordinates of the , shapey :: Double -- *centre* of the timestamp } | ClientLines { shapexs :: NonEmpty Double -- The x-coordinates of the lines to draw , shapey1, shapey2 :: Double } | Rule { shapex1, shapex2, shapey :: Double } | Arrow { shapecolour :: Maybe Colour , arrowhead :: Arrowhead , shapex1, shapex2, shapey :: Double } | SignalArrow { shapex1, epicentre, shapex2, shapey :: Double } | DirectedSignalArrow { epicentre, shapex, shapey :: Double } | Arc { topx, topy, bottomx, bottomy :: Double , arcside :: Side , caption :: String } | Highlight { highlightRegion :: Rect } deriving (Show, Eq) -- Smart constructors for TimestampLabel and MemberLabel that fill in the -- hardcoded (spit) x coordinates. memberLabel :: ObjectPath -> Maybe InterfaceName -> MemberName -> Bool -- ^ True if this is a return; False if it's a call -> Double -- ^ y-coordinate -> Shape memberLabel p i m isReturn = MemberLabel p i m isReturn memberx timestampLabel :: String -> Double -> Shape timestampLabel s = TimestampLabel s timestampx type Diagram = [Shape] arcControlPoints :: Shape -> (Point, Point) arcControlPoints Arc { topx=x1, topy=y1, bottomx=x2, bottomy=y2, arcside=s } = let (+-) = offset s cp1 = (x1 +- 60, y1 + 10) cp2 = (x2 +- 60, y2 - 10) in (cp1, cp2) arcControlPoints _ = error "i see you've played arcy-shapey before" mapX, mapY :: (Double -> Double) -> (Shape -> Shape) mapX f s = case s of Rule {} -> s { shapex1 = f (shapex1 s) , shapex2 = f (shapex2 s) } Arrow {} -> s { shapex1 = f (shapex1 s) , shapex2 = f (shapex2 s) } SignalArrow {} -> s { shapex1 = f (shapex1 s) , epicentre = f (epicentre s) , shapex2 = f (shapex2 s) } Arc {} -> s { topx = f (topx s) , bottomx = f (bottomx s) } ClientLines {} -> s { shapexs = f <$> shapexs s } _ -> s { shapex = f (shapex s) } mapY f s = case s of Arc {} -> s { topy = f (topy s) , bottomy = f (bottomy s) } ClientLines {} -> s { shapey1 = f (shapey1 s) , shapey2 = f (shapey2 s) } _ -> s { shapey = f (shapey s) } -- -- Constants -- eventHeight :: Double eventHeight = 30 timestampx, timestampWidth :: Double timestampx = 0 + timestampWidth / 2 timestampWidth = 60 memberx, memberWidth :: Double memberx = timestampWidth + memberWidth / 2 memberWidth = 340 timestampAndMemberWidth :: Double timestampAndMemberWidth = timestampWidth + memberWidth columnWidth :: Double columnWidth = 90 -- Method return arcs can go outside the first column. Empirically, 20 is -- enough to stop the arc (or the duration text) overlapping the object path -- etc. firstColumnOffset :: Double firstColumnOffset = 20 + columnWidth / 2 -- -- Calculating bounds of shapes -- minMax :: Ord a => (a, a) -> (a, a) minMax = uncurry min &&& uncurry max xMinMax :: Shape -> (Double, Double) xMinMax = minMax . (shapex1 &&& shapex2) fromCentre :: Double -> Double -> Double -> Rect fromCentre x y width = (x - width / 2, y - height / 2, x + width / 2, y + height / 2) where height = eventHeight headerHeight :: [String] -> Double headerHeight = fromIntegral . (10 *) . length bounds :: Shape -> Rect bounds s = case s of ClientLines {} -> let xs = toList (shapexs s) in (minimum xs, shapey1 s, maximum xs, shapey2 s) Rule {} -> (shapex1 s, shapey s, shapex2 s, shapey s) Arrow {} -> let (x1, x2) = xMinMax s y1 = shapey s - (if above (arrowhead s) then 5 else 0) y2 = shapey s + (if below (arrowhead s) then 5 else 0) in (x1, y1, x2, y2) SignalArrow {} -> let (x1, x2) = xMinMax s (y1, y2) = subtract 5 &&& (+5) $ shapey s in (x1, y1, x2, y2) DirectedSignalArrow {} -> let (x1, x2) = minMax (epicentre s, shapex s) (y1, y2) = subtract 5 &&& (+5) $ shapey s in (x1, y1, x2, y2) Arc { topx=x1, bottomx=x2, topy=y1, bottomy=y2 } -> let ((cx, _), (dx, _)) = arcControlPoints s -- FIXME: magic 5 makes the bounding box include the text in (min x1 cx, y1, max x2 dx, y2 + 5) TimestampLabel { shapex=x, shapey=y } -> fromCentre x y timestampWidth MemberLabel { shapex=x, shapey=y } -> fromCentre x y memberWidth Header { strs = ss, shapex = x, shapey = y} -> let width = columnWidth height = headerHeight ss in (x - width / 2, y, x + width / 2, y + height) Highlight r -> r intersects :: Rect -> Rect -> Bool intersects (x,y,w,z) (x', y', w', z') = not $ or [x > w', w < x', y > z', z < y'] -- Constructs a series of headers of various-sized lists of names, -- bottom-justified. headers :: [(Double, [String])] -- list of (x-coordinate, names) -> Double -- y-coordinate of top of headers -> (Double, [Shape]) -- the headers' combined height, and shapes headers [] _ = (0, []) headers xss y = (height, shapes) where heights = map (headerHeight . snd) xss height = maximum heights adjs = map (height -) heights shapes = zipWith (\(x, ss) adj -> Header ss x (y + adj)) xss adjs -- -- Drawing -- diagramBounds :: Diagram -> ((Double, Double), (Double, Double)) diagramBounds shapes = ((minimum (0:x1s) - padding, minimum (0:y1s) - padding) ,(maximum (0:x2s) + padding, maximum (0:y2s) + padding) ) where (x1s, y1s, x2s, y2s) = unzip4 $ map bounds shapes padding = 6 diagramDimensions :: Diagram -> (Double, Double) diagramDimensions shapes = (x2 - x1, y2 - y1) where ((x1, y1), (x2, y2)) = diagramBounds shapes topLeftJustifyDiagram :: Diagram -- ^ the original diagram -> ((Double, Double), Diagram) -- ^ the diagram transformed to be in -- positive space, and the (x, y)-axis -- shifts necessary to do so topLeftJustifyDiagram shapes = (translation, shapes') where ((x1, y1), _) = diagramBounds shapes translation = (negate x1, negate y1) shapes' = translateDiagram translation shapes translateDiagram :: (Double, Double) -> (Diagram -> Diagram) translateDiagram (x, y) = map (mapX (+ x) . mapY (+ y)) drawDiagramInternal :: (Shape -> Bool) -- ^ A filter for the shapes -> Bool -- ^ True to draw canvas items' bounding boxes -- (for debugging) -> Diagram -- ^ A diagram to render -> Render () drawDiagramInternal f drawBounds shapes = do clearCanvas forM_ (filter f shapes) $ \x -> do when drawBounds (drawBoundingBox x) draw x drawDiagram :: Bool -- ^ True to draw canvas items' bounding boxes (for -- debugging) -> Diagram -- ^ A diagram to render -> Render () drawDiagram = drawDiagramInternal (const True) drawRegion :: Rect -> Bool -> Diagram -> Render () drawRegion r = drawDiagramInternal isVisible where isVisible = intersects r . bounds saved :: Render () -> Render () saved act = save >> act >> restore clearCanvas :: Render () clearCanvas = saved $ do setSourceRGB 1 1 1 setOperator OperatorSource paint drawBoundingBox :: Shape -> Render () drawBoundingBox s = saved $ do let (x,y,w,z) = bounds s setSourceRGB 0 0 1 rectangle x y (w - x) (z - y) stroke draw :: Shape -> Render () draw s = draw' s where draw' = case s of Arc {} -> let ((cx, cy), (dx, dy)) = arcControlPoints s in drawArc cx cy dx dy <$> topx <*> topy <*> bottomx <*> bottomy <*> caption SignalArrow {} -> drawSignalArrow <$> epicentre <*> (Just . shapex1) <*> (Just . shapex2) <*> shapey DirectedSignalArrow { } -> drawDirectedSignalArrow <$> epicentre <*> shapex <*> shapey Arrow {} -> drawArrow <$> shapecolour <*> arrowhead <*> shapex1 <*> shapex2 <*> shapey Header {} -> drawHeader <$> strs <*> shapex <*> shapey MemberLabel {} -> drawMember <$> labelPath <*> labelInterface <*> labelMember <*> shapeIsReturn <*> shapex <*> shapey TimestampLabel {} -> drawTimestamp <$> str <*> shapex <*> shapey ClientLines {} -> drawClientLines <$> shapexs <*> shapey1 <*> shapey2 Rule {} -> drawRule <$> shapex1 <*> shapex2 <*> shapey Highlight {} -> drawHighlight <$> highlightRegion halfArrowHead :: Arrowhead -> Bool -> Render () halfArrowHead a left = do (x,y) <- getCurrentPoint let x' = if left then x - 10 else x + 10 let y' = voffset a y 5 if left -- work around weird artifacts then moveTo x' y' >> lineTo x y else lineTo x' y' >> moveTo x y arrowHead :: Bool -> Render () arrowHead left = halfArrowHead Above left >> halfArrowHead Below left drawArrow :: Maybe Colour -> Arrowhead -> Double -> Double -> Double -> Render () drawArrow c a from to y = saved $ do maybe (return ()) (\(Colour r g b) -> setSourceRGB r g b) c moveTo from y lineTo to y halfArrowHead a (from < to) stroke drawDirectedSignalArrow :: Double -- ^ the signal emission source -> Double -- ^ signal target coordinate -> Double -- ^ vertical coordinate -> Render () drawDirectedSignalArrow e x y | x < e = drawSignalArrow e (Just x) Nothing y | otherwise = drawSignalArrow e Nothing (Just x) y drawSignalArrow :: Double -- ^ the signal emission source -> Maybe Double -- ^ left-pointing arrow coordinate -> Maybe Double -- ^ right-pointing arrow coordinate -> Double -- ^ vertical coordinate -> Render () drawSignalArrow e mleft mright y = do newPath arc e y 5 0 (2 * pi) stroke forM_ mleft $ \left -> do moveTo left y arrowHead False lineTo (e - 5) y stroke forM_ mright $ \right -> do moveTo (e + 5) y lineTo right y arrowHead True stroke drawArc :: Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> String -> Render () drawArc cx cy dx dy x1 y1 x2 y2 cap = saved $ do setSourceRGB 0.4 0.7 0.4 setDash [3, 3] 0 moveTo x1 y1 curveTo cx cy dx dy x2 y2 stroke setSourceRGB 0 0 0 l <- mkLayout (Marquee.escape cap) EllipsizeNone AlignLeft (PangoRectangle _ _ textWidth _, _) <- liftIO $ layoutGetExtents l let tx = min x2 dx + abs (x2 - dx) / 2 moveTo (if x1 > cx then tx - textWidth else tx) (y2 - 5) showLayout l font :: FontDescription font = unsafePerformIO $ do fd <- fontDescriptionNew fontDescriptionSetSize fd 7 fontDescriptionSetFamily fd "Sans" return fd {-# NOINLINE font #-} mkLayout :: (MonadIO m) => Marquee -> EllipsizeMode -> LayoutAlignment -> m PangoLayout mkLayout s e a = liftIO $ do ctx <- cairoCreateContext Nothing layout <- layoutEmpty ctx -- layoutSetMarkup returns the un-marked-up text. We don't care about it, -- but recent versions of Pango give it the type -- GlibString string => ... -> IO string -- which we need to disambiguate between Text and String. Old versions were -- .. -> IO String -- so go with that. layoutSetMarkup layout (Marquee.toPangoMarkup s) :: IO String layoutSetFontDescription layout (Just font) layoutSetEllipsize layout e layoutSetAlignment layout a return layout withWidth :: MonadIO m => m PangoLayout -> Double -> m PangoLayout withWidth m w = do l <- m liftIO $ layoutSetWidth l (Just w) return l drawHeader :: [String] -> Double -> Double -> Render () drawHeader names x y = forM_ (zip [0..] names) $ \(i, name) -> do l <- mkLayout (Marquee.escape name) EllipsizeEnd AlignCenter `withWidth` columnWidth moveTo (x - (columnWidth / 2)) (y + i * h) showLayout l where h = 10 drawMember :: ObjectPath -> Maybe InterfaceName -> MemberName -> Bool -> Double -> Double -> Render () drawMember p i m isReturn x y = do drawOne path (y - 10) drawOne fullMethod y where drawOne markup y' = do l <- mkLayout markup EllipsizeStart AlignLeft `withWidth` memberWidth moveTo (x - memberWidth / 2) y' showLayout l path = (if isReturn then id else Marquee.b) $ Marquee.escape p fullMethod = (if isReturn then Marquee.i else id) $ Marquee.formatMember i m drawTimestamp :: String -> Double -> Double -> Render () drawTimestamp ts x y = do moveTo (x - timestampWidth / 2) (y - 10) showLayout =<< mkLayout (Marquee.escape ts) EllipsizeNone AlignLeft `withWidth` timestampWidth drawClientLines :: NonEmpty Double -> Double -> Double -> Render () drawClientLines xs y1 y2 = saved $ do setSourceRGB 0.7 0.7 0.7 forM_ (toList xs) $ \x -> do moveTo x y1 lineTo x y2 stroke drawRule :: Double -> Double -> Double -> Render () drawRule x1 x2 y = saved $ do setSourceRGB 0.9 0.9 0.9 setLineWidth 0.5 moveTo x1 y lineTo x2 y stroke drawHighlight :: Rect -> Render () drawHighlight (x1, y1, x2, y2) = saved $ do setSourceRGB 0.8 0.9 1.0 rectangle x1 y1 (x2 - x1) (y2 - y1) fill -- vim: sw=2 sts=2 bustle-0.8.0/Bustle/GDBusMessage.hs0000644000000000000000000002076313710546303015260 0ustar0000000000000000{- 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 bustle-0.8.0/Bustle/GVariant.hs0000644000000000000000000000730513710546303014517 0ustar0000000000000000{- 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 bustle-0.8.0/Bustle/Loader.hs0000644000000000000000000000420513700421730014201 0ustar0000000000000000{- Bustle.Loader: loads logs using one of the two sub-loaders Copyright © 2011–2012 Collabora Ltd. 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.Loader ( readLog , LoadError(..) -- * This function bothers me, but it's used by the live recorder for now... , isRelevant ) where import Control.Monad.Except import Control.Arrow (second) import qualified Bustle.Loader.Pcap as Pcap import Bustle.Types import Bustle.Util (io) data LoadError = LoadError FilePath String -- this nested case stuff is ugly, but it's less ugly than it looked with -- combinators to turn IO (Either a b) into ErrorT LoadError IO b using various -- a -> LoadError functions. readLog :: MonadIO io => FilePath -> ExceptT LoadError io ([String], Log) readLog f = do pcapResult <- io $ Pcap.readPcap f case pcapResult of Right ms -> return $ second (filter (isRelevant . deEvent)) ms Left ioe -> throwError $ LoadError f (show ioe) isRelevant :: Event -> Bool isRelevant (NOCEvent _) = True isRelevant (MessageEvent m) = case m of Signal {} -> not senderIsBus MethodCall {} -> none3 MethodReturn {} -> none3 Error {} -> none3 where -- FIXME: really? Maybe we should allow people to be interested in, -- say, binding to signals? senderIsBus = sender m == busDriver destIsBus = destination m == busDriver busDriver = O (OtherName dbusName) none bs = not $ or bs none3 = none [senderIsBus, destIsBus] bustle-0.8.0/Bustle/Loader/Pcap.hs0000644000000000000000000002246613710546303015102 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-} {- Bustle.Loader.Pcap: loads logs out of pcap files Copyright © 2011–2012 Collabora Ltd. Copyright © 2017–2018 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 PatternGuards, FlexibleContexts #-} module Bustle.Loader.Pcap ( readPcap , convert ) where import Data.Maybe (fromMaybe) import Data.Either (partitionEithers) import qualified Data.Map as Map import Data.Map (Map) import Control.Exception (try) import Control.Monad.State import Control.Monad.Trans.Maybe 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. stupifyBusName :: BusName -> B.TaggedBusName stupifyBusName n | isUnique n = B.U $ B.UniqueName n | otherwise = B.O $ B.OtherName n isUnique :: BusName -> Bool isUnique n = head (formatBusName n) == ':' convertBusName :: String -> Maybe BusName -> B.TaggedBusName convertBusName fallback n = stupifyBusName (fromMaybe fallback_ n) where fallback_ = busName_ fallback 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) (B.Detailed B.Message) popMatchingCall :: (MonadState PendingMessages m) => Maybe BusName -> Serial -> m (Maybe (B.Detailed B.Message)) popMatchingCall name serial = do ret <- tryPop (name, serial) case (ret, name) of -- If we don't get an answer, but we know a destination, this may be -- because we didn't know the sender's bus name because it was the -- logger itself. So try looking up pending replies whose sender is -- Nothing. (Nothing, Just _) -> tryPop (Nothing, serial) _ -> return ret where tryPop key = do call <- gets $ Map.lookup key modify $ Map.delete key return call insertPending :: MonadState PendingMessages m => Maybe BusName -> Serial -> B.Detailed B.Message -> m () 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 asBusName "" = Nothing asBusName name = Just $ busName_ name bustlifyNOC :: (BusName, Maybe BusName, Maybe BusName) -> B.NOC bustlifyNOC ns@(name, oldOwner, newOwner) | isUnique name = case (oldOwner, newOwner) of (Nothing, Just _) -> B.Connected (uniquify name) (Just _, Nothing) -> B.Disconnected (uniquify name) _ -> error $ "wtf: NOC" ++ show ns | otherwise = B.NameChanged (otherify name) $ case (oldOwner, newOwner) of (Just old, Nothing) -> B.Released (uniquify old) (Just old, Just new) -> B.Stolen (uniquify old) (uniquify new) (Nothing, Just new) -> B.Claimed (uniquify new) (Nothing, Nothing) -> error $ "wtf: NOC" ++ show ns where uniquify = B.UniqueName otherify = B.OtherName 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. 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 , Just $ busName_ owner ) bustlify :: (MonadIO m, MonadState PendingMessages m) => B.Microseconds -> Int -> GDBusMessage -> m B.DetailedEvent bustlify µs bytes m = do 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. 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 = serial , B.sender = wrappedSender , B.destination = convertBusName "method.call.destination" destination , B.member = member } insertPending sender serial (detailed call) return $ B.MessageEvent call 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 = call , B.sender = wrappedSender , B.destination = convertBusName "method.return.destination" destination } MessageTypeError -> do call <- popMatchingCall destination replySerial return $ B.MessageEvent $ B.Error { B.inReplyTo = call , B.sender = wrappedSender , B.destination = convertBusName "method.error.destination" destination } 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 :: (MonadIO m, MonadState PendingMessages m) => B.Microseconds -> Int -> GDBusMessage -> m (Either String B.DetailedEvent) convert µs bytes message = Right <$> bustlify µs bytes message readOne :: (MonadState s m, MonadIO m) => Reader -> (B.Microseconds -> Int -> GDBusMessage -> m (Either e a)) -> m (Maybe (Either e a)) readOne p f = do 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) => Reader -> (B.Microseconds -> Int -> GDBusMessage -> m (Either e a)) -> m [Either e a] mapBodies p f = do ret <- readOne p f case ret of Nothing -> return [] Just x -> do xs <- mapBodies p f return $ x:xs readPcap :: MonadIO m => FilePath -> m (Either GError ([String], [B.DetailedEvent])) readPcap path = liftIO $ try $ do p <- readerOpen path partitionEithers <$> evalStateT (mapBodies p convert) Map.empty bustle-0.8.0/Bustle/Marquee.hs0000644000000000000000000000636313700421730014401 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {- Bustle.Marquee: My First Type-Safe Markup Library With A Cutesy Name To Not Collide With Pango's 'Markup' Which Is A Synonym For String 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.Marquee ( Marquee , toPangoMarkup , tag , b , i , small , light , red , a , escape , formatMember , toString ) where import Data.Text (Text) import qualified Data.Text as T import Graphics.Rendering.Pango.BasicTypes (Weight(..)) import Graphics.Rendering.Pango.Layout (escapeMarkup) import Graphics.Rendering.Pango.Markup (markSpan, SpanAttribute(..)) import Bustle.Types (ObjectPath, formatObjectPath, InterfaceName, formatInterfaceName, MemberName, formatMemberName) newtype Marquee = Marquee { unMarquee :: String } deriving (Show, Read, Ord, Eq) toPangoMarkup :: Marquee -> String toPangoMarkup = unMarquee instance Semigroup Marquee where Marquee x <> Marquee y = Marquee (x <> y) instance Monoid Marquee where mempty = Marquee "" mconcat = Marquee . mconcat . map unMarquee tag :: String -> Marquee -> Marquee tag name contents = Marquee $ concat [ "<", name, ">" , unMarquee contents , "" ] b, i, small :: Marquee -> Marquee b = tag "b" i = tag "i" small = tag "small" a :: String -> String -> Marquee a href contents = Marquee $ concat [ "" , escapeMarkup contents , "" ] span_ :: [SpanAttribute] -> Marquee -> Marquee span_ attrs = Marquee . markSpan attrs . unMarquee light :: Marquee -> Marquee light = span_ [FontWeight WeightLight] red :: Marquee -> Marquee red = span_ [FontForeground "#ff0000"] -- Kind of a transitional measure because some strings are Strings, and some are Text. class Unescaped s where toString :: s -> String instance Unescaped String where toString = id instance Unescaped Text where toString = T.unpack instance Unescaped InterfaceName where toString = formatInterfaceName instance Unescaped ObjectPath where toString = formatObjectPath instance Unescaped MemberName where toString = formatMemberName escape :: Unescaped s => s -> Marquee escape = Marquee . escapeMarkup . toString formatMember :: Maybe InterfaceName -> MemberName -> Marquee formatMember iface member = iface' `mappend` b (escape member) where iface' = case iface of Just ifaceName -> escape ifaceName `mappend` Marquee "." Nothing -> light (escape "(no interface) ") bustle-0.8.0/Bustle/Missing.hs0000644000000000000000000000235513700421730014410 0ustar0000000000000000{- Bustle.Missing: missing GLib bindings Copyright © 2018 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.Missing ( formatSize ) where import Foreign.C import System.IO.Unsafe (unsafePerformIO) import System.Glib.UTFString foreign import ccall "g_format_size" g_format_size :: CULLong -> IO CString formatSize :: Int -- (could be Word64 but D-Bus' max message size is 2 ** 27) -> String formatSize size = unsafePerformIO $ do ret <- g_format_size (fromIntegral size) readUTFString ret bustle-0.8.0/Bustle/Monitor.hs0000644000000000000000000001021213711017761014424 0ustar0000000000000000{- Bustle.Monitor: Haskell binding for pcap-monitor.c Copyright © 2012 Collabora Ltd. Copyright © 2018 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.Monitor ( -- * Types Monitor , BusType(..) -- * Methods , monitorNew , monitorStop -- * Signals , monitorMessageLogged , monitorStopped ) where import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C import qualified Data.ByteString as BS import System.Glib.GObject import System.Glib.GError import System.Glib.Signals import Bustle.GDBusMessage import Bustle.Types (Microseconds) -- Gtk2HS boilerplate newtype Monitor = Monitor { unMonitor :: ForeignPtr Monitor } deriving (Eq, Ord) mkMonitor :: (ForeignPtr Monitor -> Monitor, FinalizerPtr a) mkMonitor = (Monitor, objectUnref) instance GObjectClass Monitor where toGObject = GObject . castForeignPtr . unMonitor unsafeCastGObject = Monitor . castForeignPtr . unGObject -- Foreign imports foreign import ccall "bustle_pcap_monitor_new" bustle_pcap_monitor_new :: CInt -> CString -> CString -> Ptr (Ptr ()) -> IO (Ptr Monitor) foreign import ccall "bustle_pcap_monitor_stop" bustle_pcap_monitor_stop :: Ptr Monitor -> IO () -- Bindings for said imports data BusType = BusTypeNone | BusTypeSystem | BusTypeSession deriving Enum -- Throws a GError if the file can't be opened, we can't get on the bus, or whatever. monitorNew :: Either BusType String -> FilePath -> IO Monitor monitorNew target filename = wrapNewGObject mkMonitor $ propagateGError $ \gerrorPtr -> withAddress $ \c_address -> withCString filename $ \c_filename -> bustle_pcap_monitor_new c_busType c_address c_filename gerrorPtr where c_busType = fromIntegral . fromEnum $ case target of Left busType -> busType Right _ -> BusTypeNone withAddress f = case target of Left _ -> f nullPtr Right address -> withCString address f monitorStop :: Monitor -> IO () monitorStop monitor = withForeignPtr (unMonitor monitor) bustle_pcap_monitor_stop messageLoggedHandler :: (Microseconds -> Int -> GDBusMessage -> IO ()) -> a -> CLong -> CLong -> Ptr CChar -> CUInt -> Ptr GDBusMessage -> IO () messageLoggedHandler user _obj sec usec _blob blobLength messagePtr = do let µsec = fromIntegral sec * (10 ^ (6 :: Int)) + fromIntegral usec message <- makeNewGDBusMessage (return messagePtr) failOnGError $ user µsec (fromIntegral blobLength) message monitorMessageLogged :: Signal Monitor (Microseconds -> Int -> GDBusMessage -> IO ()) monitorMessageLogged = Signal $ \after_ obj user -> connectGeneric "message-logged" after_ obj $ messageLoggedHandler user stoppedHandler :: (Quark -> Int -> String -> IO ()) -> a -> CUInt -> CInt -> Ptr CChar -> IO () stoppedHandler user _obj domain code messagePtr = do message <- peekCString messagePtr failOnGError $ user domain (fromIntegral code) message monitorStopped :: Signal Monitor (Quark -> Int -> String -> IO ()) monitorStopped = Signal $ \after_ obj user -> connectGeneric "stopped" after_ obj $ stoppedHandler user bustle-0.8.0/Bustle/Noninteractive.hs0000644000000000000000000000542113700421730015764 0ustar0000000000000000{- Bustle.Noninteractive: driver for ASCII-art statistics generation Copyright © 2008–2012 Collabora Ltd. 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.Noninteractive ( runCount , runTime , runDot ) where import Prelude hiding (log) import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) import Data.Maybe (mapMaybe) import Data.List (nub) import Control.Monad.Except import Text.Printf import Bustle.Loader import Bustle.Translation (__) import Bustle.Types import Bustle.Stats warn :: String -> IO () warn = hPutStrLn stderr process :: FilePath -> (Log -> [a]) -> (a -> String) -> IO () process filepath analyze format = do ret <- runExceptT $ readLog filepath case ret of Left (LoadError _ err) -> do warn $ printf (__ "Couldn't parse '%s': %s") filepath err exitFailure Right (warnings, log) -> do mapM_ warn warnings mapM_ (putStrLn . format) $ analyze log formatInterface :: Maybe InterfaceName -> String formatInterface = maybe (__ "(no interface)") formatInterfaceName runCount :: FilePath -> IO () runCount filepath = process filepath frequencies format where format :: FrequencyInfo -> String format (FrequencyInfo c t i m) = printf " %4d %6s %s.%s" c (typeName t) (formatInterface i) (formatMemberName m) typeName TallyMethod = "method" typeName TallySignal = "signal" runTime :: FilePath -> IO () runTime filepath = process filepath methodTimes format where format :: TimeInfo -> String format (TimeInfo interface method total ncalls mean) = printf " %9.4f %3d %9.4f %s.%s" total ncalls mean (formatInterface interface) (formatMemberName method) runDot :: FilePath -> IO () runDot filepath = process filepath makeDigraph id where makeDigraph log = ["digraph bustle {"] ++ makeDigraph' log ++ ["}"] makeDigraph' log = [ concat [" \"", unBusName s, "\" -> \"", unBusName d, "\";"] | (s, d) <- nub . mapMaybe (methodCall . deEvent) $ log ] methodCall (MessageEvent MethodCall {sender = s, destination = d}) = Just (s, d) methodCall _ = Nothing bustle-0.8.0/Bustle/Reader.hs0000644000000000000000000000734013710546303014205 0ustar0000000000000000{- 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 bustle-0.8.0/Bustle/Regions.hs0000644000000000000000000001637413700421730014413 0ustar0000000000000000{- Bustle.Regions: tracks a series of selectable horizontal stripes Copyright © 2011–2012 Collabora Ltd. 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 DeriveFunctor #-} module Bustle.Regions ( Stripe(..) , nonOverlapping , midpoint , Regions , translateRegions , RegionSelection (..) , regionSelectionNew , regionSelectionAppend , regionSelectionFlatten , regionSelectionUpdate , regionSelectionSelect , regionSelectionUp , regionSelectionDown , regionSelectionFirst , regionSelectionLast ) where import Data.Maybe (maybeToList) import Data.List (sort) data Stripe = Stripe { stripeTop :: Double , stripeBottom :: Double } deriving (Show, Eq, Ord) type Region a = (Stripe, a) type Regions a = [Region a] translateRegions :: Double -> Regions a -> Regions a translateRegions y = map (\(s, a) -> (translate s, a)) where translate (Stripe y1 y2) = Stripe (y1 + y) (y2 + y) -- A zipper for selected regions. rsBefore is reversed. If rsCurrent is -- Nothing, the two lists may still both be non-empty (to keep track of roughly -- where the user's last click was). data RegionSelection a = RegionSelection { rsBefore :: Regions a , rsLastClick :: Double , rsCurrent :: Maybe (Region a) , rsAfter :: Regions a } deriving (Show, Eq, Functor) relativeTo :: Double -> Stripe -> Ordering relativeTo y (Stripe top bottom) | y < top = LT | y > bottom = GT | otherwise = EQ hits :: Double -> Stripe -> Bool hits y stripe = y `relativeTo` stripe == EQ nonOverlapping :: [Stripe] -> Bool nonOverlapping [] = True nonOverlapping [_] = True nonOverlapping (s1:s2:ss) = stripeBottom s1 <= stripeTop s2 && nonOverlapping (s2:ss) regionSelectionNew :: Regions a -> RegionSelection a regionSelectionNew rs | sorted /= map fst rs = error "regionSelectionNew: unsorted regions" | not (nonOverlapping sorted) = error "regionSelectionNew: overlapping regions" | otherwise = RegionSelection [] 0 Nothing rs where sorted = sort (map fst rs) regionSelectionFlatten :: RegionSelection a -> Regions a regionSelectionFlatten rs = reverse (rsBefore rs) ++ maybeToList (rsCurrent rs) ++ rsAfter rs regionSelectionAppend :: Regions a -> RegionSelection a -> RegionSelection a regionSelectionAppend [] old = old regionSelectionAppend regions@((newFirst, _):_) old = case rsCurrent (regionSelectionLast old) of Nothing -> new Just (oldLast, _) -> if oldLast < newFirst && nonOverlapping [oldLast, newFirst] then old { rsAfter = rsAfter old ++ rsAfter new } else error "regionSelectionAppend: new regions overlap old regions" where new = regionSelectionNew regions regionSelectionUpdate :: Double -> RegionSelection a -> RegionSelection a regionSelectionUpdate y rs = rs' { rsLastClick = y } where rs' = case rsCurrent rs of Just r@(s, _) | y `hits` s -> rs | otherwise -> doSearch (rsBefore rs) (r:rsAfter rs) Nothing -> doSearch (rsBefore rs) (rsAfter rs) doSearch bs as = if y <= rsLastClick rs then let (as', result, bs') = searchy y (\y' s -> y' <= stripeBottom s) as bs in rs { rsBefore = bs' , rsCurrent = result , rsAfter = as' } else let (bs', result, as') = searchy y (\y' s -> y' >= stripeTop s) bs as in rs { rsBefore = bs' , rsCurrent = result , rsAfter = as' } invert :: RegionSelection a -> RegionSelection a invert rs = rs { rsBefore = rsAfter rs, rsAfter = rsBefore rs } midpoint :: Stripe -> Double midpoint (Stripe top bottom) = (top + bottom) / 2 regionSelectionUp :: RegionSelection a -> RegionSelection a regionSelectionUp rs@(RegionSelection before _lastClick current after) = case before of [] -> rs (b:bs) -> RegionSelection bs (midpoint (fst b)) (Just b) (maybeToList current ++ after) regionSelectionDown :: RegionSelection a -> RegionSelection a regionSelectionDown = invert . regionSelectionUp . invert regionSelectionFirst :: RegionSelection a -> RegionSelection a regionSelectionFirst rs = case reverse (rsBefore rs) ++ maybeToList (rsCurrent rs) ++ rsAfter rs of [] -> rs (first:others) -> RegionSelection [] (midpoint (fst first)) (Just first) others regionSelectionLast :: RegionSelection a -> RegionSelection a regionSelectionLast = invert . regionSelectionFirst . invert searchy :: Double -> (Double -> Stripe -> Bool) -> Regions a -> Regions a -> (Regions a, Maybe (Region a), Regions a) searchy y worthContinuing = go where go befores [] = (befores, Nothing, []) go befores afters@(a:as) | y `hits` fst a = (befores, Just a, as) | worthContinuing y (fst a) = go (a:befores) as | otherwise = (befores, Nothing, afters) regionSelectionSelect :: Eq a => a -> RegionSelection a -> RegionSelection a regionSelectionSelect x rs | fmap snd (rsCurrent rs) == Just x = rs | otherwise = case break ((== x) . snd) (rsBefore rs) of (ys, z:zs) -> RegionSelection { rsBefore = zs , rsCurrent = Just z , rsLastClick = midpoint (fst z) , rsAfter = reverse ys ++ rsAfter rs } (_, []) -> case break ((== x) . snd) (rsAfter rs) of (ys, z:zs) -> RegionSelection { rsBefore = rsBefore rs ++ reverse ys , rsCurrent = Just z , rsLastClick = midpoint (fst z) , rsAfter = zs } (_, []) -> rs bustle-0.8.0/Bustle/Renderer.hs0000644000000000000000000006252313700421730014550 0ustar0000000000000000{-# LANGUAGE DeriveFunctor, OverloadedStrings, GeneralizedNewtypeDeriving #-} {- Bustle.Renderer: render nice Cairo diagrams from a list of D-Bus messages Copyright (C) 2008 Collabora Ltd. 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.Renderer ( -- * Processing entire logs process , processWithFilters -- * Processing logs incrementally , RendererState , rendererStateNew , processSome -- * Output of processing , RendererResult(..) , Participants , sessionParticipants ) where import Bustle.Types import Bustle.Diagram import Bustle.Regions import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Set as Set import Data.Set (Set) import qualified Data.Map.Strict as Map import Data.Map.Strict (Map) import Control.Arrow (first) import Control.Monad import Control.Monad.Identity import Control.Monad.State import Control.Monad.Writer import Data.List (sort, sortBy) import Data.Maybe (fromJust, fromMaybe, catMaybes) import Data.Ord (comparing) data Bus = SessionBus | SystemBus deriving (Show, Eq, Ord) -- We keep the column in the map to allow the Monoid instance to preserve the -- ordering returned by sessionParticipants, which is the only view on this -- type exported. data Participants = Participants { pSession , _pSystem :: Map (Double, UniqueName) (Set OtherName) } deriving (Show, Eq) instance Semigroup Participants where (<>) (Participants sess1 sys1) (Participants sess2 sys2) = Participants (f sess1 sess2) (f sys1 sys2) where f = Map.unionWith Set.union instance Monoid Participants where mempty = Participants Map.empty Map.empty sessionParticipants :: Participants -> [(UniqueName, Set OtherName)] -- ^ sorted by column sessionParticipants = map (first snd) . Map.toAscList . pSession data RendererResult apps = RendererResult { rrCentreOffset :: Double , rrTopOffset :: Double -- ^ you shouldn't really need this outside of here. , rrShapes :: [Shape] , rrRegions :: Regions (Detailed Message) , rrApplications :: apps , rrWarnings :: [String] } deriving (Show, Functor, Eq) -- Using Functor is a slight hack really -- Yikes. -- -- When combining two segments of a diagram, we may need to translate -- one or other segment in either axis. For instance, if the first message -- involves a service with only one bus name, but the second involves a service -- with a hundred names, we're going to need a massive downwards translation to -- shift the first set of messages down to match the second. -- -- This is extremely unpleasant but it's a Monday. There's a test case in -- Test/Renderer.hs because I don't trust myself. instance Semigroup apps => Semigroup (RendererResult apps) where rr1 <> rr2 = RendererResult centreOffset topOffset shapes regions applications warnings where centreOffset = rrCentreOffset rr1 `max` rrCentreOffset rr2 topOffset = rrTopOffset rr1 `max` rrTopOffset rr2 shapes = shapes1 ++ shapes2 versus x y = if x < y then Just (y - x) else Nothing translation rr = ( rrCentreOffset rr `versus` centreOffset , rrTopOffset rr `versus` topOffset ) translateShapes rr = case translation rr of -- Hooray for premature optimization (Nothing, Nothing) -> rrShapes rr (mx, my) -> translateDiagram (fromMaybe 0 mx, fromMaybe 0 my) $ rrShapes rr shapes1 = translateShapes rr1 shapes2 = translateShapes rr2 translatedRegions rr = case snd $ translation rr of Nothing -> rrRegions rr Just y -> translateRegions y $ rrRegions rr regions = translatedRegions rr1 ++ translatedRegions rr2 applications = rrApplications rr1 <> rrApplications rr2 warnings = rrWarnings rr1 <> rrWarnings rr2 instance Monoid apps => Monoid (RendererResult apps) where mempty = RendererResult 0 0 [] [] mempty [] processWithFilters :: (Log, NameFilter) -> (Log, NameFilter) -> RendererResult () processWithFilters (sessionBusLog, sessionFilter) (systemBusLog, systemFilter ) = void $ fst $ processSome sessionBusLog systemBusLog rs where rs = initialState sessionFilter systemFilter process :: Log -> Log -> RendererResult Participants process sessionBusLog systemBusLog = fst $ processSome sessionBusLog systemBusLog rendererStateNew -- Doesn't let you filter rendererStateNew :: RendererState rendererStateNew = initialState emptyNameFilter emptyNameFilter buildResult :: RendererOutput -> RendererState -> RendererResult Participants buildResult (RendererOutput diagram messageRegions warnings) rs = RendererResult x y diagram' regions' participants warnings where (_translation@(x, y), diagram') = topLeftJustifyDiagram diagram regions' = translateRegions y messageRegions stripApps bs = Map.fromList [ ((column, u), aiEverNames ai) | (u, ai) <- Map.assocs (apps bs) , Just column <- [everColumn $ aiColumn ai] ] sessionApps = stripApps $ sessionBusState rs systemApps = stripApps $ systemBusState rs participants = Participants sessionApps systemApps processSome :: Log -- ^ freshly-arrived session bus messages -> Log -- ^ freshly-arrived system bus messages -> RendererState -- ^ the saved state from last time -> ( RendererResult Participants -- ^ the output from these messages , RendererState -- ^ state to re-use later ) processSome sessionBusLog systemBusLog rs = (buildResult output rs', rs') where log' = combine sessionBusLog systemBusLog (output, rs') = runRenderer (mapM_ (uncurry processOne) log') rs -- Combines a series of messages on the session bus and system bus into a -- single ordered list, annotated by timestamp. Assumes both the source lists -- are sorted. combine :: Log -- ^ session bus messages -> Log -- ^ system bus messages -> [(Bus, DetailedEvent)] combine [] [] = [] combine xs [] = zip (repeat SessionBus) xs combine [] ys = zip (repeat SystemBus) ys combine xs@(x:xs') ys@(y:ys') = if deTimestamp x < deTimestamp y then (SessionBus, x):combine xs' ys else (SystemBus, y):combine xs ys' newtype Renderer a = Renderer (WriterT RendererOutput (StateT RendererState Identity) a) deriving ( Functor , Applicative , Monad , MonadState RendererState , MonadWriter RendererOutput ) runRenderer :: Renderer () -> RendererState -> ( RendererOutput , RendererState ) runRenderer (Renderer act) st = runIdentity $ runStateT (execWriterT act) st data RendererOutput = RendererOutput ![Shape] !(Regions (Detailed Message)) ![String] deriving (Show) instance Semigroup RendererOutput where (<>) (RendererOutput s1 r1 w1) (RendererOutput s2 r2 w2) = RendererOutput (s1 ++ s2) (r1 ++ r2) (w1 ++ w2) instance Monoid RendererOutput where mempty = RendererOutput [] [] [] data BusState = BusState { apps :: Applications , firstColumn :: Double , nextColumn :: Double , columnsInUse :: Set Double , pending :: Pending , bsFilter :: NameFilter , nextFakeName :: Integer } data RendererState = RendererState { sessionBusState :: BusState , systemBusState :: BusState , row :: Double , mostRecentLabels :: Double , startTime :: Microseconds } initialBusState :: NameFilter -> Double -> BusState initialBusState ignore x = BusState { apps = Map.empty , firstColumn = x , nextColumn = x , columnsInUse = Set.empty , pending = Map.empty , bsFilter = ignore , nextFakeName = 0 } initialSessionBusState, initialSystemBusState :: NameFilter -> BusState initialSessionBusState f = initialBusState f $ timestampAndMemberWidth + firstColumnOffset initialSystemBusState f = initialBusState f $ negate firstColumnOffset initialState :: NameFilter -> NameFilter -> RendererState initialState sessionFilter systemFilter = RendererState { sessionBusState = initialSessionBusState sessionFilter , systemBusState = initialSystemBusState systemFilter , row = 0 , mostRecentLabels = 0 , startTime = 0 } -- Maps unique connection name to the column representing that name, if -- allocated, and a set of non-unique names for the connection, if any. data Column = NoColumn | CurrentColumn Double | FormerColumn (Maybe Double) deriving Show currentColumn :: Column -> Maybe Double currentColumn (CurrentColumn x) = Just x currentColumn _ = Nothing everColumn :: Column -> Maybe Double everColumn NoColumn = Nothing everColumn (CurrentColumn x) = Just x everColumn (FormerColumn mx) = mx data ApplicationInfo = ApplicationInfo { aiColumn :: Column , aiCurrentNames :: Set OtherName , aiEverNames :: Set OtherName } deriving Show aiCurrentColumn :: ApplicationInfo -> Maybe Double aiCurrentColumn = currentColumn . aiColumn type Applications = Map UniqueName ApplicationInfo -- Map from a method call message to the coordinates at which the arc to its -- return should start. type Pending = Map (Detailed Message) (Double, Double) getBusState :: Bus -> Renderer BusState getBusState = getsBusState id getsBusState :: (BusState -> a) -> Bus -> Renderer a getsBusState f SessionBus = gets (f . sessionBusState) getsBusState f SystemBus = gets (f . systemBusState) modifyBusState :: Bus -> (BusState -> BusState) -> Renderer () modifyBusState bus f = case bus of SessionBus -> modify $ \rs -> rs { sessionBusState = f (sessionBusState rs) } SystemBus -> modify $ \rs -> rs { systemBusState = f (systemBusState rs) } getApps :: Bus -> Renderer Applications getApps bus = apps <$> getBusState bus getsApps :: (Applications -> a) -> Bus -> Renderer a getsApps f = getsBusState (f . apps) lookupUniqueName :: Bus -> UniqueName -> Renderer ApplicationInfo lookupUniqueName bus u = do thing <- getsApps (Map.lookup u) bus case thing of Just nameInfo -> return nameInfo -- This happens with pcap logs where we don't (currently) have -- explicit change notification for unique names in the stream of -- DetailedEvents. Nothing -> addUnique bus u lookupOtherName :: Bus -> OtherName -> Renderer (UniqueName, ApplicationInfo) lookupOtherName bus o = do as <- getApps bus case filter (Set.member o . aiCurrentNames . snd) (Map.assocs as) of [details] -> return details -- No known owner for the well-known name. This happens in many cases, -- especially when a method call causes service activation. [] -> do n <- getsBusState nextFakeName bus modifyBusState bus $ \bs -> bs { nextFakeName = n + 1 } let u = fakeUniqueName (show n) addUnique bus u addOther bus o u ai <- lookupUniqueName bus u return (u, ai) -- … but more than one match means we've messed up. This can happen -- with logs generated by dbus-monitor --pcap, which doesn't perform -- an initial dump of all names on the bus. (d:ds) -> do warn $ concat [ unOtherName o , " owned by several apps: " , show (d:ds) ] return d -- Finds a TaggedBusName in a map of applications lookupApp :: Bus -> TaggedBusName -> Renderer (UniqueName, ApplicationInfo) lookupApp bus name = case name of U u -> do details <- lookupUniqueName bus u return (u, details) O o -> lookupOtherName bus o -- Finds a TaggedBusName in the current state, yielding its column if it exists. If -- it exists, but previously lacked a column, a column is allocated. appCoordinate :: Bus -> TaggedBusName -> Renderer Double appCoordinate bus n = do (u, details) <- lookupApp bus n case aiColumn details of NoColumn -> assignColumn u (aiCurrentNames details) CurrentColumn x -> return x FormerColumn c -> do warn $ show n ++ "(owned by " ++ show u ++ ") spontaneously reappeared" case c of Just x -> return x Nothing -> assignColumn u (aiCurrentNames details) where assignColumn :: UniqueName -> Set OtherName -> Renderer Double assignColumn u os = do x <- nextColumn <$> getBusState bus -- FIXME: ick let f = case bus of SessionBus -> (+ columnWidth) SystemBus -> subtract columnWidth modifyBusState bus $ \bs -> bs { nextColumn = f x , columnsInUse = Set.insert x (columnsInUse bs) } modifyApps bus $ Map.adjust (\ai -> ai { aiColumn = CurrentColumn x }) u -- FIXME: Does this really live here? currentRow <- gets row let ns = bestNames u os h = headerHeight ns shape $ Header ns x (currentRow - (10 + h)) shape $ ClientLines (x :| []) (currentRow - 5) (currentRow + 15) return x -- Modify the application table directly. modifyApps :: Bus -> (Applications -> Applications) -> Renderer () modifyApps bus f = modifyBusState bus $ \bs -> bs { apps = f (apps bs) } -- Updates the current set of applications in response to a well-known name's -- owner changing. updateApps :: Bus -- ^ bus on which a name's owner has changed -> OtherName -- name whose owner has changed. -> Change -- details of the change -> Renderer () updateApps bus n c = case c of Claimed new -> addOther bus n new Stolen old new -> remOther bus n old >> addOther bus n new Released old -> remOther bus n old -- Adds a new unique name addUnique :: Bus -> UniqueName -> Renderer ApplicationInfo addUnique bus n = do let ai = ApplicationInfo NoColumn Set.empty Set.empty existing <- getsApps (Map.lookup n) bus forM_ existing $ const $ warn $ concat [ "Unique name '" , unUniqueName n , "' apparently connected to the bus twice" ] modifyApps bus $ Map.insert n ai return ai -- Removes a unique name from the diagram. If we ever try to reuse columns -- we'll have to revisit the FormerColumn concept to include a range of time. remUnique :: Bus -> UniqueName -> Renderer () remUnique bus n = do ai <- lookupUniqueName bus n let mcolumn = aiCurrentColumn ai modifyApps bus $ Map.insert n (ai { aiColumn = FormerColumn mcolumn }) forM_ mcolumn $ \x -> modifyBusState bus $ \bs -> bs { columnsInUse = Set.delete x (columnsInUse bs) } addOther, remOther :: Bus -> OtherName -> UniqueName -> Renderer () -- Add a new well-known name to a unique name. addOther bus n u = do ai <- lookupUniqueName bus u let ai' = ai { aiCurrentNames = Set.insert n (aiCurrentNames ai) , aiEverNames = Set.insert n (aiEverNames ai) } modifyApps bus $ Map.insert u ai' -- Remove a well-known name from a unique name remOther bus n u = do ai <- lookupUniqueName bus u let ai' = ai { aiCurrentNames = Set.delete n (aiCurrentNames ai) } modifyApps bus $ Map.insert u ai' shape :: Shape -> Renderer () shape s = tellShapes [s] tellShapes :: [Shape] -> Renderer () tellShapes ss = tell $ RendererOutput ss [] [] region :: Stripe -> Detailed Message -> Renderer () region r m = tell $ RendererOutput [] [(r, m)] [] warn :: String -> Renderer () warn warning = tell $ RendererOutput [] [] [warning] modifyPending :: Bus -> (Pending -> Pending) -> Renderer () modifyPending bus f = modifyBusState bus $ \bs -> bs { pending = f (pending bs) } addPending :: Bus -> Detailed Message -> Renderer () addPending bus m = do x <- destinationCoordinate bus m y <- gets row modifyPending bus $ Map.insert m (x, y) findCallCoordinates :: Bus -> Maybe (Detailed Message) -> Renderer (Maybe (Detailed Message, (Double, Double))) findCallCoordinates bus = maybe (return Nothing) $ \m -> do ret <- getsBusState (Map.lookup m . pending) bus modifyPending bus $ Map.delete m return $ fmap ((,) m) ret -- The adjustments here leave space for a new app's headers to be drawn -- without overlapping the rule. getLeftMargin, getRightMargin :: Renderer Double getLeftMargin = maybe 0 (subtract 35) <$> edgemostApp SystemBus getRightMargin = maybe timestampAndMemberWidth (+ 35) <$> edgemostApp SessionBus advanceBy :: Double -> Renderer () advanceBy d = do lastLabelling <- gets mostRecentLabels current' <- gets row when (current' - lastLabelling > 400) $ do xs <- (++) <$> getsApps Map.toList SessionBus <*> getsApps Map.toList SystemBus let xs' = [ (x, bestNames u os) | (u, ApplicationInfo (CurrentColumn x) os _) <- xs ] let (height, ss) = headers xs' (current' + 20) tellShapes ss modify $ \bs -> bs { mostRecentLabels = current' + height + 10 , row = row bs + height + 10 } current <- gets row modify (\bs -> bs { row = row bs + d }) next <- gets row leftMargin <- getLeftMargin rightMargin <- getRightMargin shape $ Rule leftMargin rightMargin (current + 15) let appColumns :: Applications -> [Double] appColumns = catMaybes . Map.foldr ((:) . aiCurrentColumn) [] xs <- (++) <$> getsApps appColumns SessionBus <*> getsApps appColumns SystemBus case xs of (x:xs') -> shape $ ClientLines (x :| xs') (current + 15) (next + 15) _ -> return () bestNames :: UniqueName -> Set OtherName -> [String] bestNames u os | Set.null os = [unUniqueName u] | otherwise = (sortBy (flip (comparing length)) . map readable) $ Set.toList os where readable = reverse . takeWhile (/= '.') . reverse . unOtherName edgemostApp :: Bus -> Renderer (Maybe Double) edgemostApp bus = do columns <- getsBusState columnsInUse bus return $ if Set.null columns then Nothing else Just $ findMinMax columns where findMinMax = case bus of SessionBus -> Set.findMax SystemBus -> Set.findMin senderCoordinate :: Bus -> Detailed Message -> Renderer Double senderCoordinate bus de = appCoordinate bus . sender $ deEvent de destinationCoordinate :: Bus -> Detailed Message -> Renderer Double destinationCoordinate bus de = appCoordinate bus . destination $ deEvent de signalDestinationCoordinate :: Bus -> Detailed Message -> Renderer (Maybe Double) signalDestinationCoordinate bus m = case signalDestination $ deEvent m of Nothing -> return Nothing Just n -> Just <$> appCoordinate bus n memberName :: Detailed Message -> Bool -> Renderer () memberName message isReturn = do current <- gets row let Member p i m = member $ deEvent message shape $ memberLabel p i m isReturn current getTimeOffset :: Microseconds -> Renderer Microseconds getTimeOffset µs = do base <- gets startTime if base == 0 then do modify (\s -> s { startTime = µs }) return 0 else return (µs - base) relativeTimestamp :: Detailed a -> Renderer () relativeTimestamp dm = do relative <- getTimeOffset (deTimestamp dm) current <- gets row shape $ timestampLabel (show (µsToMs relative) ++ "ms") current returnArc :: Bus -> Detailed Message -> Double -> Double -> Microseconds -> Renderer () returnArc bus mr callx cally duration = do destinationx <- destinationCoordinate bus mr currentx <- senderCoordinate bus mr currenty <- gets row shape $ Arc { topx = callx, topy = cally , bottomx = currentx, bottomy = currenty , arcside = if destinationx > currentx then L else R , caption = show (µsToMs duration) ++ "ms" } addMessageRegion :: Detailed Message -> Renderer () addMessageRegion m = do newRow <- gets row -- FIXME: wtf. "row" points to the ... middle ... of the current row. region (Stripe (newRow - eventHeight / 2) (newRow + eventHeight / 2)) m shouldShow :: Bus -> Message -> Renderer Bool shouldShow bus m = do nameFilter <- getsBusState bsFilter bus names <- mapM (fmap fst . lookupApp bus) (mentionedNames m) return $ not (any (flip Set.member $ nfNever nameFilter) names) && (Set.null (nfOnly nameFilter) || any (flip Set.member $ nfOnly nameFilter) names) processOne :: Bus -> Detailed Event -> Renderer () processOne bus de = case deEvent de of NOCEvent n -> processNOC bus n MessageEvent m -> processMessage bus (fmap (const m) de) processMessage :: Bus -> Detailed Message -> Renderer () processMessage bus dm@(Detailed _ m _ _) = do orly <- shouldShow bus m when orly $ case m of Signal {} -> do advance relativeTimestamp dm memberName dm False signal bus dm addMessageRegion dm MethodCall {} -> do advance relativeTimestamp dm memberName dm False methodCall bus dm addPending bus dm addMessageRegion dm MethodReturn {} -> returnOrError $ methodReturn bus Error {} -> returnOrError $ errorReturn bus where advance = advanceBy eventHeight -- FIXME: use some function of timestamp? returnOrError f = do call <- findCallCoordinates bus (inReplyTo m) forM_ call $ \(dm', (x,y)) -> do advance relativeTimestamp dm memberName dm' True f dm let duration = deTimestamp dm - deTimestamp dm' returnArc bus dm x y duration addMessageRegion dm processNOC :: Bus -> NOC -> Renderer () processNOC bus noc = case noc of Connected { actor = u } -> void (addUnique bus u) Disconnected { actor = u } -> remUnique bus u NameChanged { changedName = n , change = c } -> updateApps bus n c methodCall, methodReturn, errorReturn :: Bus -> Detailed Message -> Renderer () methodCall = methodLike Nothing Above methodReturn = methodLike Nothing Below errorReturn = methodLike (Just $ Colour 1 0 0) Below methodLike :: Maybe Colour -> Arrowhead -> Bus -> Detailed Message -> Renderer () methodLike colour a bus dm = do sc <- senderCoordinate bus dm dc <- destinationCoordinate bus dm t <- gets row shape $ Arrow colour a sc dc t signal :: Bus -> Detailed Message -> Renderer () signal bus dm = do t <- gets row emitter <- senderCoordinate bus dm mtarget <- signalDestinationCoordinate bus dm case mtarget of Just target -> shape $ DirectedSignalArrow emitter target t Nothing -> do -- fromJust is safe here because we must have an app to have a -- signal. It doesn't make me very happy though. outside <- fromJust <$> edgemostApp bus inside <- getsBusState firstColumn bus let [x1, x2] = sort [outside, inside] shape $ SignalArrow (x1 - 20) emitter (x2 + 20) t -- vim: sw=2 sts=2 bustle-0.8.0/Bustle/StatisticsPane.hs0000644000000000000000000001746013700421730015740 0ustar0000000000000000{- Bustle.StatisticsPane: implementation of the stats pane Copyright © 2010–011 Collabora Ltd. 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.StatisticsPane ( StatsPane , statsPaneNew , statsPaneSetMessages ) where import Control.Monad (forM_, void) import Text.Printf import Graphics.UI.Gtk import Bustle.Missing (formatSize) import Bustle.Stats import Bustle.Translation (__) import Bustle.Types (Log) import qualified Bustle.Marquee as Marquee import Bustle.Marquee (Marquee) data StatsPane = StatsPane { spCountStore :: ListStore FrequencyInfo , spTimeStore :: ListStore TimeInfo , spSizeStore :: ListStore SizeInfo } statsPaneNew :: Builder -> IO StatsPane statsPaneNew builder = do [frequencySW, durationSW, sizeSW] <- mapM (builderGetObject builder castToScrolledWindow) ["frequencySW", "durationSW", "sizeSW"] (countStore, countView) <- newCountView containerAdd frequencySW countView (timeStore, timeView) <- newTimeView containerAdd durationSW timeView (sizeStore, sizeView) <- newSizeView containerAdd sizeSW sizeView widgetShow countView widgetShow timeView widgetShow sizeView return $ StatsPane countStore timeStore sizeStore statsPaneSetMessages :: StatsPane -> Log -- ^ session bus messages -> Log -- ^ system bus messages -> IO () statsPaneSetMessages sp sessionMessages systemMessages = do -- This conflates messages on the system bus and on the session bus, -- but I think that's okay for now. let allMessages = sessionMessages ++ systemMessages listStoreClear (spCountStore sp) listStoreClear (spTimeStore sp) listStoreClear (spSizeStore sp) forM_ (frequencies allMessages) $ listStoreAppend (spCountStore sp) forM_ (methodTimes allMessages) $ listStoreAppend (spTimeStore sp) forM_ (messageSizes allMessages) $ listStoreAppend (spSizeStore sp) addTextRenderer :: TreeViewColumn -> ListStore a -> Bool -> (a -> Marquee) -> IO CellRendererText addTextRenderer col store expand f = do renderer <- cellRendererTextNew cellLayoutPackStart col renderer expand set renderer [ cellTextSizePoints := 7 ] cellLayoutSetAttributes col renderer store $ \x -> [ cellTextMarkup := (Just . Marquee.toPangoMarkup) $ f x ] return renderer addMemberRenderer :: TreeViewColumn -> ListStore a -> Bool -> (a -> Marquee) -> IO CellRendererText addMemberRenderer col store expand f = do renderer <- addTextRenderer col store expand f set renderer [ cellTextEllipsize := EllipsizeStart , cellTextEllipsizeSet := True , cellXAlign := 1 , cellTextWidthChars := 30 ] return renderer addStatColumn :: TreeView -> ListStore a -> String -> (a -> Marquee) -> IO () addStatColumn view store title f = void $ do col <- treeViewColumnNew treeViewColumnSetTitle col title renderer <- addTextRenderer col store True f set renderer [ cellXAlign := 1 ] treeViewAppendColumn view col addTextStatColumn :: TreeView -> ListStore a -> String -> (a -> String) -> IO () addTextStatColumn view store title f = addStatColumn view store title (Marquee.escape . f) newCountView :: IO (ListStore FrequencyInfo, TreeView) newCountView = do countStore <- listStoreNew [] countView <- treeViewNewWithModel countStore set countView [ treeViewHeadersVisible := True ] nameColumn <- treeViewColumnNew treeViewColumnSetTitle nameColumn (__ "Member") set nameColumn [ treeViewColumnResizable := True , treeViewColumnExpand := True ] addTextRenderer nameColumn countStore False $ \fi -> Marquee.escape $ case fiType fi of TallyMethod -> __ "Method" TallySignal -> __ "Signal" addMemberRenderer nameColumn countStore True $ \fi -> Marquee.formatMember (fiInterface fi) (fiMember fi) treeViewAppendColumn countView nameColumn countColumn <- treeViewColumnNew treeViewColumnSetTitle countColumn (__ "Frequency") treeViewColumnSetMinWidth countColumn 120 -- Using a progress bar here is not really ideal, but I CBA to do anything -- more auspicious right now. :) countBar <- cellRendererProgressNew cellLayoutPackStart countColumn countBar True cellLayoutSetAttributes countColumn countBar countStore $ \FrequencyInfo {fiFrequency = count} -> [ cellProgressValue :=> do upperBound <- maximum . map fiFrequency <$> listStoreToList countStore -- ensure that we always show *something* return $ 2 + (count * 98 `div` upperBound) , cellProgressText := Just $ show count ] treeViewAppendColumn countView countColumn return (countStore, countView) newTimeView :: IO (ListStore TimeInfo, TreeView) newTimeView = do timeStore <- listStoreNew [] timeView <- treeViewNewWithModel timeStore set timeView [ treeViewHeadersVisible := True ] nameColumn <- treeViewColumnNew treeViewColumnSetTitle nameColumn (__ "Method") set nameColumn [ treeViewColumnResizable := True , treeViewColumnExpand := True ] addMemberRenderer nameColumn timeStore True $ \ti -> Marquee.formatMember (tiInterface ti) (tiMethodName ti) treeViewAppendColumn timeView nameColumn addTextStatColumn timeView timeStore (__ "Total") (printf (__ "%.1f ms") . tiTotalTime) addTextStatColumn timeView timeStore (__ "Calls") (show . tiCallFrequency) addTextStatColumn timeView timeStore (__ "Mean") (printf (__ "%.1f ms") . tiMeanCallTime) return (timeStore, timeView) formatSizeInfoMember :: SizeInfo -> Marquee formatSizeInfoMember si = f (Marquee.formatMember (siInterface si) (siName si)) where f = case siType si of SizeReturn -> Marquee.i SizeError -> Marquee.red _ -> id newSizeView :: IO (ListStore SizeInfo, TreeView) newSizeView = do sizeStore <- listStoreNew [] sizeView <- treeViewNewWithModel sizeStore set sizeView [ treeViewHeadersVisible := True ] nameColumn <- treeViewColumnNew treeViewColumnSetTitle nameColumn (__ "Member") set nameColumn [ treeViewColumnResizable := True , treeViewColumnExpand := True ] addTextRenderer nameColumn sizeStore False $ \si -> Marquee.escape $ case siType si of SizeCall -> __ "Method call" SizeReturn -> __ "Method return" SizeError -> __ "Error" SizeSignal -> __ "Signal" addMemberRenderer nameColumn sizeStore True formatSizeInfoMember treeViewAppendColumn sizeView nameColumn addStatColumn sizeView sizeStore (__ "Smallest") (Marquee.escape . formatSize . siMinSize) addStatColumn sizeView sizeStore (__ "Mean") (Marquee.escape . formatSize . siMeanSize) addStatColumn sizeView sizeStore (__ "Largest") (Marquee.escape . formatSize . siMaxSize) return (sizeStore, sizeView) bustle-0.8.0/Bustle/Stats.hs0000644000000000000000000001401613700421730014072 0ustar0000000000000000{- Bustle.Stats: calculates statistics for D-Bus logs Copyright © 2009–2011 Collabora Ltd. 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.Stats ( TallyType(..) , FrequencyInfo(..) , frequencies , methodTimes , TimeInfo(..) , messageSizes , SizeType(..) , SizeInfo(..) ) where import Control.Monad (guard) import Data.List (sortBy) import Data.Maybe (mapMaybe) import Data.Ord (comparing) import qualified Data.Map as Map import qualified Data.Map.Strict import Data.Map (Map) import Bustle.Types data TallyType = TallyMethod | TallySignal deriving (Eq, Ord, Show) repr :: DetailedEvent -> Maybe (TallyType, Maybe InterfaceName, MemberName) repr (Detailed _ (NOCEvent _) _ _) = Nothing repr (Detailed _ (MessageEvent msg) _ _) = case msg of MethodCall { member = m } -> Just (TallyMethod, iface m, membername m) Signal { member = m } -> Just (TallySignal, iface m, membername m) _ -> Nothing data FrequencyInfo = FrequencyInfo { fiFrequency :: Int , fiType :: TallyType , fiInterface :: Maybe InterfaceName , fiMember :: MemberName } deriving (Show, Eq, Ord) frequencies :: Log -> [FrequencyInfo] frequencies = sortBy (flip compare) . map (\((t, i, m), c) -> FrequencyInfo c t i m) . Map.toList . foldr (Map.alter alt) Map.empty . mapMaybe repr where alt Nothing = Just 1 alt (Just n) = Just (n + 1) mean :: (Eq a, Fractional a) => [a] -> a mean = acc 0 0 where acc n t [] = t / n acc n t (x:xs) = acc (n + 1) (t + x) xs data TimeInfo = TimeInfo { tiInterface :: Maybe InterfaceName , tiMethodName :: MemberName , tiTotalTime :: Double -- milliseconds , tiCallFrequency :: Int , tiMeanCallTime :: Double -- milliseconds } methodTimes :: Log -> [TimeInfo] methodTimes = sortBy (flip (comparing tiTotalTime)) . map summarize . Map.toList . foldr (\(i, method, time) -> Map.alter (alt time) (i, method)) Map.empty . mapMaybe methodReturn -- Get rid of NOC messages . snd . partitionDetaileds where alt newtime Nothing = Just (newtime, [newtime]) alt newtime (Just (total, times)) = Just (newtime + total, newtime : times) isReturn :: Message -> Bool isReturn MethodReturn {} = True isReturn _ = False methodReturn :: Detailed Message -> Maybe (Maybe InterfaceName, MemberName, Microseconds) methodReturn dm = do let m = deEvent dm guard (isReturn m) Detailed start call@MethodCall {} _ _ <- inReplyTo m return ( iface (member call) , membername (member call) , deTimestamp dm - start ) summarize ((i, method), (total, times)) = TimeInfo { tiInterface = i , tiMethodName = method , tiTotalTime = fromIntegral total / 1000 , tiCallFrequency = length times , tiMeanCallTime = mean (map fromIntegral times) / 1000 } -- FIXME: really? again? data SizeType = SizeCall | SizeReturn | SizeError | SizeSignal deriving (Show, Ord, Eq) -- The fields are in this ideosyncratic order to make the derived Ord instance -- do what we want data SizeInfo = SizeInfo { siMeanSize, siMaxSize, siMinSize :: Int , siType :: SizeType , siInterface :: Maybe InterfaceName , siName :: MemberName } deriving (Show, Ord, Eq) messageSizes :: Log -> [SizeInfo] messageSizes messages = sortBy (flip compare) . map summarize $ Map.assocs sizeTable where summarize :: ((SizeType, Maybe InterfaceName, MemberName), [Int]) -> SizeInfo summarize ((t, i, m), sizes) = SizeInfo (intMean sizes) (maximum sizes) (minimum sizes) t i m intMean :: [Int] -> Int intMean = ceiling . (mean :: [Double] -> Double) . map fromIntegral sizeTable = foldr f Map.empty . snd . partitionDetaileds $ messages f :: Detailed Message -> Map (SizeType, Maybe InterfaceName, MemberName) [Int] -> Map (SizeType, Maybe InterfaceName, MemberName) [Int] f dm = case sizeKeyRepr dm of Just key -> Data.Map.Strict.insertWith (++) key [deMessageSize dm] _ -> id callDetails :: Message -> Maybe (Maybe InterfaceName, MemberName) callDetails msg = do Detailed _ msg' _ _ <- inReplyTo msg return (iface (member msg'), membername (member msg')) sizeKeyRepr :: Detailed Message -> Maybe (SizeType, Maybe InterfaceName, MemberName) sizeKeyRepr dm = do let msg = deEvent dm case msg of MethodCall { member = m } -> return (SizeCall, iface m, membername m) Signal { member = m } -> return (SizeSignal, iface m, membername m) MethodReturn { } -> do (x, y) <- callDetails msg return (SizeReturn, x, y) Error { } -> do (x, y) <- callDetails msg return (SizeError, x, y) bustle-0.8.0/src-hgettext/Bustle/Translation.hs0000644000000000000000000000101313700421730017704 0ustar0000000000000000module Bustle.Translation ( initTranslation , __ ) where import Text.I18N.GetText import System.Locale.SetLocale import System.IO.Unsafe import GetText_bustle initTranslation :: IO () initTranslation = do setLocale LC_ALL (Just "") domain <- getMessageCatalogDomain dir <- getMessageCatalogDir bindTextDomain domain (Just dir) textDomain (Just domain) return () __ :: String -> String -- FIXME: I do not like this unsafePerformIO one little bit. __ = unsafePerformIO . getText bustle-0.8.0/src-no-hgettext/Bustle/Translation.hs0000644000000000000000000000024113700421730020320 0ustar0000000000000000module Bustle.Translation ( initTranslation , __ ) where initTranslation :: IO () initTranslation = return () __ :: String -> String __ = id bustle-0.8.0/Bustle/Types.hs0000644000000000000000000001421113710546303014102 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-} {- Bustle.Types: defines types used by Bustle Copyright (C) 2008 Collabora Ltd. 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.Types ( ObjectPath , formatObjectPath , InterfaceName , formatInterfaceName , MemberName , formatMemberName , Serial , UniqueName(..) , OtherName(..) , TaggedBusName(..) , isUnique , isOther , unUniqueName , unOtherName , unBusName , NameFilter(..) , emptyNameFilter , nameFilterAddOnly , nameFilterAddNever , nameFilterRemove , dbusName , dbusInterface , fakeUniqueName , Microseconds(..) , µsToMs , Member(..) , Message(..) , NOC(..) , Event(..) , Detailed(..) , DetailedEvent , Change(..) , partitionDetaileds , mentionedNames , Log ) where import Bustle.GDBusMessage import Data.Maybe (maybeToList) import Data.Either (partitionEithers) import Data.Set (Set) import qualified Data.Set as Set newtype UniqueName = UniqueName BusName deriving (Ord, Show, Eq) newtype OtherName = OtherName BusName deriving (Ord, Show, Eq) data TaggedBusName = U UniqueName | O OtherName deriving (Ord, Show, Eq) isUnique, isOther :: TaggedBusName -> Bool isUnique (U _) = True isUnique (O _) = False isOther = not . isUnique unUniqueName :: UniqueName -> String unUniqueName (UniqueName x) = formatBusName x unOtherName :: OtherName -> String unOtherName (OtherName x) = formatBusName x unBusName :: TaggedBusName -> String unBusName (U (UniqueName x)) = formatBusName x unBusName (O (OtherName x)) = formatBusName x data NameFilter = NameFilter { nfOnly :: Set UniqueName , nfNever :: Set UniqueName } deriving (Show, Eq, Ord) emptyNameFilter :: NameFilter emptyNameFilter = NameFilter Set.empty Set.empty nameFilterModify :: (Set UniqueName -> Set UniqueName) -> (Set UniqueName -> Set UniqueName) -> NameFilter -> NameFilter nameFilterModify updateOnly updateNever nf = nf { nfOnly = updateOnly $ nfOnly nf , nfNever = updateNever $ nfNever nf } nameFilterAddOnly, nameFilterAddNever, nameFilterRemove :: UniqueName -> NameFilter -> NameFilter nameFilterAddOnly u = nameFilterModify (Set.insert u) (Set.delete u) nameFilterAddNever u = nameFilterModify (Set.delete u) (Set.insert u) nameFilterRemove u = nameFilterModify (Set.delete u) (Set.delete u) -- These useful constants disappeared from dbus in the grand removing of the -- -core suffix. dbusName :: BusName dbusName = busName_ "org.freedesktop.DBus" dbusInterface :: InterfaceName dbusInterface = interfaceName_ "org.freedesktop.DBus" -- FIXME: nothing stops someone passing in garbage -- http://www.youtube.com/watch?v=WorPANO_ANU fakeUniqueName :: String -> UniqueName fakeUniqueName = UniqueName . busName_ . (":fake." ++) newtype Microseconds = Microseconds Integer deriving (Show, Ord, Eq, Num, Real, Enum, Integral) µsToMs :: Microseconds -> Integer µsToMs (Microseconds µs) = µs `div` 1000 data Member = Member { path :: ObjectPath , iface :: Maybe InterfaceName , membername :: MemberName } deriving (Ord, Show, Eq) data Event = MessageEvent Message | NOCEvent NOC deriving (Show, Eq, Ord) data Message = MethodCall { serial :: Serial , sender :: TaggedBusName , destination :: TaggedBusName , member :: Member } | MethodReturn { inReplyTo :: Maybe (Detailed Message) , sender :: TaggedBusName , destination :: TaggedBusName } | Signal { sender :: TaggedBusName , signalDestination :: Maybe TaggedBusName , member :: Member } | Error { inReplyTo :: Maybe (Detailed Message) , sender :: TaggedBusName , destination :: TaggedBusName } deriving (Show, Eq, Ord) data NOC = Connected { actor :: UniqueName } | Disconnected { actor :: UniqueName } | NameChanged { changedName :: OtherName , change :: Change } deriving (Show, Eq, Ord) type MessageSize = Int data Detailed e = Detailed { deTimestamp :: Microseconds , deEvent :: e , deMessageSize :: MessageSize , deReceivedMessage :: GDBusMessage } deriving (Show, Eq, Functor) type DetailedEvent = Detailed Event instance Ord e => Ord (Detailed e) where compare (Detailed µs x _ _) (Detailed µs' y _ _) = compare (µs, x) (µs', y) data Change = Claimed UniqueName | Stolen UniqueName UniqueName | Released UniqueName deriving (Show, Eq, Ord) partitionDetaileds :: [DetailedEvent] -> ([Detailed NOC], [Detailed Message]) partitionDetaileds = partitionEithers . map f where f (Detailed µs e size rm) = case e of NOCEvent n -> Left $ Detailed µs n size rm MessageEvent m -> Right $ Detailed µs m size rm mentionedNames :: Message -> [TaggedBusName] mentionedNames m = sender m:dest where dest = case m of Signal {} -> maybeToList $ signalDestination m _ -> [destination m] type Log = [DetailedEvent] -- vim: sw=2 sts=2 bustle-0.8.0/Bustle/UI.hs0000644000000000000000000006243413710546303013325 0ustar0000000000000000{- Bustle.UI: displays charts of D-Bus activity Copyright © 2008–2011 Collabora Ltd. Copyright © 2018 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 ScopedTypeVariables #-} module Bustle.UI ( uiMain ) where import Control.Monad (void) import Control.Monad.Reader import Control.Monad.State import Control.Monad.Except import Data.IORef import qualified Data.Map as Map import Data.List (intercalate) import Data.Time import Data.Tuple (swap) import Data.Monoid (mempty) import Text.Printf import Paths_bustle 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 import Bustle.UI.AboutDialog import Bustle.UI.Canvas import Bustle.UI.DetailsView import Bustle.UI.FilterDialog import Bustle.UI.OpenTwoDialog (setupOpenTwoDialog) import Bustle.UI.Recorder import Bustle.UI.RecordAddressDialog (showRecordAddressDialog) import Bustle.StatisticsPane import Bustle.Translation (__) import Bustle.Loader import Bustle.Loader.Pcap (convert) import qualified Control.Exception as C import System.Glib.GError (GError(..), failOnGError) import System.GIO.Enums (IOErrorEnum(IoErrorCancelled)) import Graphics.UI.Gtk import Graphics.Rendering.Cairo (withPDFSurface, renderWith) import System.FilePath ( splitFileName, takeFileName, takeDirectory , dropExtension, dropTrailingPathSeparator , (), (<.>) ) import System.GIO.File.File (fileFromParseName, fileMove, FileCopyFlags(..)) type B a = Bustle BConfig BState a data LogDetails = RecordedLog FilePath | SingleLog FilePath | TwoLogs FilePath FilePath -- Must be kept in sync with the names in the GtkBuilder file data Page = InstructionsPage | PleaseHoldPage | CanvasPage deriving (Show) data WindowInfo = WindowInfo { wiWindow :: Window , wiTitle :: Label , wiSubtitle :: Label , wiSpinner :: Spinner , wiRecord :: Button , wiStop :: Button , wiOpen :: Button , wiSave :: Button , wiExport :: Button , wiViewStatistics :: CheckMenuItem , wiFilterNames :: MenuItem , wiErrorBar :: InfoBar , wiErrorBarTitle :: Label , wiErrorBarDetails :: Label , wiStack :: Stack , wiSidebarHeader :: Widget -- TODO, GtkHeaderBar , wiSidebarStack :: Stack , wiStatsPane :: StatsPane , wiContentPaned :: Paned , wiCanvas :: Canvas (Detailed Message) , wiDetailsView :: DetailsView , wiLogDetails :: IORef (Maybe LogDetails) } newtype BConfig = BConfig { debugEnabled :: Bool } data BState = BState { windows :: Int , initialWindow :: Maybe WindowInfo } modifyWindows :: (Int -> Int) -> B () modifyWindows f = modify $ \s -> s { windows = f (windows s) } incWindows :: B () incWindows = modifyWindows (+1) decWindows :: B Int decWindows = modifyWindows (subtract 1) >> gets windows uiMain :: IO () uiMain = failOnGError $ do args <- initGUI -- FIXME: get a real option parser let debug = any isDebug args let config = BConfig { debugEnabled = debug } initialState = BState { windows = 0 , initialWindow = Nothing } runB config initialState $ mainB (filter (not . isDebug) args) where isDebug = (== "--debug") mainB :: [String] -> B () mainB args = do case args of ["--pair", sessionLogFile, systemLogFile] -> loadLog (TwoLogs sessionLogFile systemLogFile) _ -> mapM_ (loadLog . SingleLog) args -- If no windows are open (because none of the arguments, if any, were loaded -- successfully) create an empty window n <- gets windows when (n == 0) createInitialWindow io mainGUI createInitialWindow :: B () createInitialWindow = do wi <- emptyWindow putInitialWindow wi consumeInitialWindow :: B WindowInfo consumeInitialWindow = do x <- gets initialWindow case x of Nothing -> emptyWindow Just windowInfo -> do modify $ \s -> s { initialWindow = Nothing } return windowInfo putInitialWindow :: WindowInfo -> B () putInitialWindow wi = modify $ \s -> s { initialWindow = Just wi } loadInInitialWindow :: LogDetails -> B () loadInInitialWindow = loadLogWith consumeInitialWindow loadLog :: LogDetails -> B () loadLog = loadLogWith emptyWindow openLog :: MonadIO io => LogDetails -> ExceptT LoadError io ( ([String], [DetailedEvent]) , ([String], [DetailedEvent]) ) openLog (RecordedLog filepath) = do result <- readLog filepath return (result, ([], [])) openLog (SingleLog filepath) = do result <- readLog filepath return (result, ([], [])) openLog (TwoLogs session system) = do sessionResult <- readLog session systemResult <- readLog system return (sessionResult, systemResult) loadLogWith :: B WindowInfo -- ^ action returning a window to load the log(s) in -> LogDetails -> B () loadLogWith getWindow logDetails = do windowInfo <- getWindow ret <- runExceptT $ do ((sessionWarnings, sessionMessages), (systemWarnings, systemMessages)) <- openLog logDetails -- FIXME: pass the log file name into the renderer let rr = process sessionMessages systemMessages io $ mapM warn $ sessionWarnings ++ systemWarnings ++ rrWarnings rr lift $ displayLog windowInfo logDetails sessionMessages systemMessages rr case ret of Left (LoadError f e) -> do let title = printf (__ "Could not read '%s'") f io $ displayError windowInfo title (Just e) putInitialWindow windowInfo Right () -> io $ hideError windowInfo io $ windowPresent (wiWindow windowInfo) updateRecordingSubtitle :: WindowInfo -> Int -> IO () updateRecordingSubtitle wi j = do let message = printf (__ "Logged %u messages") j :: String labelSetMarkup (wiSubtitle wi) message processBatch :: IORef [DetailedEvent] -> IORef Int -> WindowInfo -> IO (IO Bool) processBatch pendingRef n wi = do rendererStateRef <- newIORef rendererStateNew -- FIXME: this is stupid. If we have to manually combine the outputs, it's -- basically just more state. rendererResultRef <- newIORef mempty return $ do pending <- readIORef pendingRef writeIORef pendingRef [] unless (null pending) $ do rr <- atomicModifyIORef' rendererStateRef $ \s -> swap $ processSome (reverse pending) [] s oldRR <- readIORef rendererResultRef let rr' = oldRR `mappend` rr writeIORef rendererResultRef rr' unless (null (rrShapes rr)) $ do -- If the renderer produced some visible output, count it as a -- message from the user's perspective. modifyIORef' n (+ length pending) j <- readIORef n updateRecordingSubtitle wi j aChallengerAppears wi rr' return True recorderRun :: WindowInfo -> Either BusType String -> FilePath -> BustleEnv BConfig BState -> IO () recorderRun wi target filename r = C.handle newFailed $ do -- TODO: I'm pretty sure the monitor is leaked monitor <- monitorNew target filename loaderStateRef <- newIORef Map.empty pendingRef <- newIORef [] let updateLabel :: Microseconds -> Int -> GDBusMessage -> IO () updateLabel µs l msg = do s <- readIORef loaderStateRef (m, s') <- runStateT (convert µs l msg) s s' `seq` writeIORef loaderStateRef s' case m of Left e -> warn e Right message | isRelevant (deEvent message) -> modifyIORef' pendingRef (message:) | otherwise -> return () n <- newIORef (0 :: Int) processor <- processBatch pendingRef n wi processorId <- timeoutAdd processor 200 stopActivatedId <- wiStop wi `on` buttonActivated $ monitorStop monitor handlerId <- monitor `on` monitorMessageLogged $ updateLabel void $ monitor `on` monitorStopped $ \domain code message -> do handleError domain code message signalDisconnect stopActivatedId signalDisconnect handlerId -- Flush out any last messages from the queue. timeoutRemove processorId processor hadOutput <- fmap (/= 0) (readIORef n) finished hadOutput where newFailed (GError domain code message) = do finished False handleError domain code message finished hadOutput = makeCallback (finishedRecording wi filename hadOutput) r -- Filter out IoErrorCancelled. In theory one should use -- catchGErrorJust IoErrorCancelled computation (\_ -> return ()) -- but IOErrorEnum does not have an instance for GError domain. handleError domain code message = do gIoErrorQuark <- quarkFromString "g-io-error-quark" let cancelled = fromEnum IoErrorCancelled unless (domain == gIoErrorQuark && code == cancelled) $ displayError wi (Marquee.toString message) Nothing startRecording :: Either BusType String -> B () startRecording target = do wi <- consumeInitialWindow zt <- io getZonedTime -- I hate time manipulation let yyyy_mm_dd_hh_mm_ss = takeWhile (/= '.') (show zt) cacheDir <- io getCacheDir let filename = cacheDir yyyy_mm_dd_hh_mm_ss <.> "pcap" let title = printf (__ "Recording %s…") $ case target of Left BusTypeNone -> error "whoops, this value shouldn't exist" Left BusTypeSession -> "session bus" Left BusTypeSystem -> "system bus" Right address -> address io $ do hideError wi widgetHide (wiRecord wi) widgetHide (wiOpen wi) widgetShow (wiStop wi) widgetGrabFocus (wiStop wi) spinnerStart (wiSpinner wi) labelSetMarkup (wiTitle wi) (title :: String) updateRecordingSubtitle wi 0 setPage wi PleaseHoldPage embedIO $ recorderRun wi target filename aChallengerAppears :: WindowInfo -> RendererResult a -> IO () aChallengerAppears wi rr = do updateDisplayedLog wi rr canvasScrollToBottom (wiCanvas wi) setPage wi CanvasPage onMenuItemActivate :: MenuItemClass menuItem => menuItem -> IO () -> IO (ConnectId menuItem) onMenuItemActivate mi = on mi menuItemActivate finishedRecording :: WindowInfo -> FilePath -> Bool -> B () finishedRecording wi tempFilePath producedOutput = do io $ do widgetShow (wiRecord wi) widgetShow (wiOpen wi) widgetHide (wiStop wi) spinnerStop (wiSpinner wi) if producedOutput then void $ do -- TODO: There is a noticable lag when reloading big files. It would be -- nice to either make the loading faster, or eliminate the reload. loadLogWith (return wi) (RecordedLog tempFilePath) let saveItem = wiSave wi io $ do widgetSetSensitivity saveItem True saveItem `on` buttonActivated $ showSaveDialog wi (return ()) else do setPage wi InstructionsPage putInitialWindow wi updateDisplayedLog wi (mempty :: RendererResult ()) io $ do wiTitle wi `set` [ labelText := "" ] wiSubtitle wi `set` [ labelText := "" ] showSaveDialog :: WindowInfo -> IO () -> IO () showSaveDialog wi savedCb = do Just (RecordedLog tempFilePath) <- readIORef (wiLogDetails wi) let mwindow = Just (wiWindow wi) tempFileName = takeFileName tempFilePath recorderChooseFile tempFileName mwindow $ \newFilePath -> do let tempFile = fileFromParseName tempFilePath let newFile = fileFromParseName newFilePath result <- C.try $ fileMove tempFile newFile [FileCopyOverwrite] Nothing Nothing case result of Right _ -> do widgetSetSensitivity (wiSave wi) False wiSetLogDetails wi (SingleLog newFilePath) hideError wi savedCb Left (GError _ _ msg) -> do let title = __ "Couldn't save log: " ++ Marquee.toString msg secondary = printf (__ "You might want to manually recover the log from the temporary file at \ \\"%s\".") tempFilePath displayError wi title (Just secondary) maybeQuit :: B () maybeQuit = do n <- decWindows when (n == 0) (io mainQuit) emptyWindow :: B WindowInfo emptyWindow = do builder <- io builderNew io $ builderAddFromFile builder =<< getDataFileName "data/bustle.ui" -- Grab a bunch of widgets. Surely there must be a better way to do this? let getW cast name = io $ builderGetObject builder cast name window <- getW castToWindow "diagramWindow" title <- getW castToLabel "headerTitle" subtitle <- getW castToLabel "headerSubtitle" spinner <- getW castToSpinner "headerSpinner" openItem <- getW castToMenuItem "open" openTwoItem <- getW castToMenuItem "openTwo" recordSessionItem <- getW castToMenuItem "recordSession" recordSystemItem <- getW castToMenuItem "recordSystem" recordAddressItem <- getW castToMenuItem "recordAddress" headerRecord <- getW castToButton "headerRecord" headerStop <- getW castToButton "headerStop" headerOpen <- getW castToButton "headerOpen" headerSave <- getW castToButton "headerSave" headerExport <- getW castToButton "headerExport" viewStatistics <- getW castToCheckMenuItem "statistics" filterNames <- getW castToMenuItem "filter" aboutItem <- getW castToMenuItem "about" errorBar <- getW castToInfoBar "errorBar" errorBarTitle <- getW castToLabel "errorBarTitle" errorBarDetails <- getW castToLabel "errorBarDetails" io $ errorBar `on` infoBarResponse $ \_ -> widgetHide errorBar stack <- getW castToStack "diagramOrNot" sidebarHeader <- getW castToWidget "sidebarHeader" sidebarStack <- getW castToStack "sidebarStack" contentPaned <- getW castToPaned "contentPaned" -- Open two logs dialog openTwoDialog <- embedIO $ \r -> setupOpenTwoDialog window $ \f1 f2 -> makeCallback (loadInInitialWindow (TwoLogs f1 f2)) r -- Set up the window itself embedIO $ (window `on` objectDestroy) . makeCallback maybeQuit -- File menu and related buttons embedIO $ \r -> do onMenuItemActivate recordSessionItem $ makeCallback (startRecording (Left BusTypeSession)) r onMenuItemActivate recordSystemItem $ makeCallback (startRecording (Left BusTypeSystem)) r onMenuItemActivate recordAddressItem $ showRecordAddressDialog window $ \address -> makeCallback (startRecording (Right address)) r onMenuItemActivate openItem $ makeCallback (showOpenDialog window) r onMenuItemActivate openTwoItem $ widgetShowAll openTwoDialog -- TODO: really this wants to live in the application menu, but that entails binding GApplication, -- GtkApplication, GMenu, GActionMap, GActionEntry, ... -- -- Similarly, the drop-down menus would look better as popovers. But here we are. io $ onMenuItemActivate aboutItem $ showAboutDialog window statsPane <- io $ statsPaneNew builder details <- io $ detailsViewNew builder -- The stats start off hidden. io $ widgetHide sidebarStack showBounds <- asks debugEnabled canvas <- io $ canvasNew builder showBounds (updateDetailsView details) logDetailsRef <- io $ newIORef Nothing let windowInfo = WindowInfo { wiWindow = window , wiTitle = title , wiSubtitle = subtitle , wiSpinner = spinner , wiRecord = headerRecord , wiOpen = headerOpen , wiStop = headerStop , wiSave = headerSave , wiExport = headerExport , wiViewStatistics = viewStatistics , wiFilterNames = filterNames , wiErrorBar = errorBar , wiErrorBarTitle = errorBarTitle , wiErrorBarDetails = errorBarDetails , wiStack = stack , wiSidebarHeader = sidebarHeader , wiSidebarStack = sidebarStack , wiStatsPane = statsPane , wiContentPaned = contentPaned , wiCanvas = canvas , wiDetailsView = details , wiLogDetails = logDetailsRef } incWindows io $ widgetShow window return windowInfo updateDetailsView :: DetailsView -> Maybe (Detailed Message) -> IO () updateDetailsView detailsView newMessage = case newMessage of Nothing -> widgetHide $ detailsViewGetTop detailsView Just m -> do detailsViewUpdate detailsView m widgetShow $ detailsViewGetTop detailsView updateDisplayedLog :: MonadIO io => WindowInfo -> RendererResult a -> io () updateDisplayedLog wi rr = io $ do let shapes = rrShapes rr regions = rrRegions rr canvas = wiCanvas wi (windowWidth, _) <- windowGetSize (wiWindow wi) canvasSetShapes canvas shapes regions (rrCentreOffset rr) windowWidth splitFileName_ :: String -> (String, String) splitFileName_ s = (dropTrailingPathSeparator d, f) where (d, f) = splitFileName s logWindowTitle :: LogDetails -> (String, String) logWindowTitle (RecordedLog filepath) = ("*" ++ takeFileName filepath, "") logWindowTitle (SingleLog filepath) = (name, directory) where (directory, name) = splitFileName_ filepath logWindowTitle (TwoLogs sessionPath systemPath) = -- TODO: this looks terrible, need a custom widget (sessionName ++ " & " ++ systemName, if sessionDirectory == systemDirectory then sessionDirectory else sessionDirectory ++ " & " ++ systemDirectory) where (sessionDirectory, sessionName) = splitFileName_ sessionPath (systemDirectory, systemName ) = splitFileName_ systemPath logTitle :: LogDetails -> String logTitle (RecordedLog filepath) = dropExtension $ takeFileName filepath logTitle (SingleLog filepath) = dropExtension $ takeFileName filepath logTitle (TwoLogs sessionPath systemPath) = intercalate " & " . map (dropExtension . takeFileName) $ [sessionPath, systemPath] wiSetLogDetails :: WindowInfo -> LogDetails -> IO () wiSetLogDetails wi logDetails = do writeIORef (wiLogDetails wi) (Just logDetails) let (title, subtitle) = logWindowTitle logDetails wiWindow wi `set` [ windowTitle := title ] wiTitle wi `set` [ labelText := title ] wiSubtitle wi `set` [ labelText := subtitle ] setPage :: MonadIO io => WindowInfo -> Page -> io () setPage wi page = io $ stackSetVisibleChildName (wiStack wi) (show page) displayLog :: WindowInfo -> LogDetails -> Log -> Log -> RendererResult Participants -> B () displayLog wi@WindowInfo { wiWindow = window , wiExport = exportItem , wiViewStatistics = viewStatistics , wiFilterNames = filterNames , wiCanvas = canvas , wiSidebarHeader = sidebarHeader , wiSidebarStack = sidebarStack , wiStatsPane = statsPane } logDetails sessionMessages systemMessages rr = io $ void $ do wiSetLogDetails wi logDetails nameFilterRef <- newIORef emptyNameFilter updateDisplayedLog wi rr widgetSetSensitivity exportItem True exportItem `on` buttonActivated $ do shapes <- canvasGetShapes canvas saveToPDFDialogue wi shapes setPage wi CanvasPage canvasFocus canvas -- FIXME: this currently shows stats for all messages, not post-filtered messages statsPaneSetMessages statsPane sessionMessages systemMessages widgetSetSensitivity viewStatistics True viewStatistics `on` checkMenuItemToggled $ do active <- checkMenuItemGetActive viewStatistics if active then do widgetShow sidebarStack widgetShow sidebarHeader else do widgetHide sidebarStack widgetHide sidebarHeader widgetSetSensitivity filterNames True onMenuItemActivate filterNames $ -- FIXME: also allow filtering system bus in two-bus case runFilterDialog window (sessionParticipants $ rrApplications rr) nameFilterRef $ do nameFilter <- readIORef nameFilterRef let rr' = processWithFilters (sessionMessages, nameFilter) (systemMessages, emptyNameFilter) updateDisplayedLog wi rr' showOpenDialog :: Window -> B () showOpenDialog window = embedIO $ \r -> do chooser <- fileChooserDialogNew Nothing (Just window) FileChooserActionOpen [ ("gtk-cancel", ResponseCancel) , ("gtk-open", ResponseAccept) ] chooser `set` [ windowModal := True , fileChooserLocalOnly := True ] chooser `after` response $ \resp -> do when (resp == ResponseAccept) $ do Just fn <- fileChooserGetFilename chooser makeCallback (loadInInitialWindow (SingleLog fn)) r widgetDestroy chooser widgetShowAll chooser saveToPDFDialogue :: WindowInfo -> Diagram -> IO () saveToPDFDialogue wi shapes = do let parent = Just (wiWindow wi) chooser <- fileChooserDialogNew Nothing parent FileChooserActionSave [ ("gtk-cancel", ResponseCancel) , ("gtk-save", ResponseAccept) ] chooser `set` [ windowModal := True , fileChooserLocalOnly := True , fileChooserDoOverwriteConfirmation := True ] Just logDetails <- readIORef $ wiLogDetails wi let filename = logTitle logDetails <.> "pdf" fileChooserSetCurrentName chooser filename -- If the currently-loaded log has a meaningful directory, suggest that as -- the default. let mdirectory = case logDetails of RecordedLog _ -> Nothing SingleLog p -> Just $ takeDirectory p TwoLogs p _ -> Just $ takeDirectory p forM_ mdirectory $ fileChooserSetCurrentFolder chooser chooser `after` response $ \resp -> do when (resp == ResponseAccept) $ do Just fn <- io $ fileChooserGetFilename chooser let (width, height) = diagramDimensions shapes r <- C.try $ withPDFSurface fn width height $ \surface -> renderWith surface $ drawDiagram False shapes case r of Left (e :: C.IOException) -> do let title = __ "Couldn't export log as PDF: " ++ show e displayError wi title Nothing Right () -> hideError wi widgetDestroy chooser widgetShowAll chooser displayError :: WindowInfo -> String -> Maybe String -> IO () displayError wi title mbody = do labelSetMarkup (wiErrorBarTitle wi) . Marquee.toPangoMarkup . Marquee.b $ Marquee.escape title let details = wiErrorBarDetails wi case mbody of Just body -> do labelSetMarkup details . Marquee.toPangoMarkup . Marquee.small $ Marquee.escape body widgetShow details Nothing -> widgetHide details widgetShow $ wiErrorBar wi hideError :: WindowInfo -> IO () hideError = widgetHide . wiErrorBar -- vim: sw=2 sts=2 bustle-0.8.0/Bustle/UI/AboutDialog.hs0000644000000000000000000000501613710546274015517 0ustar0000000000000000{- Bustle.UI.AboutDialog: just the about dialog… Copyright © 2008–2012 Collabora Ltd. 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.UI.AboutDialog ( showAboutDialog ) where import Prelude import Data.Version (showVersion) import Control.Exception import Control.Monad (when) import Graphics.UI.Gtk import Bustle.Translation (__) import Bustle.Util import Paths_bustle showAboutDialog :: Window -> IO () showAboutDialog window = do dialog <- aboutDialogNew license <- (Just `fmap` (readFile =<< getDataFileName "LICENSE")) `catch` (\e -> warn (show (e :: IOException)) >> return Nothing) dialog `set` [ aboutDialogName := __ "Bustle" , aboutDialogVersion := showVersion version , aboutDialogComments := __ "Someone's favourite D-Bus profiler" , aboutDialogWebsite := "https://gitlab.freedesktop.org/bustle/bustle#readme" , aboutDialogAuthors := authors , aboutDialogArtists := artists , aboutDialogCopyright := "© 2008–2017 Will Thompson, Collabora Ltd. and contributors" , aboutDialogLicense := license , aboutDialogLogoIconName := Just "org.freedesktop.Bustle" , windowModal := True , windowTransientFor := window ] dialog `after` response $ \resp -> when (resp == ResponseCancel) (widgetDestroy dialog) widgetShowAll dialog authors :: [String] authors = [ "Will Thompson " , "Dafydd Harries" , "Chris Lamb" , "Marc Kleine-Budde" , "Cosimo Alfarano" , "Sergei Trofimovich" , "Alex Merry" , "Philip Withnall" , "Jonny Lamb" , "Daniel Firth" ] artists :: [String] artists = [ "Tobias Bernard" ] bustle-0.8.0/Bustle/UI/Canvas.hs0000644000000000000000000002203513700421730014524 0ustar0000000000000000{- Bustle.UI.Canvas: displays diagrams Copyright © 2008–2012 Collabora Ltd. 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 OverloadedStrings #-} module Bustle.UI.Canvas ( Canvas , canvasNew , canvasGetShapes , canvasSetShapes , canvasFocus , canvasScrollToBottom ) where import Data.Maybe (isNothing) import Data.IORef import Control.Monad (forM_, when, void) import Graphics.UI.Gtk import Graphics.Rendering.Cairo (Render, translate) import Bustle.Diagram import Bustle.Regions import Bustle.Util data Canvas a = Canvas { canvasLayout :: Layout , canvasClampIdleId :: IORef (Maybe HandlerId) , canvasShapes :: IORef Diagram , canvasWidth :: IORef Double , canvasSelection :: IORef (RegionSelection a) , canvasSelectionChangedCb :: Maybe a -> IO () , canvasShowBounds :: Bool } canvasNew :: Eq a => Builder -> Bool -> (Maybe a -> IO ()) -> IO (Canvas a) canvasNew builder showBounds selectionChangedCb = do layout <- builderGetObject builder castToLayout ("diagramLayout" :: String) idRef <- newIORef Nothing shapesRef <- newIORef [] widthRef <- newIORef 0 rsRef <- newIORef $ regionSelectionNew [] let canvas = Canvas layout idRef shapesRef widthRef rsRef selectionChangedCb showBounds setupCanvas canvas return canvas -- Add/remove one step/page increment from an Adjustment, limited to the top of -- the last page. incStep, decStep, incPage{-, decPage -} :: Adjustment -> IO () incStep = incdec (+) adjustmentGetStepIncrement decStep = incdec (-) adjustmentGetStepIncrement incPage = incdec (+) adjustmentGetPageIncrement --decPage = incdec (-) adjustmentGetPageIncrement incdec :: (Double -> Double -> Double) -- How to combine the increment -> (Adjustment -> IO Double) -- Action to discover the increment -> Adjustment -> IO () incdec (+-) f adj = do pos <- adjustmentGetValue adj step <- f adj page <- adjustmentGetPageSize adj lim <- adjustmentGetUpper adj adjustmentSetValue adj $ min (pos +- step) (lim - page) setupCanvas :: Eq a => Canvas a -> IO () setupCanvas canvas = void $ do let layout = canvasLayout canvas -- Scrolling hadj <- layoutGetHAdjustment layout vadj <- layoutGetVAdjustment layout adjustmentSetStepIncrement hadj eventHeight adjustmentSetStepIncrement vadj eventHeight layout `on` keyPressEvent $ tryEvent $ do [] <- eventModifier key <- eventKeyName case key of "Left" -> io $ decStep hadj "Right" -> io $ incStep hadj "space" -> io $ incPage vadj _ -> stopEvent let updateWith f = io $ canvasUpdateSelection canvas f -- Clicking layout `on` buttonPressEvent $ tryEvent $ do io $ layout `set` [ widgetIsFocus := True ] LeftButton <- eventButton (_, y) <- eventCoordinates updateWith (regionSelectionUpdate y) -- Keyboard navigation layout `on` keyPressEvent $ tryEvent $ do [] <- eventModifier key <- eventKeyName case key of "Up" -> updateWith regionSelectionUp "Down" -> updateWith regionSelectionDown "Home" -> updateWith regionSelectionFirst "End" -> updateWith regionSelectionLast _ -> stopEvent layout `on` draw $ canvasDraw canvas canvasInvalidateArea :: Canvas a -> Int -> Int -> Int -> Int -> IO () canvasInvalidateArea canvas x1 y1 x2 y2 = do let layout = canvasLayout canvas realized <- widgetGetRealized layout when realized $ do win <- layoutGetDrawWindow layout let pangoRectangle = Rectangle x1 y1 x2 y2 drawWindowInvalidateRect win pangoRectangle False canvasInvalidateStripe :: Canvas a -> Stripe -> IO () canvasInvalidateStripe canvas (Stripe y1 y2) = do let layout = canvasLayout canvas realized <- widgetGetRealized layout -- We only need to invalidate ourself if we're actually on the screen when realized $ do win <- layoutGetDrawWindow layout (width, _height) <- layoutGetSize layout let pangoRectangle = Rectangle 0 (floor y1) width (ceiling y2) drawWindowInvalidateRect win pangoRectangle False canvasClampAroundSelection :: Canvas a -> IO () canvasClampAroundSelection canvas = do let idRef = canvasClampIdleId canvas id_ <- readIORef idRef when (isNothing id_) $ do id' <- flip idleAdd priorityDefaultIdle $ do rs <- readIORef $ canvasSelection canvas forM_ (rsCurrent rs) $ \(Stripe top bottom, _) -> do vadj <- layoutGetVAdjustment $ canvasLayout canvas let padding = (bottom - top) / 2 adjustmentClampPage vadj (top - padding) (bottom + padding) writeIORef idRef Nothing return False writeIORef idRef (Just id') canvasGetSelection :: Canvas a -> IO (Maybe (Stripe, a)) canvasGetSelection canvas = do rs <- readIORef $ canvasSelection canvas return $ rsCurrent rs canvasUpdateSelection :: Eq a => Canvas a -> (RegionSelection a -> RegionSelection a) -> IO () canvasUpdateSelection canvas f = do let regionSelectionRef = canvasSelection canvas rs <- readIORef regionSelectionRef let currentMessage = rsCurrent rs rs' = f rs newMessage = rsCurrent rs' writeIORef regionSelectionRef rs' when (newMessage /= currentMessage) $ do forM_ currentMessage $ \(r, _) -> canvasInvalidateStripe canvas r forM_ newMessage $ \(r, _) -> do canvasInvalidateStripe canvas r canvasClampAroundSelection canvas canvasSelectionChangedCb canvas (fmap snd newMessage) canvasSetShapes :: Eq a => Canvas a -> Diagram -> Regions a -> Double -- Yuck. These shouldn't be here. -> Int -- No no no! -> IO () canvasSetShapes canvas shapes regions centreOffset windowWidth = do let (width, height) = diagramDimensions shapes layout = canvasLayout canvas writeIORef (canvasShapes canvas) shapes writeIORef (canvasWidth canvas) width canvasUpdateSelection canvas $ \rs -> let rs' = regionSelectionNew regions in case rsCurrent rs of Just (_, x) -> regionSelectionSelect x rs' Nothing -> rs' layoutSetSize layout (floor width) (floor height) canvasInvalidateArea canvas 0 0 (floor width) (floor height) -- FIXME: only do this the first time maybe? -- Shift to make the timestamp column visible hadj <- layoutGetHAdjustment layout -- Roughly centre the timestamp-and-member column adjustmentSetValue hadj (centreOffset - (fromIntegral windowWidth - timestampAndMemberWidth) / 2 ) canvasGetShapes :: Canvas a -> IO Diagram canvasGetShapes = readIORef . canvasShapes -- | Redraws the currently-visible area of the canvas canvasDraw :: Canvas a -> Render () canvasDraw canvas = do current <- io $ canvasGetSelection canvas shapes <- io $ canvasGetShapes canvas width <- io $ readIORef $ canvasWidth canvas let shapes' = case current of Nothing -> shapes Just (Stripe y1 y2, _) -> Highlight (0, y1, width, y2):shapes let layout = canvasLayout canvas hadj <- io $ layoutGetHAdjustment layout hpos <- io $ adjustmentGetValue hadj hpage <- io $ adjustmentGetPageSize hadj vadj <- io $ layoutGetVAdjustment layout vpos <- io $ adjustmentGetValue vadj vpage <- io $ adjustmentGetPageSize vadj let r = (hpos, vpos, hpos + hpage, vpos + vpage) translate (-hpos) (-vpos) drawRegion r (canvasShowBounds canvas) shapes' canvasFocus :: Canvas a -> IO () canvasFocus canvas = canvasLayout canvas `set` [ widgetIsFocus := True ] canvasScrollToBottom :: Canvas a -> IO () canvasScrollToBottom canvas = do vadj <- layoutGetVAdjustment (canvasLayout canvas) page <- adjustmentGetPageSize vadj lim <- adjustmentGetUpper vadj adjustmentSetValue vadj (max 0 (lim - page)) bustle-0.8.0/Bustle/UI/DetailsView.hs0000644000000000000000000001136213710546303015537 0ustar0000000000000000{- Bustle.UI.DetailsView: displays the bodies of D-Bus messages Copyright © 2011–2012 Collabora Ltd. 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.UI.DetailsView ( DetailsView , detailsViewNew , detailsViewGetTop , detailsViewUpdate ) where import Control.Monad.Trans (liftIO) import Control.Monad.Trans.Maybe (MaybeT(..)) import Graphics.UI.Gtk hiding (Signal) import Bustle.Types import Bustle.Marquee import Bustle.GDBusMessage type OptionalRow = (Label, Label) data DetailsView = DetailsView { detailsGrid :: Grid , detailsType :: Stack , detailsSender :: Label , detailsDestination :: OptionalRow , detailsPath :: Label , detailsMember :: Label , detailsErrorName :: OptionalRow , detailsBodyView :: TextView } detailsViewNew :: Builder -> IO DetailsView detailsViewNew builder = DetailsView <$> builderGetObject builder castToGrid "detailsGrid" <*> builderGetObject builder castToStack "detailsType" <*> builderGetObject builder castToLabel "detailsSender" <*> optionalRow "detailsDestination" <*> builderGetObject builder castToLabel "detailsPath" <*> builderGetObject builder castToLabel "detailsMember" <*> optionalRow "detailsErrorName" <*> builderGetObject builder castToTextView "detailsArguments" where optionalRow labelId = (,) <$> builderGetObject builder castToLabel (labelId ++ "Caption") <*> builderGetObject builder castToLabel labelId pickType :: Detailed Message -> String pickType (Detailed _ m _ _) = case m of MethodCall {} -> "methodCall" MethodReturn {} -> "methodReturn" Error {} -> "error" Signal { signalDestination = d } -> maybe "signal" (const "directedSignal") d getMemberMarkup :: Member -> String getMemberMarkup m = toPangoMarkup $ formatMember (iface m) (membername m) getMember :: Detailed Message -> Maybe Member getMember (Detailed _ m _ _) = case m of MethodCall {} -> Just $ member m Signal {} -> Just $ member m MethodReturn {} -> callMember Error {} -> callMember where callMember = member . deEvent <$> inReplyTo m getDestination :: Detailed Message -> Maybe TaggedBusName getDestination (Detailed _ m _ _) = case m of Signal { signalDestination = d } -> d _ -> Just (destination m) 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 formatErrorMessage :: IO (Maybe String) formatErrorMessage = runMaybeT $ do MessageTypeError <- liftIO $ messageType m MaybeT $ messageGetBodyString m 0 detailsViewGetTop :: DetailsView -> Widget detailsViewGetTop = toWidget . detailsGrid setOptionalRow :: OptionalRow -> Maybe String -> IO () setOptionalRow (caption, label) (Just s) = do labelSetText label s widgetShow label widgetShow caption setOptionalRow (caption, label) Nothing = do widgetHide label widgetHide caption detailsViewUpdate :: DetailsView -> Detailed Message -> IO () detailsViewUpdate d m = do buf <- textViewGetBuffer $ detailsBodyView d let member_ = getMember m stackSetVisibleChildName (detailsType d) (pickType m) -- TODO: these would be a lot more useful if we could resolve unique names -- 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 labelSetText (detailsPath d) (maybe unknown (formatObjectPath . path) member_) labelSetMarkup (detailsMember d) (maybe unknown getMemberMarkup member_) textBufferSetText buf =<< formatMessage m where unknown = "" bustle-0.8.0/Bustle/UI/FilterDialog.hs0000644000000000000000000001653313700421730015664 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {- Bustle.UI.FilterDialog: allows the user to filter the displayed log Copyright © 2011 Collabora Ltd. Copyright © 2019 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.UI.FilterDialog ( runFilterDialog ) where import Control.Monad (forM_) import Data.List (intercalate, groupBy, elemIndices, elemIndex) import qualified Data.Set as Set import Data.Set (Set) import qualified Data.Function as F import Data.IORef import Graphics.UI.Gtk import Graphics.UI.Gtk.ModelView.CellRendererCombo (cellComboTextModel) import Bustle.Translation (__) import Bustle.Types import Paths_bustle data NameVisibility = NameVisibilityDefault | NameVisibilityOnly | NameVisibilityNever deriving (Show, Eq, Ord, Enum, Bounded) nameVisibilityName :: NameVisibility -> String nameVisibilityName v = case v of NameVisibilityDefault -> __ "Default" NameVisibilityOnly -> __ "Only this" NameVisibilityNever -> __ "Hidden" data NameEntry = NameEntry { neUniqueName :: UniqueName , neOtherNames :: Set OtherName , neVisibility :: NameVisibility } namespace :: String -> (String, String) namespace name = case reverse (elemIndices '.' name) of [] -> ("", name) (i:_) -> splitAt (i + 1) name formatNames :: NameEntry -> String formatNames ne | Set.null os = unUniqueName (neUniqueName ne) | otherwise = intercalate "\n" . map (formatGroup . groupGroup) $ groups where os = neOtherNames ne groups = groupBy ((==) `F.on` fst) . map (namespace . unOtherName) $ Set.toAscList os groupGroup [] = error "unpossible empty group from groupBy" groupGroup xs@((ns, _):_) = (ns, map snd xs) formatGroup (ns, [y]) = ns ++ y formatGroup (ns, ys) = ns ++ "{" ++ intercalate "," ys ++ "}" type NameStore = ListStore NameEntry makeStore :: [(UniqueName, Set OtherName)] -> NameFilter -> IO NameStore makeStore names nameFilter = listStoreNew $ map toNameEntry names where toNameEntry (u, os) = NameEntry { neUniqueName = u , neOtherNames = os , neVisibility = toVisibility u } toVisibility u | Set.member u (nfOnly nameFilter) = NameVisibilityOnly | Set.member u (nfNever nameFilter) = NameVisibilityNever | otherwise = NameVisibilityDefault nameStoreUpdate :: NameStore -> Int -> (NameEntry -> NameEntry) -> IO () nameStoreUpdate nameStore i f = do ne <- listStoreGetValue nameStore i listStoreSetValue nameStore i $ f ne makeView :: NameStore -> TreeView -> IO () makeView nameStore nameView = do treeViewSetModel nameView (Just nameStore) -- Bus name column nameCell <- cellRendererTextNew nameColumn <- treeViewColumnNew nameColumn `set` [ treeViewColumnTitle := __ "Bus Name" , treeViewColumnExpand := True ] treeViewColumnPackStart nameColumn nameCell True treeViewAppendColumn nameView nameColumn cellLayoutSetAttributes nameColumn nameCell nameStore $ \ne -> [ cellText := formatNames ne ] -- TreeStore of possible visibility states let nameVisibilities = [minBound..] let nameVisibilityNames = map nameVisibilityName nameVisibilities visibilityModel <- listStoreNew nameVisibilityNames let visibilityNameCol = makeColumnIdString 1 treeModelSetColumn visibilityModel visibilityNameCol id -- Visibility column comboCell <- cellRendererComboNew comboCell `set` [ cellTextEditable := True , cellComboHasEntry := False ] comboColumn <- treeViewColumnNew comboColumn `set` [ treeViewColumnTitle := __ "Visibility" , treeViewColumnExpand := False ] treeViewColumnPackStart comboColumn comboCell True treeViewAppendColumn nameView comboColumn cellLayoutSetAttributes comboColumn comboCell nameStore $ \ne -> [ cellComboTextModel := (visibilityModel, visibilityNameCol) , cellText :=> do let Just j = elemIndex (neVisibility ne) nameVisibilities listStoreGetValue visibilityModel j ] comboCell `on` edited $ \[i] str -> do let (Just j) = elemIndex str nameVisibilityNames nameStoreUpdate nameStore i $ \ne -> ne { neVisibility = nameVisibilities !! j } return () runFilterDialog :: WindowClass parent => parent -- ^ The window to which to attach the dialog -> [(UniqueName, Set OtherName)] -- ^ Names, in order of appearance -> IORef NameFilter -- ^ Current filter -> IO () -- ^ Callback when filter changes -> IO () runFilterDialog parent names filterRef callback = do builder <- builderNew builderAddFromFile builder =<< getDataFileName "data/FilterDialog.ui" d <- builderGetObject builder castToDialog ("filterDialog" :: String) (_, windowHeight) <- windowGetSize parent windowSetDefaultSize d (-1) (windowHeight * 3 `div` 4) d `set` [ windowTransientFor := parent ] nameStore <- makeStore names =<< readIORef filterRef makeView nameStore =<< builderGetObject builder castToTreeView ("filterTreeView" :: String) resetButton <- builderGetObject builder castToButton ("resetButton" :: String) resetButton `on` buttonActivated $ do n <- listStoreGetSize nameStore forM_ [0..n-1] $ \i -> do ne <- listStoreGetValue nameStore i case neVisibility ne of NameVisibilityDefault -> return () _ -> listStoreSetValue nameStore i $ ne { neVisibility = NameVisibilityDefault } let updateResetSensitivity = do nf <- readIORef filterRef let isEmpty = Set.null (nfOnly nf) && Set.null (nfNever nf) widgetSetSensitive resetButton $ not isEmpty updateResetSensitivity nameStore `on` rowChanged $ \[i] _iter -> do ne <- listStoreGetValue nameStore i let u = neUniqueName ne -- Should we smush this into nameFilterModify, move the enum into -- Bustle.Types? let f = case neVisibility ne of NameVisibilityDefault -> nameFilterRemove NameVisibilityOnly -> nameFilterAddOnly NameVisibilityNever -> nameFilterAddNever modifyIORef' filterRef $ f u updateResetSensitivity callback _ <- dialogRun d widgetDestroy d bustle-0.8.0/Bustle/UI/OpenTwoDialog.hs0000644000000000000000000000675013700421730016032 0ustar0000000000000000{- Bustle.UI.OpenTwoDialog: a dialog to prompt the user to open two log files Copyright © 2008–2012 Collabora Ltd. 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.UI.OpenTwoDialog ( setupOpenTwoDialog ) where import Data.Maybe (isJust, isNothing, fromJust) import Control.Monad (when, void) import Graphics.UI.Gtk import Bustle.Util import Paths_bustle -- Propagates changes to d1's currently-selected folder to d2, if and only if -- d2 doesn't have a currently-selected file (otherwise, choosing a file -- from a different directory in the second chooser would unselect a -- previously-selected file in the first). propagateCurrentFolder :: FileChooserClass chooser => chooser -> chooser -> IO (ConnectId chooser) propagateCurrentFolder d1 d2 = d1 `on` currentFolderChanged $ do f1 <- fileChooserGetCurrentFolder d1 f2 <- fileChooserGetCurrentFolder d2 otherFile <- fileChooserGetFilename d2 when (isNothing otherFile && f1 /= f2 && isJust f1) $ void $ fileChooserSetCurrentFolder d2 (fromJust f1) setupOpenTwoDialog :: Window -> (FilePath -> FilePath -> IO ()) -> IO Dialog setupOpenTwoDialog parent callback = do builder <- builderNew builderAddFromFile builder =<< getDataFileName "data/OpenTwoDialog.ui" dialog <- builderGetObject builder castToDialog "openTwoDialog" [sessionBusChooser, systemBusChooser] <- mapM (builderGetObject builder castToFileChooserButton) ["sessionBusChooser", "systemBusChooser"] openTwoOpenButton <- builderGetObject builder castToButton "openTwoOpenButton" dialog `set` [ windowTransientFor := parent ] dialog `on` deleteEvent $ tryEvent $ io $ widgetHide dialog propagateCurrentFolder sessionBusChooser systemBusChooser propagateCurrentFolder systemBusChooser sessionBusChooser let hideMyself = do widgetHide dialog fileChooserUnselectAll sessionBusChooser fileChooserUnselectAll systemBusChooser let updateOpenSensitivity = do sessionLogFile <- fileChooserGetFilename sessionBusChooser systemLogFile <- fileChooserGetFilename systemBusChooser widgetSetSensitive openTwoOpenButton $ case (sessionLogFile, systemLogFile) of (Just _, Just _) -> True _ -> False connectGeneric "file-set" False sessionBusChooser updateOpenSensitivity connectGeneric "file-set" False systemBusChooser updateOpenSensitivity updateOpenSensitivity dialog `after` response $ \resp -> do when (resp == ResponseAccept) $ do Just f1 <- fileChooserGetFilename sessionBusChooser Just f2 <- fileChooserGetFilename systemBusChooser callback f1 f2 hideMyself return dialog bustle-0.8.0/Bustle/UI/RecordAddressDialog.hs0000644000000000000000000000406113700421730017154 0ustar0000000000000000{- Bustle.UI.RecordAddressDialog: a dialog to prompt the user to open two log files Copyright © 2018 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.UI.RecordAddressDialog ( showRecordAddressDialog ) where import Control.Monad (when) import Data.Text (Text) import Graphics.UI.Gtk import System.Glib.UTFString (stringLength) import Paths_bustle showRecordAddressDialog :: Window -> (String -> IO ()) -> IO () showRecordAddressDialog parent callback = do builder <- builderNew builderAddFromFile builder =<< getDataFileName "data/RecordAddressDialog.ui" dialog <- builderGetObject builder castToDialog "recordAddressDialog" entry <- builderGetObject builder castToEntry "recordAddressEntry" record <- builderGetObject builder castToButton "recordAddressRecord" dialog `set` [ windowTransientFor := parent ] entry `on` editableChanged $ do address <- entryGetText entry -- TODO: validate with g_dbus_is_suppported_address() once -- https://gitlab.gnome.org/GNOME/glib/merge_requests/103 is in a -- release. widgetSetSensitive record (stringLength (address :: Text) /= 0) dialog `after` response $ \resp -> do when (resp == ResponseAccept) $ do address <- entryGetText entry callback address widgetDestroy dialog widgetShowAll dialog bustle-0.8.0/Bustle/UI/Recorder.hs0000644000000000000000000000334713700421730015063 0ustar0000000000000000{- Bustle.UI.Recorder: dialogs for driving Bustle.Monitor Copyright © 2012 Collabora Ltd. Copyright © 2018 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.UI.Recorder ( recorderChooseFile ) where import Graphics.UI.Gtk import Control.Monad (when) -- TODO: shouldn't be here recorderChooseFile :: FilePath -> Maybe Window -> (FilePath -> IO ()) -> IO () recorderChooseFile name mwindow callback = do chooser <- fileChooserDialogNew Nothing mwindow FileChooserActionSave [ ("gtk-cancel", ResponseCancel) , ("gtk-new", ResponseAccept) ] fileChooserSetCurrentName chooser name chooser `set` [ windowModal := True , fileChooserLocalOnly := True , fileChooserDoOverwriteConfirmation := True ] chooser `after` response $ \resp -> do when (resp == ResponseAccept) $ do Just fn <- fileChooserGetFilename chooser callback fn widgetDestroy chooser widgetShowAll chooser bustle-0.8.0/Bustle/Util.hs0000644000000000000000000000353513700421730013715 0ustar0000000000000000{-# LANGUAGE ForeignFunctionInterface #-} {- Bustle.Util: miscellaneous utility functions Copyright © 2008–2012 Collabora Ltd. 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.Util ( io , warn , getCacheDir -- You probably don't actually want to use this function. , traceM ) where import Control.Monad.Trans (MonadIO, liftIO) import Control.Monad import Debug.Trace (trace) import System.IO (hPutStrLn, stderr) import Foreign.C.String import System.Directory import System.FilePath (()) import Bustle.Translation (__) -- Escape hatch to log a value from a non-IO monadic context. traceM :: (Show a, Monad m) => a -> m () traceM = void . return . trace . show -- Log a warning which isn't worth showing to the user, but which might -- interest someone debugging the application. warn :: String -> IO () warn = hPutStrLn stderr . (__ "Warning: " ++) -- Shorthand for liftIO. io :: MonadIO m => IO a -> m a io = liftIO foreign import ccall "g_get_user_cache_dir" g_get_user_cache_dir :: IO CString getCacheDir :: IO FilePath getCacheDir = do dotCache <- peekCString =<< g_get_user_cache_dir let dir = dotCache "bustle" createDirectoryIfMissing True dir return dir bustle-0.8.0/c-sources/pcap-reader.c0000644000000000000000000002041113710546303015435 0ustar0000000000000000/* * 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 #include #include #include #include #include #include #include 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); } bustle-0.8.0/c-sources/pcap-monitor.c0000644000000000000000000007327313710546303015700 0ustar0000000000000000/* * pcap-monitor.c - monitors a bus and dumps messages to a pcap file * Copyright © 2011–2012 Collabora Ltd. * Copyright © 2018 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-monitor.h" #include #include #include #include #include #include #include #include #include #include #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."; static gboolean RUNNING_IN_FLATPAK = FALSE; /* * Transitions: * * NEW --[ initable_init() errors ]--> STOPPED * NEW --[ initable_init() ]--> STARTING * * STARTING --[ start_pcap() ]--> RUNNING * STARTING --[ error ]--> STOPPING * * RUNNING --[ user request/error ]--> STOPPING * * STOPPING --[ all finished ]--> STOPPED */ typedef enum { /* Nothing's happened yet */ STATE_NEW, /* We're waiting to read the pcap header from the subprocess */ STATE_STARTING, /* We've read the pcap header, messages are flowing freely */ STATE_RUNNING, /* Error or user request is causing us to stop; we're waiting to consume * everything from the pipe and for the dbus-monitor subprocess to exit. */ STATE_STOPPING, /* We've stopped, whether by user decision or because of an error. * Everything has been torn down (except possibly a root-owned subprocess), * the output file has been fully written and closed, and no more signals * will be emitted. */ STATE_STOPPED, } BustlePcapMonitorState; static const gchar * const STATES[] = { "NEW", "STARTING", "RUNNING", "STOPPING", "STOPPED", }; typedef struct _BustlePcapMonitor { GObject parent; GBusType bus_type; gchar *address; BustlePcapMonitorState state; GCancellable *cancellable; guint cancellable_cancelled_id; /* input */ GSubprocess *dbus_monitor; /* If >= 0, master side of controlling terminal for dbus_monitor */ int pt_master; GSubprocess *tee_proc; GSource *tee_source; BustlePcapReader *reader; /* output */ gchar *filename; /* errors */ GError *pcap_error; GError *subprocess_error; guint await_both_errors_id; } BustlePcapMonitor; enum { PROP_BUS_TYPE = 1, PROP_ADDRESS, PROP_FILENAME, }; enum { SIG_MESSAGE_LOGGED, SIG_STOPPED, N_SIGNALS }; static guint signals[N_SIGNALS]; static void initable_iface_init ( gpointer g_class, gpointer unused); G_DEFINE_TYPE_WITH_CODE (BustlePcapMonitor, bustle_pcap_monitor, 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_monitor_init (BustlePcapMonitor *self) { self->bus_type = G_BUS_TYPE_SESSION; self->state = STATE_NEW; self->cancellable = g_cancellable_new (); self->pt_master = -1; } static void bustle_pcap_monitor_get_property ( GObject *object, guint property_id, GValue *value, GParamSpec *pspec) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (object); switch (property_id) { case PROP_BUS_TYPE: g_value_set_enum (value, self->bus_type); break; case PROP_ADDRESS: g_value_set_string (value, self->address); break; case PROP_FILENAME: g_value_set_string (value, self->filename); break; default: G_OBJECT_WARN_INVALID_PROPERTY_ID (object, property_id, pspec); } } static void bustle_pcap_monitor_set_property ( GObject *object, guint property_id, const GValue *value, GParamSpec *pspec) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (object); switch (property_id) { case PROP_BUS_TYPE: self->bus_type = g_value_get_enum (value); break; case PROP_ADDRESS: self->address = g_value_dup_string (value); break; case PROP_FILENAME: self->filename = g_value_dup_string (value); break; default: G_OBJECT_WARN_INVALID_PROPERTY_ID (object, property_id, pspec); } } static void bustle_pcap_monitor_dispose (GObject *object) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (object); GObjectClass *parent_class = bustle_pcap_monitor_parent_class; if (self->cancellable_cancelled_id != 0) { g_assert (self->cancellable != NULL); g_cancellable_disconnect (self->cancellable, self->cancellable_cancelled_id); self->cancellable_cancelled_id = 0; } g_clear_object (&self->cancellable); 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); if (parent_class->dispose != NULL) parent_class->dispose (object); } static void bustle_pcap_monitor_finalize (GObject *object) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (object); GObjectClass *parent_class = bustle_pcap_monitor_parent_class; g_clear_pointer (&self->address, g_free); g_clear_pointer (&self->filename, g_free); g_clear_error (&self->pcap_error); g_clear_error (&self->subprocess_error); if (self->pt_master >= 0) { g_close (self->pt_master, NULL); self->pt_master = -1; } if (parent_class->finalize != NULL) parent_class->finalize (object); } static void bustle_pcap_monitor_class_init (BustlePcapMonitorClass *klass) { GObjectClass *object_class = G_OBJECT_CLASS (klass); GParamSpec *param_spec; object_class->get_property = bustle_pcap_monitor_get_property; object_class->set_property = bustle_pcap_monitor_set_property; object_class->dispose = bustle_pcap_monitor_dispose; object_class->finalize = bustle_pcap_monitor_finalize; #define THRICE(x) x, x, x param_spec = g_param_spec_enum ( "bus-type", "Bus type", "Which standard bus to monitor. If NONE, :address must be non-NULL.", G_TYPE_BUS_TYPE, G_BUS_TYPE_NONE, G_PARAM_CONSTRUCT_ONLY | G_PARAM_READWRITE | G_PARAM_STATIC_STRINGS); g_object_class_install_property (object_class, PROP_BUS_TYPE, param_spec); param_spec = g_param_spec_string ( "address", "Address", "Address of bus to monitor. If non-NULL, :bus-type must be G_BUS_TYPE_NONE", NULL, G_PARAM_CONSTRUCT_ONLY | G_PARAM_READWRITE | G_PARAM_STATIC_STRINGS); g_object_class_install_property (object_class, PROP_ADDRESS, param_spec); param_spec = g_param_spec_string (THRICE ("filename"), NULL, G_PARAM_CONSTRUCT_ONLY | G_PARAM_READWRITE | G_PARAM_STATIC_STRINGS); g_object_class_install_property (object_class, PROP_FILENAME, param_spec); /** * BustlePcapMonitor::message-logged: * @self: the monitor. * @sec: seconds since 1970. * @usec: microseconds! (These are not combined into a single %gint64 because * gtk2hs as of 2018-01-08 crashes when it encounters %G_TYPE_UINT64 in a * #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, 5, G_TYPE_LONG, G_TYPE_LONG, G_TYPE_POINTER, G_TYPE_UINT, G_TYPE_DBUS_MESSAGE); /** * BustlePcapMonitor::stopped: * @self: the monitor * @domain: domain of a #GError (as G_TYPE_UINT because there is no * G_TYPE_UINT32) * @code: code of a #GError * @message: message of a #GError * * Emitted once when monitoring stops, whether triggered (asynchronously) by * calling bustle_pcap_monitor_stop(), in which case @domain will be * %G_IO_ERROR and @code will be %G_IO_ERROR_CANCELLED, or because an error * occurs. */ signals[SIG_STOPPED] = g_signal_new ("stopped", BUSTLE_TYPE_PCAP_MONITOR, G_SIGNAL_RUN_FIRST, 0, NULL, NULL, NULL, G_TYPE_NONE, 3, G_TYPE_UINT, G_TYPE_INT, G_TYPE_STRING); RUNNING_IN_FLATPAK = g_file_test ("/.flatpak-info", G_FILE_TEST_EXISTS); } static void handle_error (BustlePcapMonitor *self) { g_autoptr(GError) error = NULL; g_return_if_fail (self->pcap_error != NULL || self->subprocess_error != NULL); if (self->pcap_error != NULL) g_debug ("%s: pcap_error: %s", G_STRFUNC, self->pcap_error->message); if (self->subprocess_error != NULL) g_debug ("%s: subprocess_error: %s", G_STRFUNC, self->subprocess_error->message); if (self->state == STATE_STOPPED) { g_debug ("%s: already stopped", G_STRFUNC); return; } /* Check for pkexec errors. Signal these in preference to all others. */ if (self->subprocess_error != NULL && self->bus_type == G_BUS_TYPE_SYSTEM) { if (g_error_matches (self->subprocess_error, G_SPAWN_EXIT_ERROR, 126)) { /* dialog dismissed */ g_set_error (&error, G_IO_ERROR, G_IO_ERROR_CANCELLED, "User dismissed polkit authorization dialog"); } else if (g_error_matches (self->subprocess_error, G_SPAWN_EXIT_ERROR, 127)) { /* not authorized, authorization couldn't be obtained through * authentication, or an self->subprocess_error occurred */ g_set_error (&error, G_IO_ERROR, G_IO_ERROR_PERMISSION_DENIED, "Not authorized to monitor system bus"); } } if (g_error_matches (self->subprocess_error, G_SPAWN_EXIT_ERROR, 0)) { /* I believe clean exit only happens if the bus is shut down. This might * happen if you're using Bustle to monitor a test suite, or perhaps a * user session that you log out of. Let's consider this to be * cancellation. */ g_set_error_literal (&error, G_IO_ERROR, G_IO_ERROR_CANCELLED, self->subprocess_error->message); } if (error == NULL) { /* If no pkexec errors, prefer potentially more informative errors from * libpcap, including the wonderful snaplen bug. */ if (self->pcap_error != NULL) { error = g_steal_pointer (&self->pcap_error); } /* Otherwise, the "subprocess didn't work" error will have to do. */ else { error = g_steal_pointer (&self->subprocess_error); if (self->state == STATE_STARTING) g_prefix_error (&error, "Failed to start dbus-monitor: "); } } self->state = STATE_STOPPED; g_debug ("%s: emitting ::stopped(%s, %d, %s)", G_STRFUNC, g_quark_to_string (error->domain), error->code, error->message); g_signal_emit (self, signals[SIG_STOPPED], 0, (guint) error->domain, error->code, error->message); g_clear_handle_id (&self->await_both_errors_id, g_source_remove); } static gboolean await_both_errors_cb (gpointer data) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (data); handle_error (self); self->await_both_errors_id = 0; return G_SOURCE_REMOVE; } /* Wait for the dbus-monitor subprocess to have exited, and for the pcap reader * to have finished. We expect the reader to finish promptly when the * subprocess does, but the subprocess may not die until it tries to read to a * closed pipe (if the user stops the recording). So we wait a couple of * seconds before pressing on. */ static void await_both_errors (BustlePcapMonitor *self) { if (self->state == STATE_STOPPED) return; else if (self->subprocess_error != NULL && self->pcap_error != NULL) handle_error (self); else if (self->await_both_errors_id == 0) self->await_both_errors_id = g_timeout_add_seconds_full (G_PRIORITY_DEFAULT, 2, await_both_errors_cb, g_object_ref (self), g_object_unref); } static gboolean list_all_names ( GDBusProxy *bus, GError **error) { g_autoptr(GVariant) ret = NULL; gchar **names; /* borrowed from 'ret' */ g_return_val_if_fail (G_IS_DBUS_PROXY (bus), FALSE); ret = g_dbus_proxy_call_sync (bus, "ListNames", NULL, G_DBUS_CALL_FLAGS_NONE, -1, NULL, error); if (ret == NULL) { g_prefix_error (error, "Couldn't ListNames: "); return FALSE; } for (g_variant_get_child (ret, 0, "^a&s", &names); *names != NULL; names++) { gchar *name = *names; if (!g_dbus_is_unique_name (name) && strcmp (name, "org.freedesktop.DBus") != 0) { g_autoptr(GVariant) owner = g_dbus_proxy_call_sync (bus, "GetNameOwner", g_variant_new ("(s)", name), G_DBUS_CALL_FLAGS_NONE, -1, NULL, NULL); /* Ignore returned value or error. These are just used by the UI to * fill in the initial owners of each well-known name. If we get an * error here, the owner disappeared between ListNames() and here; * but that means we'll have seen a NameOwnerChanged from which the * UI can (in theory) infer who the owner used to be. * * We cannot use G_DBUS_MESSAGE_FLAGS_NO_REPLY_EXPECTED because we * do want the reply to be sent to us. */ } } return TRUE; } static GDBusConnection * get_connection ( BustlePcapMonitor *self, GCancellable *cancellable, GError **error) { g_autofree gchar *address_to_free = NULL; const gchar *address = self->address; if (self->address != NULL) { address = self->address; } else { address_to_free = g_dbus_address_get_for_bus_sync (self->bus_type, cancellable, error); if (address_to_free == NULL) { g_prefix_error (error, "Couldn't get bus address: "); return FALSE; } address = address_to_free; } return g_dbus_connection_new_for_address_sync ( address, G_DBUS_CONNECTION_FLAGS_AUTHENTICATION_CLIENT | G_DBUS_CONNECTION_FLAGS_MESSAGE_BUS_CONNECTION, NULL, /* auth observer */ cancellable, error); } static void dump_names_thread_func ( GTask *task, gpointer source_object, gpointer task_data, GCancellable *cancellable) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (source_object); g_autoptr(GDBusConnection) connection = NULL; g_autoptr(GDBusProxy) bus = NULL; g_autoptr(GError) error = NULL; connection = get_connection (self, cancellable, &error); if (connection != NULL) { const gchar *unique_name = g_dbus_connection_get_unique_name (connection); if (unique_name != NULL) { g_autofree gchar *mangled = g_strdup (unique_name); g_autofree gchar *well_known_name = g_strconcat (BUSTLE_MONITOR_NAME_PREFIX, /* ":3.14" -> "_3_14", a legal bus name component */ g_strcanon (mangled, "0123456789", '_'), NULL); g_debug ("%s: attempting to own %s", G_STRFUNC, well_known_name); /* Ignore returned ID: we'll own it until we disconnect. * * Also ignore callbacks: we don't need to be notified, since this * name is just for the benefit of the viewer. On the system bus we * won't be able to own this name, but if we're smart we can teach * the viewer that merely requesting the name is enough to hide this * connection. */ g_bus_own_name_on_connection (connection, well_known_name, G_BUS_NAME_OWNER_FLAGS_NONE, NULL /* acquired */, NULL /* lost */, NULL /* user_data */, NULL /* free_func */); } bus = g_dbus_proxy_new_sync (connection, G_DBUS_PROXY_FLAGS_DO_NOT_LOAD_PROPERTIES | G_DBUS_PROXY_FLAGS_DO_NOT_CONNECT_SIGNALS | G_DBUS_PROXY_FLAGS_DO_NOT_AUTO_START, NULL, "org.freedesktop.DBus", "/org/freedesktop/DBus", "org.freedesktop.DBus", cancellable, &error); } if (bus != NULL && list_all_names (bus, &error)) g_task_return_boolean (task, TRUE); else g_task_return_error (task, g_steal_pointer (&error)); g_assert (error == NULL); if (connection != NULL && !g_dbus_connection_close_sync (connection, cancellable, &error)) g_warning ("%s: %s", G_STRFUNC, error->message); } static void dump_names_cb ( GObject *source_object, GAsyncResult *result, gpointer user_data) { g_autoptr(GError) error = NULL; if (!g_task_propagate_boolean (G_TASK (result), &error)) g_warning ("Failed to dump names: %s", error->message); } static void dump_names_async ( BustlePcapMonitor *self) { g_autoptr(GTask) task = g_task_new (self, self->cancellable, dump_names_cb, NULL); g_task_run_in_thread (task, dump_names_thread_func); } /** * send_sigint: * * Send SIGINT to the dbus-monitor subprocess, in as many ways as possible. */ static void send_sigint (BustlePcapMonitor *self) { /* Send the signal directly; this has no effect on the privileged subprocess * used on the system bus. */ if (self->dbus_monitor != NULL) g_subprocess_send_signal (self->dbus_monitor, SIGINT); /* Send it via the PTY that we set as the subprocess's controlling terminal; * this works even for a privileged child. */ if (self->pt_master >= 0) { char ctrl_c = '\x03'; if (write (self->pt_master, &ctrl_c, 1) != 1) { g_autoptr(GError) local_error = NULL; throw_errno (&local_error, "write to pt_master failed"); g_warning ("%s: %s", G_STRFUNC, local_error->message); } } } static gboolean start_pcap ( BustlePcapMonitor *self, GError **error) { GInputStream *stdout_pipe = NULL; gint stdout_fd = -1; FILE *dbus_monitor_filep = NULL; 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)); g_return_val_if_fail (stdout_fd >= 0, FALSE); dbus_monitor_filep = fdopen (stdout_fd, "r"); if (dbus_monitor_filep == NULL) { throw_errno (error, "fdopen failed"); return FALSE; } /* fd is owned by the FILE * now */ g_unix_input_stream_set_close_fd (G_UNIX_INPUT_STREAM (stdout_pipe), FALSE); /* This reads the 4-byte pcap header from the pipe, in a single blocking * 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->reader = bustle_pcap_reader_fopen (g_steal_pointer (&dbus_monitor_filep), error); if (self->reader == NULL) { g_prefix_error (error, "Couldn't read messages from dbus-monitor: "); /* Try to terminate dbus-monitor immediately. The reader closes the FILE * on error. */ send_sigint (self); return FALSE; } dump_names_async (self); self->state = STATE_RUNNING; return TRUE; } static gboolean read_one ( BustlePcapMonitor *self, GError **error) { glong sec, usec; const guchar *blob; guint length; g_autoptr(GDBusMessage) message = NULL; if (!bustle_pcap_reader_read_one (self->reader, &sec, &usec, &blob, &length, &message, error)) { 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); return TRUE; } } static gboolean dbus_monitor_readable ( GObject *pollable_input_stream, gpointer user_data) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (user_data); gboolean (*read_func) (BustlePcapMonitor *, GError **); g_return_val_if_fail (self->pcap_error == NULL, FALSE); if (g_cancellable_set_error_if_cancelled (self->cancellable, &self->pcap_error)) { await_both_errors (self); return FALSE; } switch (self->state) { case STATE_STARTING: read_func = start_pcap; break; case STATE_RUNNING: case STATE_STOPPING: /* may have a few last messages to read */ read_func = read_one; break; default: g_critical ("%s in unexpected state %d (%s)", G_STRFUNC, self->state, STATES[self->state]); return FALSE; } if (!read_func (self, &self->pcap_error)) { await_both_errors (self); return FALSE; } return TRUE; } static void wait_check_cb ( GObject *source, GAsyncResult *result, gpointer user_data) { g_autoptr(BustlePcapMonitor) self = BUSTLE_PCAP_MONITOR (user_data); GSubprocess *dbus_monitor = G_SUBPROCESS (source); g_return_if_fail (self->subprocess_error == NULL); if (g_subprocess_wait_check_finish (dbus_monitor, result, &self->subprocess_error)) { g_set_error (&self->subprocess_error, G_SPAWN_EXIT_ERROR, 0, "dbus-monitor exited cleanly"); } /* cases: * - G_SPAWN_ERROR / G_SPAWN_ERROR_FAILED / "Child process killed by signal N": * dbus-monitor was killed, presumably by send_sigint() * - G_SPAWN_EXIT_ERROR: * - 0: bus itself went away (assuming pkexec/flatpak-spawn propagate * errors correctly) * - 1: anything else went wrong in dbus-monitor, including invalid * arguments and broken pipe (when we close the read end) * - 126: User dismissed polkit authentication dialog * - 127: polkit auth failed * - 128 + N: killed by signal N, propagated by flatpak-spawn --host * * We just need to deal with 0, 126, 127 specially. */ await_both_errors (self); } static void cancellable_cancelled_cb (GCancellable *cancellable, gpointer user_data) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (user_data); /* Closes the stream; should cause dbus-monitor to quit in due course when it * tries to write to the other end of the pipe. */ bustle_pcap_reader_close (self->reader); /* And try to terminate it immediately. */ send_sigint (self); } static const char ** build_argv (BustlePcapMonitor *self, GError **error) { g_autoptr(GPtrArray) dbus_monitor_argv = g_ptr_array_sized_new (8); if (RUNNING_IN_FLATPAK) { g_ptr_array_add (dbus_monitor_argv, "flatpak-spawn"); g_ptr_array_add (dbus_monitor_argv, "--host"); } if (self->bus_type == G_BUS_TYPE_SYSTEM) g_ptr_array_add (dbus_monitor_argv, "pkexec"); g_ptr_array_add (dbus_monitor_argv, "dbus-monitor"); g_ptr_array_add (dbus_monitor_argv, "--pcap"); switch (self->bus_type) { case G_BUS_TYPE_SESSION: g_return_val_if_fail (self->address == NULL, FALSE); g_ptr_array_add (dbus_monitor_argv, "--session"); break; case G_BUS_TYPE_SYSTEM: g_return_val_if_fail (self->address == NULL, FALSE); g_ptr_array_add (dbus_monitor_argv, "--system"); break; case G_BUS_TYPE_NONE: g_return_val_if_fail (self->address != NULL, FALSE); g_ptr_array_add (dbus_monitor_argv, "--address"); g_ptr_array_add (dbus_monitor_argv, self->address); break; default: g_set_error (error, G_IO_ERROR, G_IO_ERROR_NOT_SUPPORTED, "Can only log the session bus, system bus, or a given address"); return NULL; } g_ptr_array_add (dbus_monitor_argv, NULL); return (const char **) g_ptr_array_free (g_steal_pointer (&dbus_monitor_argv), FALSE); } /** * set_controlling_tty_to_stdin: * * child_setup function for the dbus-monitor subprocess which arranges for its * controlling TTY to be a PTY, so we can send SIGINT to it even if it's * privileged. */ static void set_controlling_tty_to_stdin (void *user_data G_GNUC_UNUSED) { /* Move this child process to a new session, unsetting any existing * controlling terminal. */ setsid (); /* Make stdin (the worker end of a PTY pair) the controlling terminal for * this child process. */ ioctl (STDIN_FILENO, TIOCSCTTY, 0); } static GSubprocess * spawn_monitor (BustlePcapMonitor *self, const char *const *argv, GError **error) { g_autoptr(GSubprocessLauncher) launcher = g_subprocess_launcher_new (G_SUBPROCESS_FLAGS_STDOUT_PIPE); self->pt_master = posix_openpt (O_RDWR | O_NOCTTY | O_CLOEXEC); if (self->pt_master < 0) return throw_errno (error, "posix_openpt failed"); if (unlockpt (self->pt_master) < 0) return throw_errno (error, "unlockpt failed"); char sname[PATH_MAX] = { 0 }; if (ptsname_r (self->pt_master, sname, G_N_ELEMENTS (sname)) != 0) return throw_errno (error, "ptsname_r failed"); int pt_slave = open (sname, O_RDWR); if (pt_slave < 0) return throw_errno (error, "open(sname) failed"); g_subprocess_launcher_take_stdin_fd (launcher, pt_slave); if (!RUNNING_IN_FLATPAK) g_subprocess_launcher_set_child_setup (launcher, set_controlling_tty_to_stdin, NULL, NULL); /* otherwise, the session-helper process already does this for us */ GSubprocess *child = g_subprocess_launcher_spawnv (launcher, argv, error); g_close (pt_slave, NULL); 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, GCancellable *cancellable, GError **error) { BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (initable); g_autofree const char **argv = NULL; GInputStream *stdout_pipe = NULL; argv = build_argv (self, error); if (NULL == argv) return FALSE; if (self->filename == NULL) { g_set_error (error, G_IO_ERROR, G_IO_ERROR_INVALID_ARGUMENT, "You must specify a filename"); return FALSE; } self->cancellable_cancelled_id = g_cancellable_connect (self->cancellable, G_CALLBACK (cancellable_cancelled_cb), self, NULL); self->dbus_monitor = spawn_monitor (self, (const char * const *) argv, error); if (self->dbus_monitor == NULL) return FALSE; 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->tee_source = g_pollable_input_stream_create_source ( G_POLLABLE_INPUT_STREAM (stdout_pipe), self->cancellable); g_source_set_callback (self->tee_source, (GSourceFunc) dbus_monitor_readable, self, NULL); g_source_attach (self->tee_source, NULL); g_subprocess_wait_check_async ( self->dbus_monitor, self->cancellable, wait_check_cb, g_object_ref (self)); self->state = STATE_STARTING; return TRUE; } /* FIXME: instead of GInitable + syncronous stop, have * bustle_pcap_monitor_record_{async,finish} */ void bustle_pcap_monitor_stop ( BustlePcapMonitor *self) { if (self->state == STATE_STOPPED || self->state == STATE_STOPPING || self->state == STATE_NEW) { g_debug ("%s: already in state %s", G_STRFUNC, STATES[self->state]); return; } self->state = STATE_STOPPING; g_cancellable_cancel (self->cancellable); } static void initable_iface_init ( gpointer g_class, gpointer unused) { GInitableIface *iface = g_class; iface->init = initable_init; } BustlePcapMonitor * bustle_pcap_monitor_new ( GBusType bus_type, const gchar *address, const gchar *filename, GError **error) { return g_initable_new ( BUSTLE_TYPE_PCAP_MONITOR, NULL, error, "bus-type", bus_type, "address", address, "filename", filename, NULL); } bustle-0.8.0/Test/Renderer.hs0000644000000000000000000001114213710546303014225 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} module Main where import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.HUnit import Test.HUnit import Control.Monad (when) import Control.Monad.State import qualified Data.Set as Set import Data.Monoid import Data.List import System.Exit (exitFailure) import Bustle.Types import Bustle.Renderer import Bustle.GDBusMessage main :: IO () main = defaultMain tests where tests = [ testGroup "Disconnections don't affect participants" [ testCase "One participant, no disconnection" test_participants , testCase "One participant, which disconnects" test_participants_with_disconnect ] , testGroup "Incremential rendering matches all-at-once rendering" [ testCase "rrCentreOffset" $ test_incremental_simple rrCentreOffset , testCase "rrTopOffset" $ test_incremental_simple rrTopOffset , testCase "rrShapes" $ test_incremental_list rrShapes , testCase "rrRegions" $ test_incremental_list rrRegions , testCase "rrApplications" $ test_incremental_simple rrApplications , testCase "rrWarnings" $ test_incremental_simple rrWarnings ] ] -- Tests that services visible in a log are listed as participants even if they -- 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 :: 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" ] sessionLogWithDisconnect = sessionLogWithoutDisconnect ++ [ NOCEvent $ Disconnected activeService ] expectedParticipants = [ (activeService, Set.empty) ] -- 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 -- Test that incremental rendering matches all-at-once rendering u1 = UniqueName ":1.1" u2 = UniqueName ":2.2" -- This is enough names that the log needs to be rejustified to the top os = map (OtherName . busName_ . ("Foo." ++) . (:"potato")) ['a'..'z'] m = Member "/" Nothing "Hi" bareLog = [ NOCEvent $ Connected u1 , MessageEvent $ Signal (U u1) Nothing m , NOCEvent $ Connected u2 ] ++ 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) => (RendererResult Participants -> b) -> Assertion test_incremental_simple f = test_incremental $ \full incremental -> f full @=? f incremental test_incremental_list :: (Show b, Eq b) => (RendererResult Participants -> [b]) -> Assertion test_incremental_list f = test_incremental $ \fullRR incrementalRR -> do let full = f fullRR incr = f incrementalRR -- Compare each element in turn mapM_ (uncurry (@=?)) $ zip full incr when (length full /= length incr) $ full @=? incr test_incremental :: ( RendererResult Participants -> RendererResult Participants -> Assertion ) -> Assertion 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 :: [DetailedEvent] -> RendererResult Participants fullRR events = process events [] incrementalRR events = mconcat rrs where processOne m = state $ processSome [m] [] (rrs, _) = runState (mapM processOne events) rendererStateNew bustle-0.8.0/Test/Regions.hs0000644000000000000000000001303313700421730014061 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} import Test.QuickCheck import Test.QuickCheck.All import Data.List (sort, group) import Data.Maybe (isNothing, isJust) import Bustle.Regions newtype NonOverlappingStripes = NonOverlappingStripes [Stripe] deriving (Show, Eq, Ord) instance Arbitrary NonOverlappingStripes where arbitrary = do -- listOf2 tops <- sort <$> ((:) <$> arbitrary <*> listOf1 arbitrary) -- Generate dense stripes sometimes let g :: Gen Double g = frequency [(1, return 1.0), (7, choose (0.0, 1.0))] rs <- vectorOf (length tops) (choose (0.0, 1.0)) let stripes = zipWith3 (\t1 t2 r -> Stripe t1 (t1 + ((t2 - t1) * r))) tops (tail tops) rs return $ NonOverlappingStripes stripes newtype ValidRegions a = ValidRegions (Regions a) deriving (Show, Eq, Ord) instance (Eq a, Arbitrary a) => Arbitrary (ValidRegions a) where arbitrary = do NonOverlappingStripes stripes <- arbitrary values <- vector (length stripes) `suchThat` unique return $ ValidRegions (zip stripes values) where unique = all (== 1) . map length . group instance (Eq a, Arbitrary a) => Arbitrary (RegionSelection a) where arbitrary = do ValidRegions rs <- arbitrary return $ regionSelectionNew rs prop_NonOverlapping_generator_works (NonOverlappingStripes ss) = nonOverlapping ss prop_InitiallyUnselected rs = isNothing $ rsCurrent rs prop_UpDoesNothing rs = isNothing $ rsCurrent $ regionSelectionUp rs prop_DownDoesNothing vr@(ValidRegions regions) = withRegions vr $ \rs -> let final = last regions rs' = regionSelectionLast rs in rsCurrent (regionSelectionDown rs') == Just final prop_DownWorks vr@(ValidRegions regions) = withRegions vr $ \rs -> rsCurrent (regionSelectionDown rs) == Just (head regions) withRegions :: Testable t => ValidRegions a -> (RegionSelection a -> t) -> t withRegions (ValidRegions regions) f = f (regionSelectionNew regions) prop_UpdateToFirst :: (Eq a) => ValidRegions a -> Bool prop_UpdateToFirst vr@(ValidRegions regions) = withRegions vr $ \rs -> Just first == rsCurrent (regionSelectionUpdate y rs) && null (rsBefore rs) where first@(Stripe top bottom, _) = head regions y = (top + bottom) / 2 prop_SelectFirst :: (Eq a) => ValidRegions a -> Bool prop_SelectFirst vr@(ValidRegions regions) = withRegions vr $ \rs -> Just (head regions) == rsCurrent (regionSelectionFirst rs) prop_SelectLast :: (Eq a) => ValidRegions a -> Bool prop_SelectLast vr@(ValidRegions regions) = withRegions vr $ \rs -> Just (last regions) == rsCurrent (regionSelectionLast rs) prop_UpdateToAny :: (Eq a, Show a) => ValidRegions a -> Property prop_UpdateToAny vr@(ValidRegions regions) = withRegions vr $ \rs -> forAll (elements regions) $ \ r@(s, _) -> rsCurrent (regionSelectionUpdate (midpoint s) rs) == Just r shuffled :: [a] -> Gen [a] shuffled [] = return [] shuffled xs = do i <- choose (0, length xs - 1) let x = xs !! i pre = take i xs post = drop (i + 1) xs xs' <- shuffled (pre ++ post) return (x:xs') prop_UpdateToAll :: (Eq a, Show a) => ValidRegions a -> Property prop_UpdateToAll vr@(ValidRegions regions) = withRegions vr $ \rs -> forAll (shuffled regions) $ \regions' -> updateAndForward rs regions' where updateAndForward rs [] = True updateAndForward rs (x:xs) = let rs' = regionSelectionUpdate (midpoint (fst x)) rs in rsCurrent rs' == Just x && updateAndForward rs' xs randomMutation :: Gen (RegionSelection a -> RegionSelection a) randomMutation = do y <- arbitrary elements [ regionSelectionUp , regionSelectionDown , regionSelectionFirst , regionSelectionLast , regionSelectionUpdate y ] randomMutations :: Gen (RegionSelection a -> RegionSelection a) randomMutations = foldr (.) id <$> listOf randomMutation prop_ClickAlwaysInSelection rs = forAll (fmap Blind randomMutations) $ \(Blind f) -> let rs' = f rs in isJust (rsCurrent rs') ==> let Just (Stripe top bottom, _) = rsCurrent rs' y = rsLastClick rs' in top <= y && y <= bottom prop_SelectWorks :: (Eq a, Show a) => ValidRegions a -> Property prop_SelectWorks vr@(ValidRegions regions) = withRegions vr $ \rs -> forAll (elements regions) $ \ r@(s, x) -> Just r == rsCurrent (regionSelectionSelect x rs) prop_Append :: (Eq a, Show a) => ValidRegions a -> Property prop_Append vr@(ValidRegions regions) = forAll (choose (0, length regions - 1)) $ \i -> let as = take i regions bs = drop i regions in regionSelectionAppend bs (regionSelectionNew as) == regionSelectionNew regions prop_FlattenThenNewIsIdempotent :: (Eq a, Show a) => ValidRegions a -> Property prop_FlattenThenNewIsIdempotent vr@(ValidRegions regions) = withRegions vr $ \rs -> property $ regionSelectionNew (regionSelectionFlatten rs) == rs -- Essential scary hack to make quickCheckAll work O_o -- https://hackage.haskell.org/package/QuickCheck-2.7.6/docs/Test-QuickCheck-All.html return [] runTests = $quickCheckAll main = do runTests return () bustle-0.8.0/Test/PcapCrash.hs0000644000000000000000000000117113700421730014317 0ustar0000000000000000-- A regression test for . -- -- log-with-h.bustle is a log file containing a file handle. This used to make -- readPcap call 'error'. module Main where import System.Exit (exitFailure) import Bustle.Loader.Pcap (readPcap) path = "Test/data/log-with-h.bustle" main = do ret <- readPcap path case ret of Left e -> do putStrLn $ "Failed to read '" ++ path ++ "': " ++ show e exitFailure -- TODO: check there are no warnings (but there are because we don't -- understand 'h', so we just skip it) Right _ -> return () bustle-0.8.0/data/bustle.ui0000644000000000000000000013433013442235205013755 0ustar0000000000000000 True False end True False False _Filter Visible Services… True True False False _Statistics True True False gtk-about True False True True True False gtk-open True False True True True False Display two logs—one for the session bus, one for the system bus—side by side. O_pen a Pair of Logs… True True False True False Record S_ession Bus True True False Record S_ystem Bus True True False Record _Address… True False Bustle 900 700 org.freedesktop.Bustle True True False True False sidebarStack False False True False True 100 True True True True Record a new log recordMenu True False True False baseline _Record True False True 0 True False baseline pan-down-symbolic False True 1 _Stop 100 True True True 1 True False False Open an existing log openMenu True False document-open-symbolic 1 -1 True False 6 True False False True 0 True False vertical True False end 5 True False True 0 True False end True False True 1 True True 1 True False False filterStatsEtc True False open-menu-symbolic 1 end 2 True False False False Export as PDF True False document-send-symbolic 1 end 3 True False False False Save True False document-save-symbolic 1 end 4 True False True False vertical False error True False 6 end False False 0 False 16 errorBarTitle True False vertical 6 True True start <b>Oh no</b> True True True False True 0 True True start <small>very sad</small> True True True False True 1 True True 0 False False 0 False True 0 True True True False center vertical 12 True False 256 org.freedesktop.Bustle-symbolic False True 2 True False Start recording D-Bus activity with the <b>Record</b> button above You can also run <i>dbus-monitor --pcap</i> from the command line True center False True end 0 True False Welcome to Bustle False True end 1 InstructionsPage True False <big><b>Waiting for D-Bus traffic; please hold…</b></big> True PleaseHoldPage 1 True True True True True True never in Frequencies True True never in Durations 1 True True never in Sizes 2 False False True True vertical True True always in True True True False False 6 6 6 6 6 12 True False False Type 1 0 0 True False False Path 1 0 3 detailsPath True False True /place/holder True start 0 1 3 True False False Member 1 0 4 detailsMember True False True com.example.Placeholder True start 0 1 4 True False False Arguments 1 0 0 6 True True True in detailsArguments True True False char 1 6 True False True False True Method call 0 methodCall True False True Method return 0 methodReturn 1 True False True Error 0 error 2 True False True Signal 0 signal 3 True False True Directed signal 0 directedSignal 4 1 0 True False False Sender 1 0 1 True False False Destination 1 0 2 detailsPath True False True org.example.Thingy True start 0 1 1 detailsPath True False True com.example.Placeholder True start 0 1 2 True False False Error 1 0 5 detailsMember True False True com.example.Placeholder.Error.OhNo True start 0 1 5 False False True True CanvasPage 2 True True 1 bustle-0.8.0/data/FilterDialog.ui0000644000000000000000000000600113442235205015015 0ustar0000000000000000 False dialog True False Filter Visible Services False True _Reset True True True True False vertical 0 False end False False 0 True True 0 never in True True False True True True 1 bustle-0.8.0/data/OpenTwoDialog.ui0000644000000000000000000001371713442235205015177 0ustar0000000000000000 False 5 Open a Pair of Logs False True dialog org.freedesktop.Bustle True False vertical 2 True False end gtk-cancel False True True True False True False False 0 gtk-open False True True True False True False False 1 False True end 0 True False 2 2 6 6 True False Select system bus log 30 1 2 1 2 True False 0 System bus log: 1 2 True False 0 Session bus log: True False Select session bus log 30 1 2 GTK_EXPAND False True 1 openTwoCancelButton openTwoOpenButton bustle-0.8.0/data/RecordAddressDialog.ui0000644000000000000000000001160513442235205016322 0ustar0000000000000000 False Record Address False True dialog False vertical 2 False end gtk-cancel True True True True True True 0 _Record True True True True True True True True 1 False False 0 True False 6 6 6 6 6 True False Address: False True 0 True True True True 60 e.g. unix:abstract=/tmp/dbus-E5RlEB5Tzu,guid= b1c1921b62283b7b612b57305b20cc28 GTK_INPUT_HINT_NO_SPELLCHECK | GTK_INPUT_HINT_NO_EMOJI | GTK_INPUT_HINT_NONE True True 1 False True 1 recordAddressCancel recordAddressRecord bustle-0.8.0/LICENSE0000644000000000000000000006405713657324617012242 0ustar0000000000000000All code in this project is licensed under the GNU LGPL Version 2.1 or (at your option) any later version. A copy of the LGPL v2.1 follows. --- GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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 Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! bustle-0.8.0/Setup.hs0000644000000000000000000000673013700421730012642 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} #if defined(VERSION_hgettext) import System.FilePath ( (), (<.>) ) import Distribution.PackageDescription import Distribution.Simple import Distribution.Simple.BuildPaths ( autogenPackageModulesDir ) import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Setup as S import Distribution.Simple.Utils import Distribution.Text ( display ) import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as ModuleName import qualified GetText main :: IO () main = defaultMainWithHooks $ installBustleHooks simpleUserHooks -- Okay, so we want to use hgettext's install hook, but not the hook that -- miraculously runs all our code through CPP just to add a couple of -- constants. (cpp doesn't like multi-line Haskell strings, so this is not -- purely an academic preference.) -- -- Instead, we generate GetText_bustle.hs which contains the constants, in the -- same way as Paths_bustle.hs gets generated by Cabal. Much neater. -- -- TODO: upstream this to hgettext installBustleHooks :: UserHooks -> UserHooks installBustleHooks uh = uh { postInst = \a b c d -> do postInst uh a b c d GetText.installPOFiles a b c d , buildHook = \pkg lbi hooks flags -> do writeGetTextConstantsFile pkg lbi flags buildHook uh pkg lbi hooks flags } writeGetTextConstantsFile :: PackageDescription -> LocalBuildInfo -> BuildFlags -> IO () writeGetTextConstantsFile pkg lbi flags = do let verbosity = fromFlag (buildVerbosity flags) createDirectoryIfMissingVerbose verbosity True (autogenPackageModulesDir lbi) let pathsModulePath = autogenPackageModulesDir lbi ModuleName.toFilePath (getTextConstantsModuleName pkg) <.> "hs" rewriteFileEx verbosity pathsModulePath (generateModule pkg lbi) getTextConstantsModuleName :: PackageDescription -> ModuleName getTextConstantsModuleName pkg_descr = ModuleName.fromString $ "GetText_" ++ fixedPackageName pkg_descr -- Cargo-culted from two separate places in Cabal! fixedPackageName :: PackageDescription -> String fixedPackageName = map fixchar . display . packageName where fixchar '-' = '_' fixchar c = c generateModule :: PackageDescription -> LocalBuildInfo -> String generateModule pkg lbi = header ++ body where moduleName = getTextConstantsModuleName pkg header = "module " ++ display moduleName ++ " (\n"++ " getMessageCatalogDomain,\n" ++ " getMessageCatalogDir\n" ++ ") where\n"++ "\n" ++ "import qualified Control.Exception as Exception\n" ++ "import System.Environment (getEnv)\n" body = "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n" ++ "catchIO = Exception.catch\n" ++ "\n" ++ "getMessageCatalogDomain :: IO String\n" ++ "getMessageCatalogDomain = return " ++ show dom ++ "\n" ++ "\n" ++ "messageCatalogDir :: String\n" ++ "messageCatalogDir = " ++ show tar ++ "\n" ++ "\n" ++ "getMessageCatalogDir :: IO FilePath\n" ++ "getMessageCatalogDir = catchIO (getEnv \"" ++ fixedPackageName pkg ++ "_localedir\") (\\_ -> return messageCatalogDir)\n" sMap = customFieldsPD (localPkgDescr lbi) dom = GetText.getDomainNameDefault sMap (GetText.getPackageName lbi) tar = GetText.targetDataDir lbi -- Cargo-culted from hgettext #else import Distribution.Simple main :: IO () main = defaultMain #endif bustle-0.8.0/bustle.cabal0000644000000000000000000001726013711017655013501 0ustar0000000000000000Cabal-Version: 2.2 Name: bustle Category: Network, Desktop Version: 0.8.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. License: LGPL-2.1-or-later License-file: LICENSE Author: Will Thompson Maintainer: Will Thompson Homepage: https://gitlab.freedesktop.org/bustle/bustle#readme Data-files: data/bustle.ui, data/FilterDialog.ui, data/OpenTwoDialog.ui, data/RecordAddressDialog.ui, LICENSE 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, -- Stuff for nerds README.md, NEWS.md, CONTRIBUTING.md, INSTALL.md, bustle.doap, run-uninstalled.sh , Test/data/log-with-h.bustle -- inlined copy of the Cabal hooks from hgettext; -- see https://github.com/fpco/stackage/issues/746 , GetText.hs -- wow many translate , po/*.po -- intl bits , data/org.freedesktop.Bustle.appdata.xml.in , data/org.freedesktop.Bustle.desktop.in -- icons , data/icons/hicolor/scalable/apps/org.freedesktop.Bustle.svg , data/icons/hicolor/scalable/apps/org.freedesktop.Bustle.Devel.svg , data/icons/hicolor/scalable/apps/org.freedesktop.Bustle-symbolic.svg x-gettext-po-files: po/*.po x-gettext-domain-name: bustle custom-setup setup-depends: base >= 4.11 && < 5, Cabal >= 2.0, filepath, directory, process Source-Repository head Type: git Location: https://gitlab.freedesktop.org/bustle/bustle.git Flag hgettext Description: Enable translations. Since there are no translations this is currently rather pointless. Default: False Flag InteractiveTests Description: Build interactive test programs Default: False Flag threaded Description: Build with the multi-threaded runtime Default: True 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 , Bustle.Stats , Bustle.Translation , Bustle.Types , Bustle.UI , Bustle.UI.AboutDialog , Bustle.UI.Canvas , Bustle.UI.DetailsView , Bustle.UI.FilterDialog , Bustle.UI.OpenTwoDialog , Bustle.UI.RecordAddressDialog , Bustle.UI.Recorder , Bustle.Util , Paths_bustle autogen-modules: Paths_bustle default-language: Haskell2010 Ghc-options: -Wall -fno-warn-unused-do-bind if flag(threaded) ghc-options: -threaded 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 , directory , filepath , glib , gio , gtk3 , mtl >= 2.2.1 , pango , process , text , time , transformers if flag(hgettext) Build-Depends: hgettext >= 0.1.5 , setlocale other-modules: GetText_bustle autogen-modules: GetText_bustle hs-source-dirs: . , src-hgettext else hs-source-dirs: . , src-no-hgettext Executable dump-messages if flag(InteractiveTests) buildable: True else buildable: False main-is: Test/DumpMessages.hs default-language: Haskell2010 Build-Depends: base , bytestring , containers , mtl , text , transformers if flag(hgettext) Build-Depends: hgettext >= 0.1.5 , setlocale other-modules: GetText_bustle autogen-modules: GetText_bustle hs-source-dirs: . , src-hgettext else hs-source-dirs: . , src-no-hgettext Test-suite test-pcap-crash type: exitcode-stdio-1.0 main-is: Test/PcapCrash.hs other-modules: Bustle.GDBusMessage , Bustle.GVariant , Bustle.Loader.Pcap , Bustle.Reader , Bustle.Translation , Bustle.Types default-language: Haskell2010 Build-Depends: base , bytestring , containers , glib , mtl , 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 other-modules: GetText_bustle autogen-modules: GetText_bustle hs-source-dirs: . , src-hgettext else hs-source-dirs: . , src-no-hgettext Test-suite test-regions type: exitcode-stdio-1.0 main-is: Test/Regions.hs other-modules: Bustle.Regions default-language: Haskell2010 Build-Depends: base , QuickCheck 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 , Bustle.Translation , Bustle.Types , Bustle.Util default-language: Haskell2010 Build-Depends: base , cairo , containers , directory , filepath , glib , gtk3 , mtl , text , pango , test-framework , test-framework-hunit , transformers , HUnit if flag(hgettext) Build-Depends: hgettext >= 0.1.5 , setlocale other-modules: GetText_bustle autogen-modules: GetText_bustle hs-source-dirs: . , src-hgettext else hs-source-dirs: . , src-no-hgettext bustle-0.8.0/c-sources/bustle-pcap.c0000644000000000000000000001554013710546303015500 0ustar0000000000000000/* bustle-pcap.c: utility to log D-Bus traffic to a pcap file. * * Copyright © 2011–2018 Will Thompson * * This program 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 */ #include "config.h" #include #include #include #include #include #include "pcap-monitor.h" #include "version.h" static gboolean verbose = FALSE; static gboolean quiet = FALSE; static gboolean version = FALSE; static gboolean help = FALSE; static gboolean session_specified = FALSE; static gboolean system_specified = FALSE; static GBusType bus_type = G_BUS_TYPE_NONE; static gchar *address = NULL; static gchar **filenames = NULL; static GOptionEntry bus_entries[] = { { "session", 'e', 0, G_OPTION_ARG_NONE, &session_specified, "Monitor session bus (default)", NULL }, { "system", 'y', 0, G_OPTION_ARG_NONE, &system_specified, "Monitor system bus", NULL }, { "address", 'a', 0, G_OPTION_ARG_STRING, &address, "Monitor given D-Bus address", NULL }, { NULL } }; static GOptionEntry entries[] = { { "verbose", 'v', 0, G_OPTION_ARG_NONE, &verbose, "Print brief summaries of captured messages to stdout", NULL }, { "quiet", 'q', 0, G_OPTION_ARG_NONE, &quiet, "Don't print out instructions", NULL }, { "version", 'V', 0, G_OPTION_ARG_NONE, &version, "Print version information and exit", NULL }, { "help", 'h', 0, G_OPTION_ARG_NONE, &help, "Print help and exit", NULL }, { G_OPTION_REMAINING, 0, 0, G_OPTION_ARG_FILENAME_ARRAY, &filenames, "The filename to log to", NULL }, { NULL } }; static void parse_arguments ( int *argc, char ***argv, gchar **filename) { g_autoptr(GOptionContext) context; GOptionGroup *g; g_autofree gchar *usage; g_autoptr(GError) error = NULL; gboolean ret; gint exit_status = -1; int buses_specified; context = g_option_context_new ("FILENAME"); /* We implement --help by hand because the default implementation only shows * the main group, and we want to show the --session/--system/--address group * too. */ g_option_context_set_help_enabled (context, FALSE); g_option_context_add_main_entries (context, entries, NULL); g_option_context_set_summary (context, "Logs D-Bus traffic to FILENAME in a format suitable for bustle"); g = g_option_group_new ("bus", "Bus Options:", "Options specifying the bus to monitor", NULL, NULL); g_option_group_add_entries (g, bus_entries); g_option_context_add_group (context, g); ret = g_option_context_parse (context, argc, argv, &error); usage = g_option_context_get_help (context, FALSE, NULL); if (!ret) { fprintf (stderr, "%s\n", error->message); fprintf (stderr, "%s", usage); exit_status = 2; goto out; } buses_specified = !!session_specified + !!system_specified + !!address; if (help) { g_print ("%s", usage); exit_status = 0; goto out; } else if (version) { fprintf (stdout, "bustle-pcap " BUSTLE_VERSION "\n\n"); fprintf (stdout, "Copyright © 2011–2018 Will Thompson \n"); fprintf (stdout, "This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n\n"); fprintf (stdout, "Written by Will Thompson \n"); exit_status = 0; goto out; } else if (buses_specified > 1) { fprintf (stderr, "You may only specify one of --session, --system and --address\n"); fprintf (stderr, "%s", usage); exit_status = 2; goto out; } else if (address != NULL) { bus_type = G_BUS_TYPE_NONE; /* and the caller will use the global variable for the address */ } else if (system_specified) { bus_type = G_BUS_TYPE_SYSTEM; } else { bus_type = G_BUS_TYPE_SESSION; } if (filenames == NULL || filenames[0] == NULL || filenames[1] != NULL) { fprintf (stderr, "You must specify exactly one output filename\n"); fprintf (stderr, "%s", usage); exit_status = 2; goto out; } *filename = g_strdup (filenames[0]); out: g_strfreev (filenames); if (exit_status > -1) exit (exit_status); } static void message_logged_cb ( BustlePcapMonitor *pcap, glong sec, glong usec, guint8 *data, guint len, GDBusMessage *message, gpointer user_data) { 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 stopped_cb ( BustlePcapMonitor *pcap, guint domain, gint code, const gchar *message, gpointer user_data) { GMainLoop *loop = user_data; if (!(domain == G_IO_ERROR && code == G_IO_ERROR_CANCELLED)) g_printerr ("Error while monitoring: %s\n", message); g_main_loop_quit (loop); } static gboolean sigint_cb (gpointer user_data) { BustlePcapMonitor *pcap = user_data; bustle_pcap_monitor_stop (pcap); return G_SOURCE_CONTINUE; } int main ( int argc, char **argv) { GMainLoop *loop; gchar *filename; g_autoptr(GError) error = NULL; BustlePcapMonitor *pcap; parse_arguments (&argc, &argv, &filename); pcap = bustle_pcap_monitor_new (bus_type, address, filename, &error); if (pcap == NULL) { g_printerr ("Failed to start monitor: %s\n", error->message); exit (1); } if (verbose) g_signal_connect (pcap, "message-logged", G_CALLBACK (message_logged_cb), NULL); loop = g_main_loop_new (NULL, FALSE); g_signal_connect (pcap, "stopped", G_CALLBACK (stopped_cb), loop); if (!quiet) g_printf ("Logging D-Bus traffic to '%s'...\n", filename); g_unix_signal_add (SIGINT, sigint_cb, pcap); if (!quiet) g_printf ("Hit Control-C to stop logging.\n"); g_main_loop_run (loop); g_main_loop_unref (loop); bustle_pcap_monitor_stop (pcap); g_object_unref (pcap); g_free (filename); return 0; } bustle-0.8.0/c-sources/pcap-reader.h0000644000000000000000000000376213710546303015454 0ustar0000000000000000/* * 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 #include #include #include #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); bustle-0.8.0/c-sources/pcap-monitor.h0000644000000000000000000000253213442235205015671 0ustar0000000000000000/* * pcap-monitor.h - monitors a bus and dumps messages to a pcap file * Copyright © 2011–2012 Collabora Ltd. * Copyright © 2018 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 #include #define BUSTLE_TYPE_PCAP_MONITOR bustle_pcap_monitor_get_type () G_DECLARE_FINAL_TYPE (BustlePcapMonitor, bustle_pcap_monitor, BUSTLE, PCAP_MONITOR, GObject) BustlePcapMonitor *bustle_pcap_monitor_new ( GBusType bus_type, const gchar *address, const gchar *filename, GError **error); void bustle_pcap_monitor_stop ( BustlePcapMonitor *self); extern const char *BUSTLE_MONITOR_NAME_PREFIX; bustle-0.8.0/c-sources/config.h0000644000000000000000000000200113657324617014533 0ustar0000000000000000/* config.h: some preprocessor goop for Bustle's C code. * * Copyright © 2012 Collabora Ltd. * * This program 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 */ #ifndef BUSTLE_CONFIG_H #define BUSTLE_CONFIG_H #define GLIB_VERSION_MIN_REQUIRED GLIB_VERSION_2_56 #define GLIB_VERSION_MAX_ALLOWED GLIB_VERSION_2_56 #endif /* BUSTLE_CONFIG_H */ bustle-0.8.0/Makefile0000644000000000000000000001022113711017205012634 0ustar0000000000000000CFLAGS = -g -O2 -Wall -Wunused -Waddress DBUS_FLAGS = $(shell pkg-config --cflags --libs dbus-1) GIO_FLAGS := $(shell pkg-config --cflags --libs 'glib-2.0 >= 2.26' gio-2.0 gio-unix-2.0) PCAP_CONFIG ?= pcap-config PCAP_FLAGS := $(shell $(PCAP_CONFIG) --cflags pcap-config --libs) DESTDIR = PREFIX = /usr/local BINDIR = $(DESTDIR)$(PREFIX)/bin DATADIR = $(DESTDIR)$(PREFIX)/share MAN1DIR = $(DATADIR)/man/man1 BINARIES = \ dist/build/bustle-pcap \ $(NULL) MANPAGE = bustle-pcap.1 DESKTOP_FILE = org.freedesktop.Bustle.desktop APPDATA_FILE = org.freedesktop.Bustle.appdata.xml SCALABLE_ICONS = \ data/icons/hicolor/scalable/apps/org.freedesktop.Bustle.svg \ data/icons/hicolor/scalable/apps/org.freedesktop.Bustle.Devel.svg \ data/icons/hicolor/scalable/apps/org.freedesktop.Bustle-symbolic.svg \ $(NULL) all: $(BINARIES) $(MANPAGE) $(DESKTOP_FILE) $(APPDATA_FILE) $(SCALABLE_ICONS) 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-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' $< org.freedesktop.Bustle.desktop: data/org.freedesktop.Bustle.desktop.in msgfmt --desktop -d po --template $< -o $@ org.freedesktop.Bustle.appdata.xml: data/org.freedesktop.Bustle.appdata.xml.in msgfmt --xml -d po --template $< -o $@ # https://github.com/flathub/flathub/wiki/Review-Guidelines validate-metadata: org.freedesktop.Bustle.desktop org.freedesktop.Bustle.appdata.xml desktop-file-validate org.freedesktop.Bustle.desktop appstream-util validate org.freedesktop.Bustle.appdata.xml dist/build/bustle-pcap: $(BUSTLE_PCAP_SOURCES) $(BUSTLE_PCAP_HEADERS) @mkdir -p dist/build $(CC) -Idist/build/autogen $(CFLAGS) $(CPPFLAGS) $(LDFLAGS) \ -o $@ $(BUSTLE_PCAP_SOURCES) \ $(GIO_FLAGS) $(PCAP_FLAGS) dist/build/autogen/version.txt: bustle.cabal @mkdir -p `dirname $@` perl -nle 'm/^Version:\s+(.*)$$/ and print $$1' \ $< > $@ dist/build/autogen/version.h: dist/build/autogen/version.txt echo '#define BUSTLE_VERSION "'`cat $<`'"' > $@ install: all install -D -t $(BINDIR) $(BINARIES) -install -Dt $(MAN1DIR) $(MANPAGE) -install -Dt $(MAN1DIR) $(MANPAGE) install -Dt $(DATADIR)/applications $(DESKTOP_FILE) install -Dt $(DATADIR)/appdata $(APPDATA_FILE) install -Dt $(DATADIR)/icons/hicolor/scalable/apps $(SCALABLE_ICONS) $(MAKE) update-icon-cache uninstall: rm -f $(BINDIR)/$(notdir $(BINARIES)) rm -f $(MAN1DIR)/$(MANPAGE) rm -f $(DATADIR)/applications/$(DESKTOP_FILE) rm -f $(DATADIR)/appdata/$(APPDATA_FILE) rm -f $(DATADIR)/icons/hicolor/scalable/apps/org.freedesktop.Bustle.svg rm -f $(DATADIR)/icons/hicolor/scalable/apps/org.freedesktop.Bustle.Devel.svg rm -f $(DATADIR)/icons/hicolor/scalable/apps/org.freedesktop.Bustle-symbolic.svg $(MAKE) update-icon-cache clean: rm -f $(BINARIES) $(MANPAGE) $(BUSTLE_PCAP_GENERATED_HEADERS) $(DESKTOP_FILE) $(APPDATA_FILE) # Icon cache stuff gtk_update_icon_cache = gtk-update-icon-cache -f -t $(DATADIR)/icons/hicolor update-icon-cache: @-if test -z "$(DESTDIR)"; then \ echo "Updating GTK+ icon cache."; \ $(gtk_update_icon_cache); \ else \ echo "*** Icon cache not updated. After (un)install, run this:"; \ echo "*** $(gtk_update_icon_cache)"; \ fi # Flatpak stuff org.freedesktop.Bustle.flatpak: flatpak/org.freedesktop.Bustle.json rm -rf _build flatpak-builder --repo=repo -v _build $< flatpak build-bundle repo org.freedesktop.Bustle.flatpak org.freedesktop.Bustle # Maintainer stuff maintainer-update-messages-pot: find Bustle -name '*.hs' -print0 | xargs -0 stack exec -- hgettext -k __ -o po/messages.pot xgettext data/bustle.ui data/org.freedesktop.Bustle.desktop.in \ data/org.freedesktop.Bustle.appdata.xml.in --join-existing -o po/messages.pot maintainer-make-release: bustle.cabal dist/build/autogen/version.txt stack sdist --test-tarball git tag -s -m 'Bustle '`cat dist/build/autogen/version.txt` \ bustle-`cat dist/build/autogen/version.txt` gpg --detach-sign --armor dist/bustle-`cat dist/build/autogen/version.txt`.tar.gz bustle-0.8.0/README.md0000644000000000000000000000245513442235205012470 0ustar0000000000000000Bustle 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. [![pipeline status](https://gitlab.freedesktop.org/bustle/bustle/badges/master/pipeline.svg)](https://gitlab.freedesktop.org/bustle/bustle/commits/master) Download on Flathub Using Bustle ============ Run it: bustle Now click **File → New…** to start recording session bus traffic. When you're done, click **Stop**, and explore the log. If you want to record traffic without running the UI (maybe on an embedded platform which doesn't have Gtk+ and/or a Haskell compiler), you can use the stand-alone logger: bustle-pcap logfile.bustle You can then open `logfile.bustle` in Bustle. You can also get some ASCII-art version of the statistics shown in the UI: bustle --count logfile.bustle bustle --time logfile.bustle bustle-0.8.0/NEWS.md0000644000000000000000000004234713711020145012305 0ustar0000000000000000Bustle 0.8.0 (2020-07-31) ------------------------- Bustle has a new icon, kindly provided by Tobias Bernard. Closing a window without saving a recorded log no longer prompts for confirmation. Anecdotally, most users just want to record and read logs, not save them. Bustle now uses GLib's implementation of the D-Bus wire protocol throughout. The only user-facing consequence is that message bodies are now pretty-printed in the GVariant text format. Since Bustle no longer depends on any GPL libraries, the project license has been simplified to plain LGPL 2.1 or later. Bustle 0.7.5 (2019-03-08) ------------------------- User-facing changes: * As well as being able to filter out messages involving certain services, you can now also filter messages to only show certain services. Internal changes: * SVGs are now 256×256px to placate flatpak-validate-icon * Add Nix compatibility (Daniel Firth) Bustle 0.7.4 (2018-12-07) ------------------------- User-facing changes: * In the details for an error reply, the error name is now shown, and the error message is formatted more legibly. * The default file extension for log files is now `.pcap`, reflecting what they actually are. Internal changes: * When you stop monitoring the system bus, the privileged dbus-monitor process is now terminated promptly, rather than dying with “Broken pipe” the next time a message is sent on the bus. * Update all links to or depending on context. Bustle 0.7.3 (2018-11-15) ------------------------- User-facing changes: * Bustle now handles the application/vnd.tcpdump.pcap MIME type, which in practice means that your file manager will offer to open pcap files with Bustle. Internal changes: * Scalable non-symbolic icon is now installed. * Packagers should add a dependency on libpcap >= 1.9.0. This is not checked during build or at runtime (`pcap-config` does not accept a version check; libpcap does not provide a `.pc` file; and `pcap_lib_version()` returns a human-readable string of unspecified format) but is recommended to avoid running Bustle against libpcap 1.8.x, with which it is incompatible. Bustle 0.7.2 (2018-07-24) ------------------------- User-facing changes: * You can now explore messages while they're being recorded. (Filtering, statistics and exporting are still only available once you stop recording.) * The raw sender and destination for each message is now shown in the details pane. * Bytestrings with embedded NULs which are otherwise ASCII are now shown as ASCII strings. Internal changes: * New contributor Daniel Firth set up GitLab CI, with a linter, and provided many patches to clean up and modernize the code. * Jan Tojnar provided a build fix for Nix (and perhaps other distros). * GHC 8.4 is now required to build Bustle. Bustle 0.7.1 (2018-06-15) ------------------------- * It's now possible to monitor the system bus (from the user interface and with the bustle-pcap command-line tool), with no need to reconfigure the system bus. It's also possible to monitor an arbitrary bus by address. * Bustle now requires that a version of dbus-monitor new enough to support the --pcap argument is installed on the system. (This was added in DBus 1.9.10, released in February 2015.) * To monitor the system bus, Bustle requires the pkexec command to be installed on the host system. * Bustle now requires GLib 2.54 or newer. * The canonical Git repository and issue tracker has moved to . All open tickets have been migrated. Bustle 0.6.3 (2018-05-24) ------------------------- * The statistics sidebar now a more modern look and feel, and uses text to distinguish signals, method calls, etc. rather than font colour, italic text, and abstract shapes. * Sizes now use power-of-10 units, in common with the rest of the GNOME desktop. * Padding and alignment is more consistent. * A libpcap 0.8.0/0.8.1 incompatibility is now detected and handled specially. See [bug #100220](https://bugs.freedesktop.org/show_bug.cgi?id=100220#c7) for details. Distributions should apply downstream patches until until a new upstream release is made; users should [install Bustle from Flathub](https://flathub.org/apps/details/org.freedesktop.Bustle). * Most importantly, the welcome page is more beautiful. Bustle 0.6.2 (2017-10-26) ------------------------- * Check link type header in pcap files * Bump minimum GLib version to 2.44, and remove code for older versions * Compile C code with -g * Fix building with Cabal >= 2 * Fix a few compiler warnings Bustle 0.6.1 (2017-07-27) ------------------------- * Trivial fix to bustle.cabal. Bustle 0.6.0 (2017-07-26) ------------------------- * Fix leaks in bustle-pcap.c. (Jonny Lamb, ) * Add a Flatpak build manifest. * Don't crash if reading a file with libpcap fails. * Note that libpcap 1.8.0 and 1.8.1 (and hence Bustle) will still refuse to read log files generated by Bustle. This is fixed in libpcap Git by commits [1a6b088](https://github.com/the-tcpdump-group/libpcap/commit/1a6b088a88886eac782008f37a7219a32b86da45) and [42c3865](https://github.com/the-tcpdump-group/libpcap/commit/42c3865d71a3d3ad3fc61ee382ad3b5113d40552). * Add a Flatpak build manifest, which bundles a new-enough Git snapshot of libpcap. * Remove scripts to build artisan binary tarballs. * Drop support for pre-0.3.1 text-only log files. If you still have any valuable logs from before 2012, I can only apologise. * Add a Cabal flag to disable hgettext support. Since there are no non-English translations, the only user-visible impact is that some ‘curly quotes’ in three dialog boxes become 'legacy quotes'. * Rename bustle.desktop (etc.) to org.freedesktop.Bustle.desktop (etc.). * Fix a crash when reading logs generated with `dbus-monitor --pcap`. Bustle 0.5.4 (2016-01-27) ------------------------- * A single-byte functional change! * Use `DLT_DBUS` link type in pcap files Bustle 0.5.3 (2016-01-11) ------------------------- * No functional changes! * Add keywords to `.desktop` file * Update screenshots in `.appdata.xml` file Bustle 0.5.2 (2015-08-18) ------------------------- * No functional changes! * Update all links to * Remove external dependencies from Cabal build script for the benefit of Stackage and Travis-CI. Bustle 0.5.1 (2015-06-28) ------------------------- * Build fixes for GHC 7.10 (Sergei Trofimovich) Bustle 0.5.0 (2015-06-04) ------------------------- * Use Gtk+ 3, making Bustle more beautiful and support hidpi displays. * Fix warnings triggered by recent GHCs and standard libraries by completely mechanical patching. * Try not to crash if you view the body of a message containing a Unix FD. Bustle 0.4.8 (2015-03-22) ------------------------- * Be compatible with recent versions of Gtk2HS which use Text rather than Strings in many places. Should still build against older releases. Let me know if not. * [#89712][]: Add symbolic icon. (Arnaud Bonatti) [#89712]: https://bugs.freedesktop.org/show_bug.cgi?id=89712 Bustle 0.4.7 (2014-07-19) ------------------------- * Ship the icons in the tarball! Thanks again, Sergei Trofimovich. Bustle 0.4.6 (2014-07-17) ------------------------- * Icons! Thanks to Αποστολίδου Χρυσαφή for redrawing the icon as an SVG, and to Philip Withnall for the build system goop. * More appdata! Thanks again, Philip. Bustle 0.4.5 (2014-02-26) ------------------------- * Fix build failure with tests enabled due to translation files. * Distribute appdata and desktop files in source tarballs. Thanks to Sergei Trofimovich for catching and fixing these! Bustle 0.4.4 (2014-01-30) ------------------------- Wow, I can't believe the first release was in 2008! * Bustle's now translatable. It only ships with an English translation, but others are more than welcome! Thanks to Philip Withnall for getting this started. * Add an AppData and .desktop file. (Philip Withnall) Bustle 0.4.3 (2013-12-05) ------------------------- I think you mean ‘fewer crashy’. * Don't crash on i386 when opening the stats pane. Thanks to Sujith Sudhi for reporting this issue. * [#54237][]: Don't crash if we can't connect to the bus. * Don't crash the second time you try to record a log. I swear this didn't happen before. [#54237]: https://bugs.freedesktop.org/show_bug.cgi?id=54237 Bustle 0.4.2 (2012-11-14) ------------------------- This release is all about build fixes; nothing user-visible has changed. * The Makefile now respects the `DESTDIR` variable. * No more deprecation warnings about `g_thread_create()`! * We explicitly check for GLib ≥ 2.26. Also, there's now a `threaded` Cabal flag you can turn off if you're building for some platform where the threaded GHC runtime isn't available (such as S/390, MIPS or Sparc). This is the same approach used to make several other packages build for those architectures in Debian, as per [bug 541848][]. You can do something like this in your packaging: DEB_SETUP_GHC_CONFIGURE_ARGS := $(shell test -e /usr/lib/ghc-$(GHC_VERSION)/libHSrts_thr.a || echo --flags=-threaded) Bustle doesn't directly use Haskell-land threads, but I don't trust it not to break in this configuration, so it's not the default. [bug 541848]: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=541848#33 Bustle 0.4.1 (2012-08-29) ------------------------- Some dependency changes: * Gtk2HS ≥ 0.12 is now required. * Bustle now uses the [dbus][] Haskell library (≥ 0.10), which supersedes the [dbus-core][] package. * `binary` is no longer required. Some user-visible changes: * The front page now has two big buttons rather than some [lame instructions][fdo44889]. * Memory usage should be a bit better, particularly for wide logs showing lots of applications. Some plumbing changes: * You can now make a symlink to the launcher script and have it work properly. * Bustle [builds with GHC 7.4.1][fdo47013] (courtesy of Sergei Trofimovich). * `make clean` [works][fdo47908] in source tarballs. * `bustle-pcap` now has a man page (courtesy of Alex Merry). [dbus]: http://hackage.haskell.org/package/dbus-0.10 [fdo44889]: https://bugs.freedesktop.org/show_bug.cgi?id=44889 [fdo47013]: https://bugs.freedesktop.org/show_bug.cgi?id=47013 [fdo47908]: https://bugs.freedesktop.org/show_bug.cgi?id=47908 Bustle 0.4.0 (2012-01-18) ------------------------- The “let's hope my attention span lasts long enough” release. You can now record D-Bus logs from within Bustle itself. No more faffing around with command-line tools: just click **File → New**, and watch the diagram being drawn as the messages trickle (or fly) in. (If you want to capture logs from your embedded platform *du jour*, don't fear: `bustle-pcap` is still provided as a standalone program for your enjoyment.) Bustle no longer [crashes when it encounters messages containing file handles][crash-on-h]. (Those messages are now dropped; which is not perfect, but is at least an improvement.) Directed signals—signals with a specified destination, which are unusual but do appear—are now shown differently to normal, undirected signals, with an arrow pointing to the signal's recipient. Relatedly, the monitors now [explicitly eavesdrop on messages][eavesdrop] when using D-Bus 1.5.x, courtesy of Cosimo Alfarano. [crash-on-h]: https://bugs.freedesktop.org/show_bug.cgi?id=44714 [eavesdrop]: https://bugs.freedesktop.org/show_bug.cgi?id=39140 Bustle 0.3.1 (2012-01-09) ------------------------- The “How do I dress up as shared global mutable state?” release. This release finally allows you to record complete D-Bus sessions, including message bodies, and browse them in the user interface! As a result, there is a new logger, `bustle-pcap`, which logs D-Bus traffic to Pcap files; and Bustle itself now depends on the [pcap][] and [dbus-core][] packages. Your old logs should still be loaded just fine, but since they don't contain message body data, you won't be able to see it in the UI. Also, as of this release binary tarballs will be provided for those not interested in compiling Bustle themselves. [pcap]: http://hackage.haskell.org/package/pcap [dbus-core]: http://hackage.haskell.org/package/dbus-core Bustle 0.3.0 ------------ You can't prove anything. Bustle 0.2.5 (2011-06-25) ------------------------- The “Why go all the way to Glastonbury to not watch U2 when you can just not turn on the BBC at any point this weekend to not watch them?” release. This adds a sidebar with statistics about the log: namely, method call and signal emission frequency, and total/mean times spent in method calls. This code has mostly been sitting around unreleased since November. Sorry, dear users! Bustle 0.2.4 (2011-06-06) ------------------------- The “I think I'm a panda” release. There's just a few bits and pieces of clean-up along with a couple of bug fixes in this release. Hopefully there will be more interesting stuff in the next release. While we're here, Bustle's git repository has moved to freedesktop.org, and it now has a bug tracker there too. Browse the source at ; see open bugs at ; file new ones at . Astonishing! * The viewer is now much more tolerant of inconsistencies in log files. (Thanks to Marco Barisione for the [bug report][fdo35297].) * The linking order for bustle-dbus-monitor is fixed. (Thanks to Sergei Trofimovich.) * Miscellaneous clean-up. [fdo35297]: https://bugs.freedesktop.org/show_bug.cgi?id=35297 Bustle 0.2.3 (2010-10-29) ------------------------- The “Will it be a scone? Or will it be a lecture in category theory?” release.
[[!img bustle-0.2.3.png size="200x143" alt="screenshot of side-by-side session and system bus logs" class="floated screenshot"]]
You can now show a session bus log and a system bus log side-by-side, with the same time scale and with events interleaved as they happened. This might come in useful for full-system profiling, or for frameworks where actions on one bus lead to reactions on another. Record the two logs as normal, by running something like: > % bustle-dbus-monitor --session \> session.bustle &
> % bustle-dbus-monitor --system \> system.bustle & Then go do whatever you want to profile. When you're done, kill the two loggers. In Bustle, choose **File → Open a pair of logs…** to show them side-by-side. You can save the diagram to a PDF as normal. Bustle 0.2.2 (2010-06-29) ------------------------- The “Shepherded” release. Fixes: * Suppress messages sent to the bus by bus name, rather than object path. This prevents Bustle blowing up when (buggy) clients call methods on / rather than on /org/freedesktop/DBus. (Thanks to Guillaume Desmottes for reporting the issue.) * Build against the re-namespaced Pango in Gtk2HS 0.11, and clean up a tonne of warnings. I think I've kept backwards compatibility with old enough Gtk2HSes and GHCs for this to work with the versions in Ubuntu 10.04 and other recent-but-not-futuristic distros, but haven't actually tried it. Drop me a mail in the event of landing on water. (Thanks to Chris Lamb for upstreaming this from Debian bug #587132.) Bustle 0.2.1 (2009-12-02) ------------------------- The “Going down where the Firefly goes” release. Enhancements: * The handling of services with multiple well-known names has improved. Whereas previously one name was (essentially) randomly-chosen, now all names owned by a service are shown in the diagram. * When a service falls off the bus, its column goes away to indicate that. * Strings are now ellipsized if necessary. * Method returns now include the object path and method name so you don't have to look it up yourself. * The UI is less spartan: you can open files, and launch it without passing at least one filename as a command-line argument. Fixes: * The UI handles parse errors gracefully rather than, uhm, throwing an exception and dying. * bustle-dbus-monitor now has rudimentary cross-compilation support, by respecting $CC and friends. (Marc Kleine-Budde) * You can now kill the monitor immediately with ^C, rather than waiting for another message to arrive. (Lennart Poettering, from a patch for dbus-monitor) Notes: * While your old logs should continue to work with the new viewer, the reverse is not true: the changes to name handling required modifying the log format. Bustle 0.2.0 (2009-04-03) ------------------------- The "new monkey makes me sad :-(" release. Enhancements: * Add a menu item to save a PDF of the diagram. * Show the elapsed time between a method call and its return. * Add new tools to count method calls and signals, sum the total time spent per method call, and generate .dot graphs (Dafydd Harries). Fixes: * Don't crash on empty logs, or logs containing calls on interface "". * Compile with new Gtk2HS and GHC 6.10 (Chris Lamb). Bustle 0.1 (2008-11-13) ----------------------- Initial release. vim: tw=72 bustle-0.8.0/CONTRIBUTING.md0000644000000000000000000000254613442235205013443 0ustar0000000000000000Want to get involved? Great! ============================ Make sure you have an up-to-date Haskell toolchain. I recommend using [Stack](https://haskellstack.org/) for development. Make sure you run `stack update` if you install it from a distro package before continuing. Grab the latest code from git: git clone https://gitlab.freedesktop.org/bustle/bustle.git cd bustle Build it: stack build Run it: stack exec bustle Test it: stack test Please file bugs and merge requests at . In new code, try to follow . The author did not follow it in the past but it seems like a good kind of thing to aim for. Releasing Bustle ================ * Ideally, automate the steps below * Write news in `NEWS.md` and `data/org.freedesktop.Bustle.appdata.xml.in` * Update version number in `bustle.cabal` ```sh # Tag release, build and sign the tarballs make maintainer-make-release # Stick source and binaries on freedesktop.org mkdir x.y.z cp dist/bustle-x.y.z* x.y.z/ scp -r x.y.z annarchy.freedesktop.org:/srv/www.freedesktop.org/www/software/bustle/ # Upload source to Hackage stack upload . git push origin --tags master ``` * Add `.1` to version number in `bustle.cabal` * Update bustle-0.8.0/INSTALL.md0000644000000000000000000000306713442235205012641 0ustar0000000000000000Installing from Flathub ======================= If you don't want to modify Bustle, by far the easiest way to install it is to [get it from Flathub](https://gitlab.freedesktop.org/bustle/bustle). Download on Flathub Building from source ==================== I recommend using Stack; see the instructions in [CONTRIBUTING.md](./CONTRIBUTING.md). You can also build a Git checkout using Flatpak: ``` flatpak-builder --install --user --force-clean app flatpak/org.freedesktop.Bustle.yaml ``` On exotic platforms with no Haskell toolchain ============================================= If you're working on an embedded platform, you may have D-Bus but no Haskell toolchain, and you may not want to bootstrap everything just to run Bustle on the target device. That's fine: Bustle was originally written for exactly this situation! First, install Bustle on your (x86_64) development system as above. You then have two options to monitor D-Bus traffic on the target device: 1. On the target device, run `dbus-monitor --pcap --session >session.pcap`, and hit `Ctrl+C` when you're done. Then copy `session.pcap` to your development system, and open it in Bustle. 2. On the target device, arrange for D-Bus to be accessible via TCP or via some kind of socket forwarding. On your development system, run Bustle, choose _Record → Record Address_, and enter the remote address in the same form accepted by `dbus-monitor`. bustle-0.8.0/bustle.doap0000644000000000000000000000256713442236246013366 0ustar0000000000000000 Bustle Draw sequence diagrams of D-Bus activity Bustle draws sequence diagrams of D-Bus activity. It shows signal emissions, method calls and their corresponding returns, with time stamps 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 is not performing as well as you like. It also provides statistics like signal frequencies and average method call times. Haskell Will Thompson wjt bustle-0.8.0/run-uninstalled.sh0000755000000000000000000000042713657457175014715 0ustar0000000000000000#!/bin/sh set -e root="$(dirname ${0}})" # Cabal generates code that uses this bustle_datadir="${root}" # For Gtk+'s benefit XDG_DATA_HOME=$bustle_datadir/data export bustle_datadir XDG_DATA_HOME bustle="${root}"/dist/build/bustle/bustle cabal build 1>&2 exec $bustle "${@}" bustle-0.8.0/Test/data/log-with-h.bustle0000644000000000000000000011525313710546303016243 0ustar0000000000000000òOSl s:1.1007gso/org/freedesktop/DBussAddMatchsorg.freedesktop.DBussorg.freedesktop.DBus type='error'OhTl uo/org/freedesktop/DBuss ListNamessorg.freedesktop.DBussorg.freedesktop.DBusOUlU hs:1.1007gss(org.freedesktop.DBus.Error.UnknownMethodus:1.1007PNo such interface `org.freedesktop.DBus' on object at path /org/freedesktop/DBusOXl @sorg.freedesktop.DBusgasu s:1.1007org.freedesktop.DBus:1.1065org.freedesktop.Telepathy.Client.Empathy.FileTransferorg.freedesktop.Notifications:1.107:1.108:1.328:1.329%org.freedesktop.Tracker1.Miner.Flickr:1.9681org.freedesktop.Telepathy.ConnectionManager.psyke<org.freedesktop.Telepathy.Client.CallObserver._3a1_2e1000.n0'org.freedesktop.Telepathy.Client.Logger org.gtk.Private.AfcVolumeMonitorcom.meego.libsocialweborg.gtk.vfs.Daemonorg.pulseaudio.Server5org.freedesktop.Telepathy.Client.Empathy.CallObservercom.redhat.abrt.appletorg.gnome.SessionManager:1.80:1.81-org.freedesktop.Telepathy.Client.Empathy.Chat:1.190:1.82org.gnome.Tomboy:1.61:1.83:1.62org.gnome.GConf:1.40:1.84:1.63:1.85:1.64 org.gnome.network_manager_applet:1.65:1.66org.gnome.keyringorg.gnome.Shell.CalendarServerorg.gnome.EvolutionAlarmNotify:1.67org.gnome.Shell:1.45:1.89:1.68:1.330:1.24Forg.freedesktop.Telepathy.Client.Empathy.ChatroomManager._3a1_2e755.n0:1.111:1.69org.gnome.Caribou.Keyboard:1.331:1.177:1.47:1.25:1.133:1.112:1.332:1.48:1.26:1.134:1.113:1.333:1.49:1.27:1.135:1.994:1.334(org.gnome.evolution.dataserver.Calendar1:1.28:1.9952org.freedesktop.Telepathy.ConnectionManager.gabble:1.335+org.freedesktop.Telepathy.ChannelDispatcher:1.29ca.desrt.dconfcom.redhat.imsettings:1.996:1.116:1.336+org.freedesktop.Tracker1.Miner.ApplicationsForg.freedesktop.Telepathy.Client.Empathy.ChatroomManager._3a1_2e189.n0org.gnome.SettingsDaemon:1.755:1.117:1.337:1.756:1.118org.freedesktop.Tracker1:1.338:1.757:1.119:1.339:1.758org.gnome.Evolution org.gnome.Do:1.3199org.freedesktop.Telepathy.Client.GnomeShell._3a1_2e332.n0org.gnome.NautilusApplicationorg.gnome.Magnifierorg.gnome.Terminal.Display_0_0+org.gnome.evolution.dataserver.AddressBook1org.gnome.Nautilus]org.freedesktop.Telepathy.Connection.gabble.jabber.dannielle_2emeyer_40gmail_2ecom_2f4d053a41(org.freedesktop.Telepathy.AccountManagerorg.gnome.Panel5org.freedesktop.Telepathy.Client.Empathy.EventManager org.gtk.Private.GduVolumeMonitor:1.90forg.freedesktop.Telepathy.Connection.gabble.jabber.danielle_2emadeley_40collabora_2eco_2euk_2f4d053a41:1.91>org.freedesktop.Telepathy.Connection.psyke.skype.danni_5fmeyer:1.92org.gnome.OnlineAccountsorg.gnome.ScreenSaver:1.71:1.72:1.50org.gnome.Empathy.Chat:1.51:1.95org.gnome.Empathyorg.gtk.vfs.Metadata9org.freedesktop.Telepathy.Client.Empathy.AuthEventManager:1.30:1.96:1.31:1.97:1.1000:1.76:1.32:1.1001:1.33:1.99:1.1002:1.78)org.freedesktop.Telepathy.MissionControl5:1.56:1.34:1.1003:1.79:1.35:1.264:1.1004org.gtk.vfs.mountpoint.http:1.485:1.188:1.100:1.36:1.265:1.144:1.486org.freedesktop.secrets:1.189:1.59:1.684$org.freedesktop.Tracker1.Miner.Files:1.37:1.266:1.145:1.2:1.487 org.freedesktop.Telepathy.Logger:1.38:1.267:1.146:1.3:1.1007:1.488:1.345:1.103:1.39:1.268:1.4$org.gtk.Private.GPhoto2VolumeMonitor:1.346:1.104org.gnome.Devhelp:1.269:1.5:1.347:1.105*org.freedesktop.Tracker1.Miner.Files.Index:1.6OZl s:1.1007o/org/freedesktop/DBuss ListNamessorg.freedesktop.DBussorg.freedesktop.DBusO[l: }gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus5org.freedesktop.Telepathy.Client.Empathy.FileTransferO\[[l @sorg.freedesktop.DBusgsu s:1.1007:1.755O{]l: s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus5org.freedesktop.Telepathy.Client.Empathy.FileTransferO]l" }gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.freedesktop.NotificationsO^[[l @sorg.freedesktop.DBusgsu s:1.1007:1.332O_l" s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.freedesktop.NotificationsO`l*}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus%org.freedesktop.Tracker1.Miner.FlickrO`ZZl @sorg.freedesktop.DBusgsus:1.1007:1.59Oal*s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus%org.freedesktop.Tracker1.Miner.FlickrO!bl6}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus1org.freedesktop.Telepathy.ConnectionManager.psykeOc[[l @sorg.freedesktop.DBusgsus:1.1007:1.968Ocl6s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus1org.freedesktop.Telepathy.ConnectionManager.psykeOOdlA}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus<org.freedesktop.Telepathy.Client.CallObserver._3a1_2e1000.n0O=e\\l @sorg.freedesktop.DBusgsus:1.1007:1.1000OflAs:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus<org.freedesktop.Telepathy.Client.CallObserver._3a1_2e1000.n0Omfl,}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus'org.freedesktop.Telepathy.Client.LoggerO_gZZl @sorg.freedesktop.DBusgsus:1.1007:1.79O:hl,s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus'org.freedesktop.Telepathy.Client.LoggerOhl%}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gtk.Private.AfcVolumeMonitorOHjZZl @sorg.freedesktop.DBusgsus:1.1007:1.40O9kl%s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gtk.Private.AfcVolumeMonitorOkl}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBuscom.meego.libsocialwebOl[[l @sorg.freedesktop.DBusgsus:1.1007:1.104O}mls:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBuscom.meego.libsocialwebOml}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gtk.vfs.DaemonOnYYl @sorg.freedesktop.DBusgsus:1.1007:1.4Ools:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gtk.vfs.DaemonOpl}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.pulseaudio.ServerOqZZl @sorg.freedesktop.DBusgsus:1.1007:1.29Oqls:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.pulseaudio.ServerOPrl:}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus5org.freedesktop.Telepathy.Client.Empathy.CallObserverOFs[[l @sorg.freedesktop.DBusgsus:1.1007:1.755O+tl:s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus5org.freedesktop.Telepathy.Client.Empathy.CallObserverOtl}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBuscom.redhat.abrt.appletOruZZl @sorg.freedesktop.DBusgsus:1.1007:1.71ONvls:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBuscom.redhat.abrt.appletOvl}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.SessionManagerOwZZl @sorg.freedesktop.DBusgsus:1.1007:1.24Otxls:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.SessionManagerOxl2}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus-org.freedesktop.Telepathy.Client.Empathy.ChatOy[[l @sorg.freedesktop.DBusgsus:1.1007:1.189Ozl2s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus-org.freedesktop.Telepathy.Client.Empathy.ChatOzl}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.TomboyO{ZZl @sorg.freedesktop.DBusgsus:1.1007:1.85O|ls:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.TomboyO}l}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.GConfO~ZZl @sorg.freedesktop.DBusgsus:1.1007:1.32O~ls:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.GConfOCl%}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gnome.network_manager_appletOZZl @sorg.freedesktop.DBusgsus:1.1007:1.51Ol%s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gnome.network_manager_appletOl}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.keyringOZZl @sorg.freedesktop.DBusgsus:1.1007:1.30Ols:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.keyringOKl#}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Shell.CalendarServerO[[l @sorg.freedesktop.DBusgsus:1.1007:1.337Ol#s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Shell.CalendarServerOنl#}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.EvolutionAlarmNotifyO7ZZl @sorg.freedesktop.DBusgsus:1.1007:1.72Ol#s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.EvolutionAlarmNotifyOql }gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.ShellOĊ[[l @sorg.freedesktop.DBusgsu s:1.1007:1.332Ol s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.ShellOlK!}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusForg.freedesktop.Telepathy.Client.Empathy.ChatroomManager._3a1_2e755.n0OL[[l @sorg.freedesktop.DBusgsu!s:1.1007:1.755O/lK!s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusForg.freedesktop.Telepathy.Client.Empathy.ChatroomManager._3a1_2e755.n0Ol"}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Caribou.KeyboardOÏ[[l !@sorg.freedesktop.DBusgsu"s:1.1007:1.332Ol"s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Caribou.KeyboardOl-#}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus(org.gnome.evolution.dataserver.Calendar1OGZZl "@sorg.freedesktop.DBusgsu#s:1.1007:1.83O%l-#s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus(org.gnome.evolution.dataserver.Calendar1Oyl7$}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus2org.freedesktop.Telepathy.ConnectionManager.gabbleO[[l #@sorg.freedesktop.DBusgsu$s:1.1007:1.994Ol7$s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus2org.freedesktop.Telepathy.ConnectionManager.gabbleOl0%}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus+org.freedesktop.Telepathy.ChannelDispatcherO6ZZl $@sorg.freedesktop.DBusgsu%s:1.1007:1.78Ol0%s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus+org.freedesktop.Telepathy.ChannelDispatcherOgl&}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusca.desrt.dconfOZZl %@sorg.freedesktop.DBusgsu&s:1.1007:1.45Ol&s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusca.desrt.dconfOl'}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBuscom.redhat.imsettingsO3YYl &@sorg.freedesktop.DBusgsu's:1.1007:1.2Ol's:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBuscom.redhat.imsettingsOel0(}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus+org.freedesktop.Tracker1.Miner.ApplicationsOZZl '@sorg.freedesktop.DBusgsu(s:1.1007:1.66Ol0(s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus+org.freedesktop.Tracker1.Miner.ApplicationsOlK)}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusForg.freedesktop.Telepathy.Client.Empathy.ChatroomManager._3a1_2e189.n0O![[l (@sorg.freedesktop.DBusgsu)s:1.1007:1.189OlK)s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusForg.freedesktop.Telepathy.Client.Empathy.ChatroomManager._3a1_2e189.n0OVl*}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.SettingsDaemonOZZl )@sorg.freedesktop.DBusgsu*s:1.1007:1.26Oxl*s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.SettingsDaemonO̤l+}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.freedesktop.Tracker1OZZl *@sorg.freedesktop.DBusgsu+s:1.1007:1.62Ol+s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.freedesktop.Tracker1OEl,}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.EvolutionO[[l +@sorg.freedesktop.DBusgsu,s:1.1007:1.267Ofl,s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.EvolutionOl-}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gnome.DoOZZl ,@sorg.freedesktop.DBusgsu-s:1.1007:1.96O׫l-s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gnome.DoO,l>.}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus9org.freedesktop.Telepathy.Client.GnomeShell._3a1_2e332.n0Or[[l -@sorg.freedesktop.DBusgsu.s:1.1007:1.332OPl>.s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus9org.freedesktop.Telepathy.Client.GnomeShell._3a1_2e332.n0Ol"/}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.NautilusApplicationO[[l .@sorg.freedesktop.DBusgsu/s:1.1007:1.486Oðl"/s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.NautilusApplicationOl0}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.MagnifierO][[l /@sorg.freedesktop.DBusgsu0s:1.1007:1.332O8l0s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.MagnifierOl#1}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Terminal.Display_0_0Oʴ[[l 0@sorg.freedesktop.DBusgsu1s:1.1007:1.134Ol#1s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Terminal.Display_0_0Ol02}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus+org.gnome.evolution.dataserver.AddressBook1OIZZl 1@sorg.freedesktop.DBusgsu2s:1.1007:1.95O'l02s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus+org.gnome.evolution.dataserver.AddressBook1O{l3}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.NautilusOȹ[[l 2@sorg.freedesktop.DBusgsu3s:1.1007:1.486Ol3s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.NautilusOlb4}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus]org.freedesktop.Telepathy.Connection.gabble.jabber.dannielle_2emeyer_40gmail_2ecom_2f4d053a41O?[[l 3@sorg.freedesktop.DBusgsu4s:1.1007:1.994O#lb4s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus]org.freedesktop.Telepathy.Connection.gabble.jabber.dannielle_2emeyer_40gmail_2ecom_2f4d053a41Oxl-5}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus(org.freedesktop.Telepathy.AccountManagerOZZl 4@sorg.freedesktop.DBusgsu5s:1.1007:1.78Ol-5s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus(org.freedesktop.Telepathy.AccountManagerOl6}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.PanelO4[[l 5@sorg.freedesktop.DBusgsu6s:1.1007:1.332Ol6s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.PanelOdl:7}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus5org.freedesktop.Telepathy.Client.Empathy.EventManagerO[[l 6@sorg.freedesktop.DBusgsu7s:1.1007:1.755Ol:7s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus5org.freedesktop.Telepathy.Client.Empathy.EventManagerOl%8}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gtk.Private.GduVolumeMonitorO&ZZl 7@sorg.freedesktop.DBusgsu8s:1.1007:1.38Ol%8s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.gtk.Private.GduVolumeMonitorOXlk9}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusforg.freedesktop.Telepathy.Connection.gabble.jabber.danielle_2emadeley_40collabora_2eco_2euk_2f4d053a41O[[l 8@sorg.freedesktop.DBusgsu9s:1.1007:1.994O  lk9s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusforg.freedesktop.Telepathy.Connection.gabble.jabber.danielle_2emadeley_40collabora_2eco_2euk_2f4d053a41OlC:}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus>org.freedesktop.Telepathy.Connection.psyke.skype.danni_5fmeyerO[[l 9@sorg.freedesktop.DBusgsu:s:1.1007:1.968OlC:s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus>org.freedesktop.Telepathy.Connection.psyke.skype.danni_5fmeyerOQl;}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.OnlineAccountsOZZl :@sorg.freedesktop.DBusgsu;s:1.1007:1.90Ol;s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.OnlineAccountsOl<}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.ScreenSaverOZZl ;@sorg.freedesktop.DBusgsu<s:1.1007:1.68Ol<s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.ScreenSaverORl=}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Empathy.ChatO[[l <@sorg.freedesktop.DBusgsu=s:1.1007:1.190O{l=s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.Empathy.ChatOl>}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.EmpathyO[[l =@sorg.freedesktop.DBusgsu>s:1.1007:1.757Ol>s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.EmpathyONl?}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gtk.vfs.MetadataO[[l >@sorg.freedesktop.DBusgsu?s:1.1007:1.177Osl?s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gtk.vfs.MetadataOl>@}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus9org.freedesktop.Telepathy.Client.Empathy.AuthEventManagerO[[l ?@sorg.freedesktop.DBusgsu@s:1.1007:1.755Ol>@s:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus9org.freedesktop.Telepathy.Client.Empathy.AuthEventManagerOAl.A}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus)org.freedesktop.Telepathy.MissionControl5OZZl @@sorg.freedesktop.DBusgsuAs:1.1007:1.78Oml.As:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus)org.freedesktop.Telepathy.MissionControl5Ol B}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gtk.vfs.mountpoint.httpO[[l A@sorg.freedesktop.DBusgsuBs:1.1007:1.145Ol Bs:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gtk.vfs.mountpoint.httpOBlC}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.freedesktop.secretsOZZl B@sorg.freedesktop.DBusgsuCs:1.1007:1.30OflCs:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.freedesktop.secretsOl)D}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus$org.freedesktop.Tracker1.Miner.FilesOZZl C@sorg.freedesktop.DBusgsuDs:1.1007:1.66Ol)Ds:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus$org.freedesktop.Tracker1.Miner.FilesO:l%E}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.freedesktop.Telepathy.LoggerOZZl D@sorg.freedesktop.DBusgsuEs:1.1007:1.79O`l%Es:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus org.freedesktop.Telepathy.LoggerOl)F}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus$org.gtk.Private.GPhoto2VolumeMonitorOZZl E@sorg.freedesktop.DBusgsuFs:1.1007:1.39Ol)Fs:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus$org.gtk.Private.GPhoto2VolumeMonitorO2lG}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.DevhelpOv[[l F@sorg.freedesktop.DBusgsuGs:1.1007:1.347O[lGs:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBusorg.gnome.DevhelpOl/H}gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus*org.freedesktop.Tracker1.Miner.Files.IndexOZZl G@sorg.freedesktop.DBusgsuHs:1.1007:1.66Ol/Hs:1.1007gso/org/freedesktop/DBuss GetNameOwnersorg.freedesktop.DBussorg.freedesktop.DBus*org.freedesktop.Tracker1.Miner.Files.IndexOt44lI}gso/org/freedesktop/DBuss RemoveMatchsorg.freedesktop.DBussorg.freedesktop.DBustype='signal',sender='org.freedesktop.DBus',interface='org.freedesktop.DBus',member='NameOwnerChanged',path='/org/freedesktop/DBus',arg0='org.freedesktop.DBus'OHHlH8sorg.freedesktop.DBusuIs:1.1007OGDDlIs:1.1007gso/org/freedesktop/DBuss RemoveMatchsorg.freedesktop.DBussorg.freedesktop.DBustype='signal',sender='org.freedesktop.DBus',interface='org.freedesktop.DBus',member='NameOwnerChanged',path='/org/freedesktop/DBus',arg0='org.freedesktop.DBus'O@ l sorg.freedesktop.DBusgssso/org/freedesktop/DBussorg.freedesktop.DBussNameOwnerChanged:1.1008:1.1008O, l}s:1.1008o/org/freedesktop/DBussorg.freedesktop.DBussHellosorg.freedesktop.DBusO ls:1.1008gso/org/freedesktop/DBussorg.freedesktop.DBussAddMatchsorg.freedesktop.DBus type='signal'O ls:1.1008gso/org/freedesktop/DBussorg.freedesktop.DBussAddMatchsorg.freedesktop.DBustype='method_call'O ls:1.1008gso/org/freedesktop/DBussorg.freedesktop.DBussAddMatchsorg.freedesktop.DBustype='method_return'O ls:1.1008gso/org/freedesktop/DBussorg.freedesktop.DBussAddMatchsorg.freedesktop.DBus type='error'O l$Es:1.66gsdio%/org/freedesktop/Tracker1/Miner/FilessProgresssorg.freedesktop.Tracker1.Miner Processing…?O lFs:1.66gh uo"/org/freedesktop/Tracker1/Steroidss UpdateArrays!org.freedesktop.Tracker1.Steroidssorg.freedesktop.Tracker1OJ YYl6s:1.62gas uuFs:1.66 ON lGs:1.66gsdio%/org/freedesktop/Tracker1/Miner/FilessProgresssorg.freedesktop.Tracker1.MinerIdle?Ol sorg.freedesktop.DBusgssso/org/freedesktop/DBussorg.freedesktop.DBussNameOwnerChanged:1.1008:1.1008bustle-0.8.0/GetText.hs0000644000000000000000000002034213700421730013121 0ustar0000000000000000-- | This library extends the Distribution with internationalization support. -- -- It performs two functions: -- -- * compiles and installs PO files to the specified directory -- -- * tells the application where files were installed to make it able -- to bind them to the code -- -- Each PO file will be placed to the -- @{datadir}\/locale\/{loc}\/LC_MESSAGES\/{domain}.mo@ where: -- -- [@datadir@] Usually @prefix/share@ but could be different, depends -- on system. -- -- [@loc@] Locale name (language code, two characters). This module -- supposes, that each PO file has a base name set to the proper -- locale, e.g. @de.po@ is the German translation of the program, so -- this file will be placed under @{datadir}\/locale\/de@ directory -- -- [@domain@] Program domain. A unique identifier of single -- translational unit (program). By default domain will be set to the -- package name, but its name could be configured in the @.cabal@ file. -- -- The module defines following @.cabal@ fields: -- -- [@x-gettext-domain-name@] Name of the domain. One ofmore -- alphanumeric characters separated by hyphens or underlines. When -- not set, package name will be used. -- -- [@x-gettext-po-files@] List of files with translations. Could be -- used a limited form of wildcards, e.g.: @x-gettext-po-files: -- po/*.po@ -- -- [@x-gettext-domain-def@] Name of the macro, in which domain name -- will be passed to the program. Default value is -- @__MESSAGE_CATALOG_DOMAIN__@ -- -- [@x-gettext-msg-cat-def@] Name of the macro, in which path to the -- message catalog will be passed to the program. Default value is -- @__MESSAGE_CATALOG_DIR__@ -- -- The last two parameters are used to send configuration data to the -- code during its compilation. The most common usage example is: -- -- -- > ... -- > prepareI18N = do -- > setLocale LC_ALL (Just "") -- > bindTextDomain __MESSAGE_CATALOG_DOMAIN__ (Just __MESSAGE_CATALOG_DIR__) -- > textDomain __MESSAGE_CATALOG_DOMAIN__ -- > -- > main = do -- > prepareI18N -- > ... -- > -- > ... -- -- -- /NOTE:/ files, passed in the @x-gettext-po-files@ are not -- automatically added to the source distribution, so they should be -- also added to the @extra-source-files@ parameter, along with -- translation template file (usually @message.pot@) -- -- /WARNING:/ sometimes, when only configuration targets changes, code -- will not recompile, thus you should execute @cabal clean@ to -- cleanup the build and restart it again from the configuration. This -- is temporary bug, it will be fixed in next releases. -- -- /TODO:/ this is lifted verbatim (modulo other /TODO/s) from hgettext's -- Distribution.Simple.I18N.GetText partly to expose individual hooks and -- partly to avoid the /cabal configure/-time dependency. For the latter, -- see https://github.com/fpco/stackage/issues/746 -- module GetText ( -- | /TODO:/ upstream exporting the individual hooks? installPOFiles, -- | /TODO:/ upstream generating GetText_foo.hs rather than exporting these? getDomainNameDefault, getPackageName, targetDataDir, installGetTextHooks, gettextDefaultMain ) where import Distribution.Simple import Distribution.Simple.Setup as S import Distribution.Simple.LocalBuildInfo import Distribution.PackageDescription import Distribution.Simple.Configure import Distribution.Simple.InstallDirs as I import Distribution.Simple.Utils import Language.Haskell.Extension import Control.Monad import Control.Arrow (second) import Data.Maybe (listToMaybe, maybeToList, fromMaybe) import Data.List (unfoldr,nub,null) import System.FilePath import System.Directory import System.Process -- | Default main function, same as -- -- > defaultMainWithHooks $ installGetTextHooks simpleUserHooks -- gettextDefaultMain :: IO () gettextDefaultMain = defaultMainWithHooks $ installGetTextHooks simpleUserHooks -- | Installs hooks, used by GetText module to install -- PO files to the system. Previous won't be disabled -- installGetTextHooks :: UserHooks -- ^ initial user hooks -> UserHooks -- ^ patched user hooks installGetTextHooks uh = uh{ confHook = \a b -> updateLocalBuildInfo <$> confHook uh a b, postInst = \a b c d -> postInst uh a b c d >> installPOFiles a b c d } updateLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo updateLocalBuildInfo l = let sMap = getCustomFields l [domDef, catDef] = map ($ sMap) [getDomainDefine, getMsgCatalogDefine] dom = getDomainNameDefault sMap (getPackageName l) tar = targetDataDir l [catMS, domMS] = map (uncurry formatMacro) [(domDef, dom), (catDef, tar)] in (appendCPPOptions [domMS,catMS] . appendExtension [EnableExtension CPP]) l installPOFiles :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO () installPOFiles _ _ _ l = let sMap = getCustomFields l destDir = targetDataDir l dom = getDomainNameDefault sMap (getPackageName l) installFile file = do let fname = takeFileName file let bname = takeBaseName fname let targetDir = destDir bname "LC_MESSAGES" -- ensure we have directory destDir/{loc}/LC_MESSAGES createDirectoryIfMissing True targetDir system $ "msgfmt --output-file=" ++ (targetDir dom <.> "mo") ++ " " ++ file in do filelist <- getPoFilesDefault sMap -- copy all whose name is in the form of dir/{loc}.po to the -- destDir/{loc}/LC_MESSAGES/dom.mo -- with the 'msgfmt' tool mapM_ installFile filelist forBuildInfo :: LocalBuildInfo -> (BuildInfo -> BuildInfo) -> LocalBuildInfo forBuildInfo l f = let a = l{localPkgDescr = updPkgDescr (localPkgDescr l)} updPkgDescr x = x{library = updLibrary (library x), executables = updExecs (executables x)} updLibrary Nothing = Nothing updLibrary (Just x) = Just $ x{libBuildInfo = f (libBuildInfo x)} updExecs = map updExec updExec x = x{buildInfo = f (buildInfo x)} in a appendExtension :: [Extension] -> LocalBuildInfo -> LocalBuildInfo appendExtension exts l = forBuildInfo l updBuildInfo where updBuildInfo x = x{defaultExtensions = updExts (defaultExtensions x)} updExts s = nub (s ++ exts) appendCPPOptions :: [String] -> LocalBuildInfo -> LocalBuildInfo appendCPPOptions opts l = forBuildInfo l updBuildInfo where updBuildInfo x = x{cppOptions = updOpts (cppOptions x)} updOpts s = nub (s ++ opts) formatMacro name value = "-D" ++ name ++ "=" ++ show value targetDataDir :: LocalBuildInfo -> FilePath targetDataDir l = let dirTmpls = installDirTemplates l prefix' = prefix dirTmpls data' = datadir dirTmpls dataEx = I.fromPathTemplate $ I.substPathTemplate [(PrefixVar, prefix')] data' in dataEx ++ "/locale" getPackageName :: LocalBuildInfo -> String getPackageName = unPackageName . packageName . localPkgDescr getCustomFields :: LocalBuildInfo -> [(String, String)] getCustomFields = customFieldsPD . localPkgDescr findInParametersDefault :: [(String, String)] -> String -> String -> String findInParametersDefault al name def = (fromMaybe def . lookup name) al getDomainNameDefault :: [(String, String)] -> String -> String getDomainNameDefault al = findInParametersDefault al "x-gettext-domain-name" getDomainDefine :: [(String, String)] -> String getDomainDefine al = findInParametersDefault al "x-gettext-domain-def" "__MESSAGE_CATALOG_DOMAIN__" getMsgCatalogDefine :: [(String, String)] -> String getMsgCatalogDefine al = findInParametersDefault al "x-gettext-msg-cat-def" "__MESSAGE_CATALOG_DIR__" getPoFilesDefault :: [(String, String)] -> IO [String] getPoFilesDefault al = toFileList $ findInParametersDefault al "x-gettext-po-files" "" where toFileList "" = return [] toFileList x = fmap concat $ mapM matchFileGlob $ split' x -- from Blow your mind (HaskellWiki) -- splits string by newline, space and comma split' x = concatMap lines $ concatMap words $ unfoldr (\b -> fmap (const . second (drop 1) . break (==',') $ b) . listToMaybe $ b) x bustle-0.8.0/po/en.po0000644000000000000000000000711213442235205012564 0ustar0000000000000000# Translation file msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "Report-Msgid-Bugs-To: \n" "POT-Creation-Date: 2009-01-13 06:05-0800\n" "PO-Revision-Date: 2014-01-12 14:19+0000\n" "Last-Translator: Will Thompson \n" "Language-Team: English\n" "Language: en\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" #: Bustle/StatisticsPane.hs:210 Bustle/StatisticsPane.hs:213 msgid "%.1f ms" msgstr "%.1f ms" #: Bustle/UI.hs:467 msgid "%s - Bustle" msgstr "%s – Bustle" #: Bustle/Noninteractive.hs:55 msgid "(no interface)" msgstr "(no interface)" #: Bustle/UI/DetailsView.hs:148 msgid "" msgstr "" #: Bustle/UI/DetailsView.hs:87 msgid "Arguments:" msgstr "Arguments:" #: Bustle/StatisticsPane.hs:228 msgid "B" msgstr "B" #: Bustle/UI/AboutDialog.hs:47 msgid "Bustle" msgstr "Bustle" #: Bustle/StatisticsPane.hs:211 msgid "Calls" msgstr "Calls" #: Bustle/UI.hs:294 msgid "Close _Without Saving" msgstr "Close _Without Saving" #: Bustle/UI.hs:210 msgid "Could not read '%s'" msgstr "Could not read ‘%s’" #: Bustle/Noninteractive.hs:48 msgid "Couldn't parse '%s': %s" msgstr "Couldn’t parse ‘%s’: %s" #: Bustle/UI/DetailsView.hs:110 msgid "Directed signal" msgstr "Directed signal" #: Bustle/UI/DetailsView.hs:106 msgid "Error" msgstr "Error" #: Bustle/StatisticsPane.hs:171 msgid "Frequency" msgstr "Frequency" #: Bustle/UI.hs:293 msgid "If you don't save, this log will be lost forever." msgstr "If you don’t save, this log will be lost forever." #: Bustle/StatisticsPane.hs:229 msgid "KB" msgstr "KB" #: Bustle/StatisticsPane.hs:264 msgid "Largest" msgstr "Largest" #: Bustle/StatisticsPane.hs:230 msgid "MB" msgstr "MB" #: Bustle/StatisticsPane.hs:212 Bustle/StatisticsPane.hs:263 msgid "Mean" msgstr "Mean" #: Bustle/StatisticsPane.hs:249 msgid "Member" msgstr "Member" #: Bustle/UI/DetailsView.hs:85 msgid "Member:" msgstr "Member:" #: Bustle/StatisticsPane.hs:200 msgid "Method" msgstr "Method" #: Bustle/UI/DetailsView.hs:104 msgid "Method call" msgstr "Method call" #: Bustle/UI/DetailsView.hs:105 msgid "Method return" msgstr "Method return" #: Bustle/StatisticsPane.hs:156 msgid "Name" msgstr "Name" #: Bustle/UI/DetailsView.hs:127 msgid "" "No message body information is available. Please capture a fresh log using a " "recent version of Bustle!" msgstr "" "No message body information is available. Please capture a fresh log using a " "recent version of Bustle!" #: Bustle/Loader.hs:64 msgid "Parse error %s" msgstr "Parse error %s" #: Bustle/UI/DetailsView.hs:84 msgid "Path:" msgstr "Path:" #: Bustle/UI.hs:286 msgid "Save log '%s' before closing?" msgstr "Save log ‘%s’ before closing?" #: Bustle/UI/DetailsView.hs:109 msgid "Signal" msgstr "Signal" #: Bustle/StatisticsPane.hs:262 msgid "Smallest" msgstr "Smallest" #: Bustle/UI/AboutDialog.hs:49 msgid "Someone's favourite D-Bus profiler" msgstr "Someone's favourite D-Bus profiler" #: Bustle/StatisticsPane.hs:209 msgid "Total" msgstr "Total" #: Bustle/UI/FilterDialog.hs:105 msgid "" "Unticking a service hides its column in the diagram, and all messages it is " "involved in. That is, all methods it calls or are called on it, the " "corresponding returns, and all signals it emits will be hidden." msgstr "" "Unticking a service hides its column in the diagram, and all messages it is " "involved in. That is, all methods it calls or are called on it, the " "corresponding returns, and all signals it emits will be hidden." #: Bustle/Util.hs:53 msgid "Warning: " msgstr "Warning: " bustle-0.8.0/data/org.freedesktop.Bustle.appdata.xml.in0000644000000000000000000001111013711020373021201 0ustar0000000000000000 org.freedesktop.Bustle org.freedesktop.Bustle.desktop CC-BY-SA-3.0 Bustle Draw sequence diagrams of D-Bus activity

Bustle draws sequence diagrams of D-Bus activity. It shows signal emissions, method calls and their corresponding returns, with time stamps 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 is not performing as well as you like. It also provides statistics like signal frequencies and average method call times.

 LGPL-2.1+ https://gitlab.freedesktop.org/bustle/bustle/raw/master/data/appdata/bustle-diagram.png Explore sequence diagrams of D-Bus activity https://gitlab.freedesktop.org/bustle/bustle/raw/master/data/appdata/bustle-statistics.png See statistics summarizing the log https://gitlab.freedesktop.org/bustle/bustle/raw/master/data/appdata/bustle-welcome.png Relax with this soothing greyscale welcome page https://gitlab.freedesktop.org/bustle/bustle#readme will_at_willthompson.co.uk bustle bustle.desktop

Bustle has a new icon, kindly provided by Tobias Bernard.

Closing a window without saving a recorded log no longer prompts for confirmation. Anecdotally, most users just want to record and read logs, not save them.

Bustle now uses GLib's implementation of the D-Bus wire protocol throughout. The only user-facing consequence is that message bodies are now pretty-printed in the GVariant text format.

Since Bustle no longer depends on any GPL libraries, the project license has been simplified to plain LGPL 2.1 or later.

As well as being able to filter out messages involving certain services, you can now also filter messages to only show certain services.

In the details for an error reply, the error name is now shown, and the error message is formatted more legibly.

The default file extension for log files is now ‘.pcap’, reflecting what they actually are.

Bustle now handles the application/vnd.tcpdump.pcap MIME type, which in practice means that your file manager will offer to open pcap files with Bustle.

You can now explore messages while they're being recorded. Filtering, statistics and exporting are still only available once you stop recording.

The raw sender and destination for each message is now shown in the details pane.

Bytestrings with embedded NULs which are otherwise ASCII are now shown as ASCII strings.

It's now possible to monitor the system bus (from the user interface and with the bustle-pcap command-line tool), with no need to reconfigure the system bus. It's also possible to monitor an arbitrary bus by address.

Bustle now requires that dbus-monitor (≥ 1.9.10) and pkexec are installed on your system.

 bustle-0.8.0/data/org.freedesktop.Bustle.desktop.in0000644000000000000000000000046513442235205020457 0ustar0000000000000000[Desktop Entry] Name=Bustle Comment=Draw sequence diagrams of D-Bus activity Exec=bustle %F Icon=org.freedesktop.Bustle Terminal=false Type=Application Categories=GTK;Development;Debugger;Profiling; StartupNotify=true Keywords=debug;profile;d-bus;dbus;sequence;monitor; MimeType=application/vnd.tcpdump.pcap; bustle-0.8.0/data/icons/hicolor/scalable/apps/org.freedesktop.Bustle.svg0000644000000000000000000002140413710546274024470 0ustar0000000000000000 bustle-0.8.0/data/icons/hicolor/scalable/apps/org.freedesktop.Bustle.Devel.svg0000644000000000000000000004644413710546274025541 0ustar0000000000000000 bustle-0.8.0/data/icons/hicolor/scalable/apps/org.freedesktop.Bustle-symbolic.svg0000644000000000000000000000452613710546274026315 0ustar0000000000000000