diff --git a/Bustle.hs b/Bustle.hs new file mode 100644 --- /dev/null +++ b/Bustle.hs @@ -0,0 +1,61 @@ +{- +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 Bustle.Noninteractive +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 + 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 diff --git a/Bustle/Application/Monad.hs b/Bustle/Application/Monad.hs new file mode 100644 --- /dev/null +++ b/Bustle/Application/Monad.hs @@ -0,0 +1,105 @@ +{- +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, Monad, MonadIO) + +newtype BustleEnv config state = + BustleEnv { unBustleEnv :: IORef (config, state) } + +readConfig :: MonadIO m + => BustleEnv config state + -> m config +readConfig = liftM fst . liftIO . readIORef . unBustleEnv + +readState :: MonadIO m + => BustleEnv config state + -> m state +readState = liftM snd . liftIO . readIORef . unBustleEnv + +putState :: MonadIO m + => state + -> BustleEnv config state + -> m () +putState new e = liftIO $ do + modifyIORef (unBustleEnv e) $ \(conf, _) -> (conf, 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 + -- FIXME: I don't actually think it's possible to implement local without + -- keeping two refs or something. I guess I could make a temporary ioref, + -- and propagate any changes to the actual state part of the ref to the + -- outside world. This would break horribly in the face of threads. Or we + -- could do something like: + -- MVar (BConfig, MVar BState) + local = error "Sorry, Dave, I can't let you do that." + +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) x = runReaderT act x + +runB :: config -> state -> Bustle config state a -> IO a +runB config s (B act) = do + r <- newIORef (config, s) + runReaderT act $ BustleEnv r diff --git a/Bustle/Diagram.hs b/Bustle/Diagram.hs new file mode 100644 --- /dev/null +++ b/Bustle/Diagram.hs @@ -0,0 +1,520 @@ +{- +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 Control.Arrow ((&&&)) +import Control.Applicative ((<$>), (<*>)) + +import Control.Monad.Reader + +import Graphics.Rendering.Cairo +import Graphics.UI.Gtk.Cairo (cairoCreateContext, showLayout) +import Graphics.Rendering.Pango.Layout +import Graphics.Rendering.Pango.Font + +import qualified Bustle.Markup as Markup +import Bustle.Markup (Markup) +import Bustle.Util +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 y = MemberLabel p i m isReturn memberx y + +timestampLabel :: String -> Double -> Shape +timestampLabel s y = TimestampLabel s timestampx y + +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 = mapNonEmpty 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 = nonEmptyToList (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), minimum (0:y1s)) + ,(maximum (0:x2s), maximum (0:y2s)) + ) + where + (x1s, y1s, x2s, y2s) = unzip4 $ map bounds shapes + +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 + + maybeM mleft $ \left -> do + moveTo left y + arrowHead False + lineTo (e - 5) y + stroke + + maybeM 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 (Markup.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) + => Markup -> EllipsizeMode -> LayoutAlignment + -> m PangoLayout +mkLayout s e a = liftIO $ do + ctx <- cairoCreateContext Nothing + layout <- layoutEmpty ctx + layoutSetMarkup layout (Markup.unMarkup s) + 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 (Markup.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 Markup.b) $ Markup.escape p + fullMethod = + (if isReturn then Markup.i else id) $ Markup.formatMember i m + +drawTimestamp :: String -> Double -> Double -> Render () +drawTimestamp ts x y = do + moveTo (x - timestampWidth / 2) (y - 10) + showLayout =<< mkLayout (Markup.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_ (nonEmptyToList 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 diff --git a/Bustle/Loader.hs b/Bustle/Loader.hs new file mode 100644 --- /dev/null +++ b/Bustle/Loader.hs @@ -0,0 +1,88 @@ +{- +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.Exception +import Control.Monad.Error +import Control.Arrow ((***)) + +import qualified Bustle.Loader.OldSkool as Old +import qualified Bustle.Loader.Pcap as Pcap +import Bustle.Upgrade (upgrade) +import Bustle.Types +import Bustle.Util (io) + +data LoadError = LoadError FilePath String +instance Error LoadError where + strMsg = LoadError "" + +-- 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 + -> ErrorT LoadError io ([String], Log) +readLog f = do + pcapResult <- io $ Pcap.readPcap f + liftM (id *** filter (isRelevant . deEvent)) $ case pcapResult of + Right ms -> return ms + Left _ -> liftM ((,) []) readOldLogFile + where + readOldLogFile = do + result <- liftIO $ try $ readFile f + case result of + Left e -> throwError $ LoadError f (show (e :: IOException)) + Right input -> do + let oldResult = fmap upgrade $ Old.readLog input + case oldResult of + Left e -> throwError $ LoadError f ("Parse error " ++ show e) + Right r -> return r + +isRelevant :: Event + -> Bool +isRelevant (NOCEvent _) = True +isRelevant (MessageEvent m) = case m of + Signal {} -> none [ senderIsBus + , isDisconnected + ] + 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) + + -- When the monitor is forcibly disconnected from the bus, the + -- Disconnected message has no sender; the old logger spat out . + isDisconnected = sender m == O (OtherName Old.senderWhenDisconnected) + + none bs = not $ or bs + none3 = none [senderIsBus, destIsBus, isDisconnected] + + diff --git a/Bustle/Loader/OldSkool.hs b/Bustle/Loader/OldSkool.hs new file mode 100644 --- /dev/null +++ b/Bustle/Loader/OldSkool.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE OverloadedStrings #-} +{- +Bustle.Loader.OldSkool: reads the output of bustle-dbus-monitor +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 +-} +module Bustle.Loader.OldSkool + ( readLog + , senderWhenDisconnected + ) +where + +import Bustle.Types +import qualified DBus as D +import Text.ParserCombinators.Parsec hiding (Parser) +import Data.Map (Map) +import Data.Maybe (isJust) +import qualified Data.Map as Map +import Control.Monad (ap, when, guard) +import Control.Applicative ((<$>)) + +infixl 4 <* +(<*) :: Monad m => m a -> m b -> m a +m <* n = do ret <- m; n; return ret + +infixl 4 <*> +(<*>) :: Monad m => m (a -> b) -> m a -> m b +(<*>) = ap + +type Parser a = GenParser Char (Map (TaggedBusName, Serial) (Detailed Message)) a + +t :: Parser Char +t = char '\t' + +nameChars :: Parser String +nameChars = many1 (noneOf "\t\n") +-- this should be +-- nameChars = many1 (oneOf "._-" <|> alphaNum) +-- but making it more tolerant lets us shoehorn misc into this field until the +-- log format is less shit. + +parseUniqueName :: Parser UniqueName +parseUniqueName = do + char ':' + rest <- nameChars + case D.parseBusName (':':rest) of + Just n -> return $ UniqueName n + Nothing -> fail $ "':" ++ rest ++ "' is not a valid unique name" + "unique name" + +-- FIXME: this shouldn't exist. +senderWhenDisconnected :: D.BusName +senderWhenDisconnected = D.busName_ "org.freedesktop.DBus.Local" + +parseMissingName :: Parser OtherName +parseMissingName = do + none + return $ OtherName senderWhenDisconnected + +parseSpecifiedOtherName :: Parser OtherName +parseSpecifiedOtherName = do + x <- nameChars + case D.parseBusName x of + Just n -> return $ OtherName n + Nothing -> fail $ "'" ++ x ++ "' is not a valid name" + +parseOtherName :: Parser OtherName +parseOtherName = parseMissingName <|> parseSpecifiedOtherName + + "non-unique name" + +parseBusName :: Parser TaggedBusName +parseBusName = (fmap U parseUniqueName) <|> (fmap O parseOtherName) + +parseSerial :: Parser Serial +parseSerial = read <$> many1 digit "serial" + +parseTimestamp :: Parser Microseconds +parseTimestamp = do + seconds <- i + t + µs <- i + return $ µsFromPair seconds µs + where i = read <$> many1 digit "timestamp" + +none :: Parser (Maybe a) +none = do + string "" + return Nothing + +pathify :: String -> D.ObjectPath +pathify s = case D.parseObjectPath s of + Just p -> p + Nothing -> D.objectPath_ "/unparseable/object/path" + +interfacify :: String -> Maybe D.InterfaceName +interfacify = D.parseInterfaceName + +memberNamify :: String -> D.MemberName +memberNamify s = case D.parseMemberName s of + Just m -> m + Nothing -> D.memberName_ "UnparseableMemberName" + +entireMember :: Parser Member +entireMember = do + let p = pathify <$> many1 (oneOf "/_" <|> alphaNum) "path" + i = none <|> fmap interfacify (many1 (oneOf "._" <|> alphaNum)) "iface" + m = memberNamify <$> many1 (oneOf "_" <|> alphaNum) "membername" + Member <$> p <* t <*> i <* t <*> m + "member" + +addPendingCall :: Detailed Message -> Parser () +addPendingCall dm = updateState $ Map.insert (sender m, serial m) dm + where + m = deEvent dm + +findPendingCall :: TaggedBusName -> Serial -> Parser (Maybe (Detailed Message)) +findPendingCall dest s = do + pending <- getState + let key = (dest, s) + ret = Map.lookup key pending + when (isJust ret) $ updateState (Map.delete key) + return ret + +methodCall :: Parser DetailedEvent +methodCall = do + char 'c' + t + µs <- parseTimestamp + t + m <- MethodCall <$> parseSerial <* t + <*> parseBusName <* t <*> parseBusName <* t <*> entireMember + let dm = Detailed µs m Nothing + addPendingCall dm + return $ fmap MessageEvent dm + "method call" + +parseReturnOrError :: String + -> (Maybe (Detailed Message) -> TaggedBusName -> TaggedBusName -> Message) + -> Parser DetailedEvent +parseReturnOrError prefix constructor = do + string prefix <* t + ts <- parseTimestamp <* t + parseSerial <* t + replySerial <- parseSerial <* t + s <- parseBusName <* t + d <- parseBusName + call <- findPendingCall d replySerial + -- If we can see a call, use its sender and destination as the destination + -- and sender for the reply. This might prove unnecessary in the event of + -- moving the name collapsing into the UI. + let (s', d') = case call of + Just (Detailed _ m _) -> (destination m, sender m) + Nothing -> (s, d) + message = constructor call s' d' + return $ Detailed ts (MessageEvent message) Nothing + "method return or error" + +methodReturn, parseError :: Parser DetailedEvent +methodReturn = parseReturnOrError "r" MethodReturn "method return" +parseError = parseReturnOrError "err" Error "error" + +signal :: Parser DetailedEvent +signal = do + string "sig" + t + µs <- parseTimestamp + t + -- Ignore serial + m <- Signal <$> (parseSerial >> t >> parseBusName) <* t + <*> return Nothing + <*> entireMember + return $ Detailed µs (MessageEvent m) Nothing + "signal" + +method :: Parser DetailedEvent +method = char 'm' >> (methodCall <|> methodReturn) + "method call or return" + +noName :: Parser () +noName = char '!' >> return () + "the empty name '!'" + +perhaps :: Parser a -> Parser (Maybe a) +perhaps act = (noName >> return Nothing) <|> fmap Just act + +sameUnique :: UniqueName -> UniqueName -> Parser () +sameUnique u u' = guard (u == u') + "owner to be " ++ unUniqueName u ++ ", not " ++ unUniqueName u' + +atLeastOne :: OtherName -> Parser a +atLeastOne n = fail "" + unOtherName n ++ " to gain or lose an owner" + +nameOwnerChanged :: Parser DetailedEvent +nameOwnerChanged = do + string "nameownerchanged" + t + ts <- parseTimestamp + t + n <- parseBusName + t + m <- parseNOCDetails n + return $ Detailed ts (NOCEvent m) Nothing + +parseNOCDetails :: TaggedBusName + -> Parser NOC +parseNOCDetails n = + case n of + U u -> do + old <- perhaps parseUniqueName + case old of + Nothing -> do + t + u' <- parseUniqueName + sameUnique u u' + return $ Connected u + Just u' -> do + sameUnique u u' + t + noName + return $ Disconnected u + O o -> do + old <- perhaps parseUniqueName + t + new <- perhaps parseUniqueName + c <- case (old, new) of + (Nothing, Nothing) -> atLeastOne o + (Just a, Nothing) -> return $ Released a + (Nothing, Just b) -> return $ Claimed b + (Just a, Just b) -> return $ Stolen a b + return $ NameChanged o c + +event :: Parser DetailedEvent +event = method <|> signal <|> nameOwnerChanged <|> parseError + +events :: Parser [DetailedEvent] +events = sepEndBy event (char '\n') <* eof + +readLog :: String -> Either ParseError [DetailedEvent] +readLog filename = runParser events Map.empty "" filename + +-- vim: sw=2 sts=2 diff --git a/Bustle/Loader/Pcap.hs b/Bustle/Loader/Pcap.hs new file mode 100644 --- /dev/null +++ b/Bustle/Loader/Pcap.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE OverloadedStrings #-} +{- +Bustle.Loader.Pcap: loads logs out of pcap files using dbus-core +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 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 Network.Pcap + +import DBus + +import qualified Data.ByteString as BS + +import qualified Bustle.Types as B + +-- 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 :: (a -> ObjectPath) + -> (a -> Maybe InterfaceName) + -> (a -> MemberName) + -> a + -> B.Member +convertMember getObjectPath getInterfaceName getMemberName m = + B.Member (getObjectPath m) + (getInterfaceName m) + (getMemberName m) + +type PendingMessages = Map (Maybe BusName, Serial) + (MethodCall, B.Detailed B.Message) + +popMatchingCall :: (MonadState PendingMessages m) + => Maybe BusName + -> Serial + -> m (Maybe (MethodCall, 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 + -> MethodCall + -> B.Detailed B.Message + -> m () +insertPending n s rawCall b = modify $ Map.insert (n, s) (rawCall, b) + +isNOC :: Maybe BusName -> Signal -> Maybe (BusName, Maybe BusName, Maybe BusName) +isNOC (Just sender) s | looksLikeNOC = + case names of + [Just n, old, new] -> Just (n, old, new) + _ -> Nothing + where + names :: [Maybe BusName] + names = map fromVariant $ signalBody s + + looksLikeNOC = + and [ sender == B.dbusName + , signalInterface s == B.dbusInterface + , formatMemberName (signalMember s) == "NameOwnerChanged" + ] +isNOC _ _ = Nothing + + +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 :: Maybe (MethodCall, a) + -> MethodReturn + -> Maybe B.NOC +tryBustlifyGetNameOwnerReply maybeCall mr = do + -- FIXME: obviously this should be more robust: + -- • check that the service really is the bus daemon + -- • don't crash if the body of the call or reply doesn't contain one bus name. + (rawCall, _) <- maybeCall + guard (formatMemberName (methodCallMember rawCall) == "GetNameOwner") + ownedName <- fromVariant $ (methodCallBody rawCall !! 0) + return $ bustlifyNOC ( ownedName + , Nothing + , fromVariant $ (methodReturnBody mr !! 0) + ) + +bustlify :: Monad m + => B.Microseconds + -> Int + -> ReceivedMessage + -> StateT PendingMessages m B.DetailedEvent +bustlify µs bytes m = do + bm <- buildBustledMessage + return $ B.Detailed µs bm (Just (bytes, m)) + where + sender = receivedMessageSender m + -- FIXME: can we do away with the un-Maybe-ing and just push that Nothing + -- means 'the monitor' downwards? Or skip the message if sender is Nothing. + wrappedSender = convertBusName "sen.der" sender + + buildBustledMessage = case m of + (ReceivedMethodCall serial mc) -> do + let call = B.MethodCall + { B.serial = serialValue serial + , B.sender = wrappedSender + , B.destination = convertBusName "method.call.destination" $ methodCallDestination mc + , B.member = convertMember methodCallPath methodCallInterface methodCallMember mc + } + -- FIXME: we shouldn't need to construct almost the same thing here + -- and 10 lines above maybe? + insertPending sender serial mc (B.Detailed µs call (Just (bytes, m))) + return $ B.MessageEvent call + + (ReceivedMethodReturn _serial mr) -> do + call <- popMatchingCall (methodReturnDestination mr) (methodReturnSerial mr) + + return $ case tryBustlifyGetNameOwnerReply call mr of + Just noc -> B.NOCEvent noc + Nothing -> B.MessageEvent $ B.MethodReturn + { B.inReplyTo = fmap snd call + , B.sender = wrappedSender + , B.destination = convertBusName "method.return.destination" $ methodReturnDestination mr + } + + (ReceivedMethodError _serial e) -> do + call <- popMatchingCall (methodErrorDestination e) (methodErrorSerial e) + return $ B.MessageEvent $ B.Error + { B.inReplyTo = fmap snd call + , B.sender = wrappedSender + , B.destination = convertBusName "method.error.destination" $ methodErrorDestination e + } + + (ReceivedSignal _serial sig) + | Just names <- isNOC sender sig -> return $ B.NOCEvent $ bustlifyNOC names + | otherwise -> return $ B.MessageEvent $ + B.Signal { B.sender = wrappedSender + , B.member = convertMember signalPath (Just . signalInterface) signalMember sig + , B.signalDestination = fmap stupifyBusName + $ signalDestination sig + } + + _ -> error "woah there! someone added a new message type." + +convert :: Monad m + => B.Microseconds + -> BS.ByteString + -> StateT PendingMessages m (Either String B.DetailedEvent) +convert µs body = + case unmarshal body of + Left e -> return $ Left $ unmarshalErrorMessage e + Right m -> liftM Right $ bustlify µs (BS.length body) m + +data Result e a = + EOF + | Packet (Either e a) + deriving Show + +readOne :: (Monad m, MonadIO m) + => PcapHandle + -> (B.Microseconds -> BS.ByteString -> StateT s m (Either e a)) + -> StateT s m (Result e a) +readOne p f = do + (hdr, body) <- liftIO $ nextBS p + -- No really, nextBS just returns null packets when you hit the end of the + -- file. + -- + -- It occurs to me that we could stream by just polling this every second + -- or something? + if hdrCaptureLength hdr == 0 + then return EOF + else liftM Packet $ f (fromIntegral (hdrTime hdr)) body + +-- This shows up as the biggest thing on the heap profile. Which is kind of a +-- surprise. It's supposedly the list. +mapBodies :: (Monad m, MonadIO m) + => PcapHandle + -> (B.Microseconds -> BS.ByteString -> StateT s m (Either e a)) + -> StateT s m [Either e a] +mapBodies p f = do + ret <- readOne p f + case ret of + EOF -> return $ [] + Packet x -> do + xs <- mapBodies p f + return $ x:xs + +readPcap :: FilePath + -> IO (Either IOError ([String], [B.DetailedEvent])) +readPcap path = try $ do + p <- openOffline path + + liftM partitionEithers $ evalStateT (mapBodies p convert) Map.empty diff --git a/Bustle/Markup.hs b/Bustle/Markup.hs new file mode 100644 --- /dev/null +++ b/Bustle/Markup.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{- +Bustle.Diagram: My First Type-Safe Markup Library +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.Markup + ( Markup + , unMarkup + , tag + , b + , i + , light + , red + , a + , escape + + , formatMember + ) +where + +import Data.Monoid +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 Markup = Markup { unMarkup :: String } + deriving (Show, Read, Ord, Eq) + +instance Monoid Markup where + mempty = Markup "" + mappend x y = Markup (unMarkup x `mappend` unMarkup y) + mconcat = Markup . mconcat . map unMarkup + +--raw :: String -> Markup +--raw = Markup + +tag :: String -> Markup -> Markup +tag name contents = + Markup $ concat [ "<", name, ">" + , unMarkup contents + , "" + ] + +b, i :: Markup -> Markup +b = tag "b" +i = tag "i" + +a :: String + -> String + -> Markup +a href contents = + Markup $ concat [ "" + , escapeMarkup contents + , "" + ] + +span_ :: [SpanAttribute] -> Markup -> Markup +span_ attrs = Markup . markSpan attrs . unMarkup + +light :: Markup -> Markup +light = span_ [FontWeight WeightLight] + +red :: Markup -> Markup +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 -> Markup +escape = Markup . escapeMarkup . toString + +formatMember :: Maybe InterfaceName -> MemberName -> Markup +formatMember iface member = iface' `mappend` b (escape member) + where + iface' = case iface of + Just ifaceName -> escape ifaceName `mappend` Markup "." + Nothing -> light (escape "(no interface) ") diff --git a/Bustle/Monitor.hs b/Bustle/Monitor.hs new file mode 100644 --- /dev/null +++ b/Bustle/Monitor.hs @@ -0,0 +1,109 @@ +{- +Bustle.Monitor: Haskell binding for pcap-monitor.c +Copyright © 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 ForeignFunctionInterface #-} +module Bustle.Monitor + ( +-- * Types + Monitor + , BusType(..) + +-- * Methods + , monitorNew + , monitorStop + +-- * Signals + , monitorMessageLogged + ) +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.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 + +-- Dirty ugly foreign imports +foreign import ccall "bustle_pcap_monitor_new" + bustle_pcap_monitor_new :: CInt + -> 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 :: BusType + -> FilePath + -> IO Monitor +monitorNew busType filename = + wrapNewGObject mkMonitor $ + propagateGError $ \gerrorPtr -> + withCString filename $ \c_filename -> + bustle_pcap_monitor_new (fromIntegral $ fromEnum busType) + c_filename + gerrorPtr + +monitorStop :: Monitor + -> IO () +monitorStop monitor = do + withForeignPtr (unMonitor monitor) bustle_pcap_monitor_stop + +messageLoggedHandler :: (Microseconds -> BS.ByteString -> IO ()) + -> a + -> Ptr () + -> CInt + -> CLong + -> CLong + -> Ptr CChar + -> CUInt + -> IO () +messageLoggedHandler user _obj _messageObject _isIncoming sec usec blob blobLength = do + blobBS <- BS.packCStringLen (blob, fromIntegral blobLength) + let µsec = fromIntegral sec * (10 ^ (6 :: Int)) + fromIntegral usec + failOnGError $ user µsec blobBS + +monitorMessageLogged :: Signal Monitor (Microseconds -> BS.ByteString -> IO ()) +monitorMessageLogged = + Signal $ \after_ obj user -> + connectGeneric "message-logged" after_ obj $ messageLoggedHandler user diff --git a/Bustle/Noninteractive.hs b/Bustle/Noninteractive.hs new file mode 100644 --- /dev/null +++ b/Bustle/Noninteractive.hs @@ -0,0 +1,89 @@ +{- +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.Error +import Text.Printf + +import Bustle.Loader +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 <- runErrorT $ readLog filepath + case ret of + Left (LoadError _ err) -> do + warn $ concat [ "Couldn't parse " + , 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 diff --git a/Bustle/Regions.hs b/Bustle/Regions.hs new file mode 100644 --- /dev/null +++ b/Bustle/Regions.hs @@ -0,0 +1,214 @@ +{- +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 diff --git a/Bustle/Renderer.hs b/Bustle/Renderer.hs new file mode 100644 --- /dev/null +++ b/Bustle/Renderer.hs @@ -0,0 +1,746 @@ +{-# LANGUAGE DeriveFunctor, OverloadedStrings #-} +{- +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 +-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Bustle.Renderer + ( + -- * Processing entire logs + process + , processWithFilters + + -- * Processing logs incrementally + , RendererState + , rendererStateNew + , processSome + + -- * Output of processing + , RendererResult(..) + , Participants + , sessionParticipants + ) +where + +import Prelude hiding (log) + +import Bustle.Types +import Bustle.Diagram +import Bustle.Regions +import Bustle.Util (maybeM, NonEmpty(..)) + +import qualified Data.Set as Set +import Data.Set (Set) +import qualified Data.Map as Map +import Data.Map (Map) + +import Control.Applicative (Applicative(..), (<$>), (<*>)) +import Control.Arrow ((***)) +import Control.Monad.Error +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) + +describeBus :: Bus -> String +describeBus SessionBus = "session" +describeBus SystemBus = "system" + +-- 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 Monoid Participants where + mempty = Participants Map.empty Map.empty + mappend (Participants sess1 sys1) (Participants sess2 sys2) = + Participants (f sess1 sess2) + (f sys1 sys2) + where + f = Map.unionWith Set.union + +sessionParticipants :: Participants + -> [(UniqueName, Set OtherName)] -- ^ sorted by column +sessionParticipants = map (snd *** id) . 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 Monoid apps => Monoid (RendererResult apps) where + mempty = RendererResult 0 0 [] [] mempty [] + mappend 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 `mappend` rrApplications rr2 + warnings = rrWarnings rr1 `mappend` rrWarnings rr2 + +processWithFilters :: (Log, Set UniqueName) + -> (Log, Set UniqueName) + -> RendererResult () +processWithFilters (sessionBusLog, sessionFilter) + (systemBusLog, systemFilter ) = + fmap (const ()) $ 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 Set.empty Set.empty + +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 + , Monad + , MonadState RendererState + , MonadWriter RendererOutput + ) + +instance Applicative Renderer where + pure = return + (<*>) = ap + +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 Monoid RendererOutput where + mempty = RendererOutput [] [] [] + mappend (RendererOutput s1 r1 w1) + (RendererOutput s2 r2 w2) = RendererOutput (s1 ++ s2) + (r1 ++ r2) + (w1 ++ w2) + +data BusState = + BusState { apps :: Applications + , firstColumn :: Double + , nextColumn :: Double + , columnsInUse :: Set Double + , pending :: Pending + , bsIgnoredNames :: Set UniqueName + } + +data RendererState = + RendererState { sessionBusState :: BusState + , systemBusState :: BusState + , row :: Double + , mostRecentLabels :: Double + , startTime :: Microseconds + } + +initialBusState :: Set UniqueName + -> Double + -> BusState +initialBusState ignore first = + BusState { apps = Map.empty + , firstColumn = first + , nextColumn = first + , columnsInUse = Set.empty + , pending = Map.empty + , bsIgnoredNames = ignore + } + +initialSessionBusState, initialSystemBusState :: Set UniqueName -> BusState +initialSessionBusState f = + initialBusState f $ timestampAndMemberWidth + firstColumnOffset +initialSystemBusState f = + initialBusState f $ negate firstColumnOffset + +initialState :: Set UniqueName + -> Set UniqueName + -> 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 matches indicates a corrupt log, which we try to recover from … + [] -> do + warn $ concat [ "'" + , unOtherName o + , "' appeared unheralded on the " + , describeBus bus + , " bus; making something up..." + ] + let namesInUse = Map.keys as + candidates = map (fakeUniqueName . show) + ([1..] :: [Integer]) + u = head $ filter (not . (`elem` namesInUse)) candidates + addUnique bus u + addOther bus o u + ai <- lookupUniqueName bus u + return (u, ai) + + -- … but more than one match means we're screwed. + several -> error $ concat [ "internal error: " + , show o + , " in several apps: " + , show several + ] + +-- 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 + case existing of + Nothing -> return () + Just _ -> 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 }) + maybeM 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.fold ((:) . 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 = reverse . sortBy (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 + ignored <- getsBusState bsIgnoredNames bus + names <- mapM (fmap fst . lookupApp bus) (mentionedNames m) + return $ Set.null (ignored `Set.intersection` Set.fromList 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) + case call of + Nothing -> return () + Just (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 } -> addUnique bus u >> return () + 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 -> do + 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 diff --git a/Bustle/StatisticsPane.hs b/Bustle/StatisticsPane.hs new file mode 100644 --- /dev/null +++ b/Bustle/StatisticsPane.hs @@ -0,0 +1,265 @@ +{- +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.Applicative ((<$>)) +import Control.Monad (forM_) +import Text.Printf +import Graphics.UI.Gtk hiding (Markup) +import Bustle.Stats +import Bustle.Types (Log) +import qualified Bustle.Markup as Markup +import Bustle.Markup (Markup) +import Data.Monoid + +data StatsPane = + StatsPane { spCountStore :: ListStore FrequencyInfo + , spTimeStore :: ListStore TimeInfo + , spSizeStore :: ListStore SizeInfo + } + +statsPaneNew :: Builder + -> Maybe Pixbuf + -> Maybe Pixbuf + -> IO StatsPane +statsPaneNew builder methodIcon signalIcon = do + [frequencySW, durationSW, sizeSW] <- mapM (builderGetObject builder castToScrolledWindow) + ["frequencySW", "durationSW", "sizeSW"] + + (countStore, countView) <- newCountView methodIcon signalIcon + containerAdd frequencySW countView + + (timeStore, timeView) <- newTimeView + containerAdd durationSW timeView + + (sizeStore, sizeView) <- newSizeView methodIcon signalIcon + 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 -> Markup) + -> 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 . Markup.unMarkup $ f x ] + return renderer + +addMemberRenderer :: TreeViewColumn + -> ListStore a + -> Bool + -> (a -> Markup) + -> 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 -> Markup) + -> IO () +addStatColumn view store title f = do + col <- treeViewColumnNew + treeViewColumnSetTitle col title + renderer <- addTextRenderer col store True f + set renderer [ cellXAlign := 1 ] + treeViewAppendColumn view col + return () + +addTextStatColumn :: TreeView + -> ListStore a + -> String + -> (a -> String) + -> IO () +addTextStatColumn view store title f = + addStatColumn view store title (Markup.escape . f) + +-- If we managed to load the method and signal icons... +maybeAddTypeIconColumn :: CellLayoutClass layout + => layout + -> ListStore a + -> Maybe Pixbuf + -> Maybe Pixbuf + -> (a -> Bool) + -> IO () +maybeAddTypeIconColumn nameColumn store (Just m) (Just s) isMethod = do + typeRenderer <- cellRendererPixbufNew + cellLayoutPackStart nameColumn typeRenderer False + cellLayoutSetAttributes nameColumn typeRenderer store $ \row -> + [ cellPixbuf := if isMethod row then m else s ] +maybeAddTypeIconColumn _ _ _ _ _ = return () + +newCountView :: Maybe Pixbuf + -> Maybe Pixbuf + -> IO (ListStore FrequencyInfo, TreeView) +newCountView method signal = do + countStore <- listStoreNew [] + countView <- treeViewNewWithModel countStore + + set countView [ treeViewHeadersVisible := False ] + + nameColumn <- treeViewColumnNew + treeViewColumnSetTitle nameColumn "Name" + set nameColumn [ treeViewColumnResizable := True + , treeViewColumnExpand := True + ] + + maybeAddTypeIconColumn nameColumn countStore method signal $ \fi -> + case fiType fi of + TallyMethod -> True + TallySignal -> False + + addMemberRenderer nameColumn countStore True $ \fi -> + Markup.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 -> + Markup.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 -> Markup +formatSizeInfoMember si = + f (Markup.formatMember (siInterface si) (siName si)) + where + f = case siType si of + SizeReturn -> Markup.i + SizeError -> Markup.red + _ -> id + +formatSize :: Int -> Markup +formatSize s + | s < maxB = value 1 `mappend` units "B" + | s < maxKB = value 1024 `mappend` units "KB" + | otherwise = value (1024 * 1024) `mappend` units "MB" + where + maxB = 10000 + maxKB = 10000 * 1024 + + units = Markup.escape . (' ':) + + value factor = Markup.escape (show (s `div` factor)) + +newSizeView :: Maybe Pixbuf + -> Maybe Pixbuf + -> IO (ListStore SizeInfo, TreeView) +newSizeView methodIcon_ signalIcon_ = do + sizeStore <- listStoreNew [] + sizeView <- treeViewNewWithModel sizeStore + + set sizeView [ treeViewHeadersVisible := True ] + + nameColumn <- treeViewColumnNew + treeViewColumnSetTitle nameColumn "Member" + set nameColumn [ treeViewColumnResizable := True + , treeViewColumnExpand := True + ] + + maybeAddTypeIconColumn nameColumn sizeStore methodIcon_ signalIcon_ $ \si -> + case siType si of + SizeSignal -> False + -- We distinguish between call, return and error by and red. + _ -> True + addMemberRenderer nameColumn sizeStore True formatSizeInfoMember + treeViewAppendColumn sizeView nameColumn + + addStatColumn sizeView sizeStore "Smallest" (formatSize . siMinSize) + addStatColumn sizeView sizeStore "Mean" (formatSize . siMeanSize) + addStatColumn sizeView sizeStore "Largest" (formatSize . siMaxSize) + + return (sizeStore, sizeView) diff --git a/Bustle/Stats.hs b/Bustle/Stats.hs new file mode 100644 --- /dev/null +++ b/Bustle/Stats.hs @@ -0,0 +1,184 @@ +{- +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 (sort, sortBy) +import Data.Maybe (mapMaybe) +import Data.Ord (comparing) + +import qualified Data.Map as Map +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 = reverse + . sort + . 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 0 _ [] = error "mean of empty list" + 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 = reverse + . sortBy (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 = + reverse . sort . 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, deDetails dm) of + (Just key, Just (size, _)) -> Map.insertWith' (++) key [size] + _ -> 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) diff --git a/Bustle/Types.hs b/Bustle/Types.hs new file mode 100644 --- /dev/null +++ b/Bustle/Types.hs @@ -0,0 +1,201 @@ +{-# 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 + + , dbusName + , dbusInterface + + , fakeUniqueName + + , Microseconds(..) + , µsFromPair + , µsToMs + + , Member(..) + , Message(..) + , NOC(..) + , Event(..) + , Detailed(..) + , DetailedEvent + , Change(..) + , partitionDetaileds + , mentionedNames + , Log + ) +where + +import Data.Word (Word32) +import DBus ( ObjectPath, formatObjectPath + , InterfaceName, formatInterfaceName, interfaceName_ + , MemberName, formatMemberName + , BusName, formatBusName, busName_ + , ReceivedMessage + ) +import Data.Maybe (maybeToList) +import Data.Either (partitionEithers) + +type Serial = Word32 + +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 + +-- 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) + +µsFromPair :: Integer + -> Integer + -> Microseconds +µsFromPair s µs = Microseconds $ (s * 1000000) + µs + +µ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 + , deDetails :: Maybe (MessageSize, ReceivedMessage) + } + 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 details) = + case e of + NOCEvent n -> Left $ Detailed µs n details + MessageEvent m -> Right $ Detailed µs m details + +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 diff --git a/Bustle/UI.hs b/Bustle/UI.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI.hs @@ -0,0 +1,591 @@ +{- +Bustle.UI: displays 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 Bustle.UI + ( uiMain + ) +where + +import Control.Monad.Reader +import Control.Monad.State +import Control.Monad.Error + +import Data.IORef +import qualified Data.Set as Set +import Data.List (intercalate) +import Data.Time +import Data.Monoid (mempty) + +import Paths_bustle +import Bustle.Application.Monad +import Bustle.Renderer +import Bustle.Types +import Bustle.Diagram +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.Util (displayError) +import Bustle.StatisticsPane +import Bustle.Loader + +import qualified Control.Exception as C +import System.Glib.GError (GError(..), failOnGError) + +import Graphics.UI.Gtk + +import Graphics.Rendering.Cairo (withPDFSurface, renderWith) + +import System.FilePath ( splitFileName, takeFileName, takeDirectory + , dropExtension, dropTrailingPathSeparator + , (), (<.>) + ) +import System.Directory (renameFile) + +type B a = Bustle BConfig BState a + +data LogDetails = + RecordedLog FilePath + | SingleLog FilePath + | TwoLogs FilePath FilePath + +data Page = + InstructionsPage + | PleaseHoldPage + | CanvasPage + deriving + (Enum) + +data WindowInfo = + WindowInfo { wiWindow :: Window + , wiSave :: ImageMenuItem + , wiExport :: MenuItem + , wiViewStatistics :: CheckMenuItem + , wiFilterNames :: MenuItem + , wiNotebook :: Notebook + , wiStatsBook :: Notebook + , wiStatsPane :: StatsPane + , wiContentVPaned :: VPaned + , wiCanvas :: Canvas (Detailed Message) + , wiDetailsView :: DetailsView + + , wiLogDetails :: IORef (Maybe LogDetails) + } + +data BConfig = + BConfig { debugEnabled :: Bool + , bustleIcon :: Maybe Pixbuf + , methodIcon :: Maybe Pixbuf + , signalIcon :: Maybe Pixbuf + } + +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 + + [bustle, method, signal] <- mapM loadPixbuf + ["bustle.png", "dfeet-method.png", "dfeet-signal.png"] + + let config = BConfig { debugEnabled = debug + , bustleIcon = bustle + , methodIcon = method + , signalIcon = signal + } + 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 + misc <- emptyWindow + modify $ \s -> s { initialWindow = Just misc } + +consumeInitialWindow :: B WindowInfo +consumeInitialWindow = do + x <- gets initialWindow + case x of + Nothing -> emptyWindow + Just windowInfo -> do + modify $ \s -> s { initialWindow = Nothing } + return windowInfo + +loadInInitialWindow :: LogDetails -> B () +loadInInitialWindow = loadLogWith consumeInitialWindow + +loadLog :: LogDetails -> B () +loadLog = loadLogWith emptyWindow + +openLog :: MonadIO io + => LogDetails + -> ErrorT 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 + ret <- runErrorT $ 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 + + windowInfo <- lift getWindow + lift $ displayLog windowInfo + logDetails + sessionMessages + systemMessages + rr + + case ret of + Left (LoadError f e) -> io $ + displayError Nothing ("Could not read '" ++ f ++ "'") (Just e) + Right () -> return () + +startRecording :: B () +startRecording = 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 <.> "bustle" + + setPage wi PleaseHoldPage + let mwindow = Just (wiWindow wi) + progress = aChallengerAppears wi + finished = finishedRecording wi filename + embedIO $ \r -> recorderRun filename mwindow progress + (\p -> makeCallback (finished p) r) + +aChallengerAppears :: WindowInfo + -> RendererResult a + -> IO () +aChallengerAppears wi rr = do + updateDisplayedLog wi rr + canvasScrollToBottom (wiCanvas wi) + setPage wi CanvasPage + +finishedRecording :: WindowInfo + -> FilePath + -> Bool + -> B () +finishedRecording wi tempFilePath producedOutput = do + if producedOutput + then 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 + onActivateLeaf saveItem $ showSaveDialog wi (return ()) + return () + else do + setPage wi InstructionsPage + modify $ \s -> s { initialWindow = Just wi } + updateDisplayedLog wi (mempty :: RendererResult ()) + +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 + renameFile tempFilePath newFilePath + widgetSetSensitivity (wiSave wi) False + wiSetLogDetails wi (SingleLog newFilePath) + savedCb + +-- | Show a confirmation dialog if the log is unsaved. Suitable for use as a +-- 'delete-event' handler. +promptToSave :: MonadIO io + => WindowInfo + -> io Bool -- ^ True if we showed a prompt; False if we're + -- happy to quit +promptToSave wi = io $ do + mdetails <- readIORef (wiLogDetails wi) + case mdetails of + Just (RecordedLog tempFilePath) -> do + let tempFileName = takeFileName tempFilePath + title = "Save log “" ++ tempFileName ++ "” before closing?" + prompt <- messageDialogNew (Just (wiWindow wi)) + [DialogModal] + MessageWarning + ButtonsNone + title + messageDialogSetSecondaryText prompt + "If you don’t save, this log will be lost forever." + dialogAddButton prompt "Close _without saving" ResponseClose + dialogAddButton prompt stockCancel ResponseCancel + dialogAddButton prompt stockSave ResponseYes + + widgetShowAll prompt + prompt `afterResponse` \resp -> do + let closeUp = widgetDestroy (wiWindow wi) + case resp of + ResponseYes -> showSaveDialog wi closeUp + ResponseClose -> closeUp + _ -> return () + widgetDestroy prompt + + return True + _ -> return False + +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" + [newItem, openItem, saveItem, closeItem, aboutItem] <- + mapM (getW castToImageMenuItem) + ["new", "open", "save", "close", "about"] + [newButton, openButton] <- mapM (getW castToButton) ["newButton", "openButton"] + exportItem <- getW castToMenuItem "export" + openTwoItem <- getW castToMenuItem "openTwo" + viewStatistics <- getW castToCheckMenuItem "statistics" + filterNames <- getW castToMenuItem "filter" + + + [nb, statsBook] <- mapM (getW castToNotebook) + ["diagramOrNot", "statsBook"] + contentVPaned <- getW castToVPaned "contentVPaned" + + -- Open two logs dialog + openTwoDialog <- embedIO $ \r -> + setupOpenTwoDialog builder window $ \f1 f2 -> + makeCallback (loadInInitialWindow (TwoLogs f1 f2)) r + withProgramIcon (windowSetIcon openTwoDialog) + + -- Set up the window itself + withProgramIcon (windowSetIcon window) + embedIO $ onDestroy window . makeCallback maybeQuit + + -- File menu and related buttons + embedIO $ \r -> do + let new = makeCallback startRecording r + onActivateLeaf newItem new + onClicked newButton new + + let open = makeCallback (openDialogue window) r + onActivateLeaf openItem open + onClicked openButton open + + onActivateLeaf openTwoItem $ widgetShowAll openTwoDialog + + -- Help menu + withProgramIcon $ \icon -> io $ + onActivateLeaf aboutItem $ showAboutDialog window icon + + m <- asks methodIcon + s <- asks signalIcon + statsPane <- io $ statsPaneNew builder m s + + details <- io $ detailsViewNew + io $ do + let top = detailsViewGetTop details + panedPack2 contentVPaned top False False + -- Hide the details by default; they'll be shown when the user selects a + -- message. + widgetHide top + + -- The stats start off hidden. + io $ widgetHide statsBook + + showBounds <- asks debugEnabled + canvas <- io $ canvasNew builder showBounds (updateDetailsView details) + + logDetailsRef <- io $ newIORef Nothing + let windowInfo = WindowInfo { wiWindow = window + , wiSave = saveItem + , wiExport = exportItem + , wiViewStatistics = viewStatistics + , wiFilterNames = filterNames + , wiNotebook = nb + , wiStatsBook = statsBook + , wiStatsPane = statsPane + , wiContentVPaned = contentVPaned + , wiCanvas = canvas + , wiDetailsView = details + , wiLogDetails = logDetailsRef + } + + io $ window `on` deleteEvent $ promptToSave windowInfo + io $ closeItem `on` menuItemActivate $ do + prompted <- promptToSave windowInfo + when (not prompted) (widgetDestroy window) + incWindows + io $ widgetShow window + return windowInfo + +updateDetailsView :: DetailsView + -> Maybe (Detailed Message) + -> IO () +updateDetailsView detailsView newMessage = do + case newMessage of + Nothing -> do + 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 + +prettyDirectory :: String + -> String +prettyDirectory s = "(" ++ dropTrailingPathSeparator s ++ ")" + +logWindowTitle :: LogDetails + -> String +logWindowTitle (RecordedLog filepath) = "(*) " ++ takeFileName filepath +logWindowTitle (SingleLog filepath) = + intercalate " " [name, prettyDirectory directory] + where + (directory, name) = splitFileName filepath +logWindowTitle (TwoLogs sessionPath systemPath) = + intercalate " " $ filter (not . null) + [ sessionName, sessionDirectory' + , "&" + , systemName, prettyDirectory systemDirectory + ] + where + (sessionDirectory, sessionName) = splitFileName sessionPath + (systemDirectory, systemName ) = splitFileName systemPath + sessionDirectory' = + if sessionDirectory == systemDirectory + then "" + else prettyDirectory sessionDirectory + +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) + windowSetTitle (wiWindow wi) (logWindowTitle logDetails ++ " — Bustle") + +setPage :: MonadIO io + => WindowInfo + -> Page + -> io () +setPage wi page = io $ notebookSetCurrentPage (wiNotebook wi) (fromEnum page) + +displayLog :: WindowInfo + -> LogDetails + -> Log + -> Log + -> RendererResult Participants + -> B () +displayLog wi@(WindowInfo { wiWindow = window + , wiExport = exportItem + , wiViewStatistics = viewStatistics + , wiFilterNames = filterNames + , wiCanvas = canvas + , wiStatsBook = statsBook + , wiStatsPane = statsPane + }) + logDetails + sessionMessages + systemMessages + rr = do + io $ do + wiSetLogDetails wi logDetails + + hiddenRef <- newIORef Set.empty + + updateDisplayedLog wi rr + + widgetSetSensitivity exportItem True + onActivateLeaf exportItem $ 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 widgetShow statsBook + else widgetHide statsBook + + widgetSetSensitivity filterNames True + onActivateLeaf filterNames $ do + hidden <- readIORef hiddenRef + hidden' <- runFilterDialog window (sessionParticipants $ rrApplications rr) hidden + writeIORef hiddenRef hidden' + let rr' = processWithFilters (sessionMessages, hidden') (systemMessages, Set.empty) + + updateDisplayedLog wi rr' + + return () + +withProgramIcon :: (Maybe Pixbuf -> IO a) -> B a +withProgramIcon f = asks bustleIcon >>= io . f + +loadPixbuf :: FilePath -> IO (Maybe Pixbuf) +loadPixbuf filename = do + iconName <- getDataFileName $ "data/" ++ filename + C.catch (fmap Just (pixbufNewFromFile iconName)) + (\(GError _ _ msg) -> warn msg >> return Nothing) + +openDialogue :: Window -> B () +openDialogue window = embedIO $ \r -> do + chooser <- fileChooserDialogNew Nothing (Just window) FileChooserActionOpen + [ ("gtk-cancel", ResponseCancel) + , ("gtk-open", ResponseAccept) + ] + chooser `set` [ windowModal := True + , fileChooserLocalOnly := True + ] + + chooser `afterResponse` \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 + maybeM mdirectory $ fileChooserSetCurrentFolder chooser + + chooser `afterResponse` \resp -> do + when (resp == ResponseAccept) $ do + Just fn <- io $ fileChooserGetFilename chooser + let (width, height) = diagramDimensions shapes + withPDFSurface fn width height $ + \surface -> renderWith surface $ drawDiagram False shapes + widgetDestroy chooser + + widgetShowAll chooser + +-- vim: sw=2 sts=2 diff --git a/Bustle/UI/AboutDialog.hs b/Bustle/UI/AboutDialog.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI/AboutDialog.hs @@ -0,0 +1,70 @@ +{- +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 hiding (catch) + +import Data.Version (showVersion) +import Control.Exception +import Control.Monad (when) + +import Graphics.UI.Gtk + +import Bustle.Util +import Paths_bustle + + +showAboutDialog :: Window + -> Maybe Pixbuf + -> IO () +showAboutDialog window icon = 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 := "http://willthompson.co.uk/bustle" + , aboutDialogAuthors := authors + , aboutDialogCopyright := "© 2008–2013 Will Thompson, Collabora Ltd. and contributors" + , aboutDialogLicense := license + ] + dialog `afterResponse` \resp -> + when (resp == ResponseCancel) (widgetDestroy dialog) + windowSetTransientFor dialog window + windowSetModal dialog True + aboutDialogSetLogo dialog icon + + widgetShowAll dialog + +authors :: [String] +authors = [ "Will Thompson " + , "Dafydd Harries" + , "Chris Lamb" + , "Marc Kleine-Budde" + , "Cosimo Alfarano" + , "Sergei Trofimovich" + , "Alex Merry" + ] diff --git a/Bustle/UI/Canvas.hs b/Bustle/UI/Canvas.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI/Canvas.hs @@ -0,0 +1,295 @@ +{- +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 +-} +module Bustle.UI.Canvas + ( + Canvas + , canvasNew + + , canvasGetShapes + , canvasSetShapes + + , canvasFocus + , canvasScrollToBottom + ) +where + +import Data.Maybe (isNothing) +import Data.IORef +import Control.Monad (when) + +import Graphics.UI.Gtk + +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" + 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 = 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 + + -- Expose events + -- I think we could speed things up by only showing the revealed area + -- rather than everything that's visible. + layout `on` exposeEvent $ tryEvent $ io $ canvasUpdate canvas + + return () + +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 + case rsCurrent rs of + Nothing -> return () + Just (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 + maybeM currentMessage $ \(r, _) -> + canvasInvalidateStripe canvas r + + maybeM 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 +canvasUpdate :: Canvas a + -> IO () +canvasUpdate canvas = do + current <- canvasGetSelection canvas + shapes <- canvasGetShapes canvas + width <- 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 <- layoutGetHAdjustment layout + hpos <- adjustmentGetValue hadj + hpage <- adjustmentGetPageSize hadj + + vadj <- layoutGetVAdjustment layout + vpos <- adjustmentGetValue vadj + vpage <- adjustmentGetPageSize vadj + + let r = (hpos, vpos, hpos + hpage, vpos + vpage) + + win <- layoutGetDrawWindow layout + renderWithDrawable win $ drawRegion r (canvasShowBounds canvas) shapes' + +canvasFocus :: Canvas a + -> IO () +canvasFocus canvas = do + (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)) diff --git a/Bustle/UI/DetailsView.hs b/Bustle/UI/DetailsView.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI/DetailsView.hs @@ -0,0 +1,145 @@ +{- +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 Data.List (intercalate) +import Graphics.UI.Gtk hiding (Signal, Markup) + +import qualified DBus as D + +import Bustle.Types +import Bustle.Markup +import Bustle.VariantFormatter + +data DetailsView = + DetailsView { detailsTable :: Table + , detailsTitle :: Label + , detailsPath :: Label + , detailsMember :: Label + , detailsBodyView :: TextView + } + +addTitle :: Table + -> String + -> Int + -> IO () +addTitle table title row = do + label <- labelNew $ Just title + miscSetAlignment label 0 0 + tableAttach table label 0 1 row (row + 1) [Fill] [Fill] 0 0 + +addValue :: Table + -> Int + -> IO Label +addValue table row = do + label <- labelNew Nothing + miscSetAlignment label 0 0 + labelSetEllipsize label EllipsizeStart + labelSetSelectable label True + tableAttach table label 1 2 row (row + 1) [Expand, Fill] [Fill] 0 0 + return label + +addField :: Table + -> String + -> Int + -> IO Label +addField table title row = do + addTitle table title row + addValue table row + +detailsViewNew :: IO DetailsView +detailsViewNew = do + table <- tableNew 2 3 False + table `set` [ tableRowSpacing := 6 + , tableColumnSpacing := 6 + ] + + title <- labelNew Nothing + miscSetAlignment title 0 0 + tableAttach table title 0 2 0 1 [Fill] [Fill] 0 0 + + pathLabel <- addField table "Path:" 1 + memberLabel <- addField table "Member:" 2 + + addTitle table "Arguments:" 3 + + view <- textViewNew + textViewSetWrapMode view WrapWordChar + textViewSetEditable view False + + sw <- scrolledWindowNew Nothing Nothing + scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic + containerAdd sw view + + tableAttachDefaults table sw 1 2 3 4 + + widgetShowAll table + return $ DetailsView table title pathLabel memberLabel view + +pickTitle :: Detailed Message -> Markup +pickTitle (Detailed _ m _) = case m of + MethodCall {} -> b (escape "Method call") + MethodReturn {} -> b (escape "Method return") + Error {} -> b (escape "Error") + Signal { signalDestination = d } -> + b . escape $ case d of + Nothing -> "Signal" + Just _ -> "Directed signal" + +getMemberMarkup :: Member -> String +getMemberMarkup m = + unMarkup $ 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 = fmap (member . deEvent) $ inReplyTo m + +formatMessage :: Detailed Message -> String +formatMessage (Detailed _ _ Nothing) = + "# No message body information is available. Please capture a fresh log\n\ + \# using bustle-pcap if you need it!" +formatMessage (Detailed _ _ (Just (_size, rm))) = + formatArgs $ D.receivedMessageBody rm + where + formatArgs = intercalate "\n" . map (format_Variant VariantStyleSignature) + +detailsViewGetTop :: DetailsView -> Widget +detailsViewGetTop = toWidget . detailsTable + +detailsViewUpdate :: DetailsView + -> Detailed Message + -> IO () +detailsViewUpdate d m = do + buf <- textViewGetBuffer $ detailsBodyView d + let member_ = getMember m + labelSetMarkup (detailsTitle d) (unMarkup $ pickTitle m) + labelSetText (detailsPath d) (maybe "Unknown" (D.formatObjectPath . path) member_) + labelSetMarkup (detailsMember d) (maybe "Unknown" getMemberMarkup member_) + textBufferSetText buf $ formatMessage m diff --git a/Bustle/UI/FilterDialog.hs b/Bustle/UI/FilterDialog.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI/FilterDialog.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE OverloadedStrings #-} +{- +Bustle.UI.FilterDialog: allows the user to filter the displayed log +Copyright © 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.UI.FilterDialog + ( runFilterDialog + ) +where + +import Data.List (intercalate) +import qualified Data.Set as Set +import Data.Set (Set) + +import Graphics.UI.Gtk + +import Bustle.Types + +formatNames :: (UniqueName, Set OtherName) + -> String +formatNames (u, os) + | Set.null os = unUniqueName u + | otherwise = intercalate "\n" . map unOtherName $ Set.toAscList os + +type NameStore = ListStore (Bool, (UniqueName, Set OtherName)) + +makeStore :: [(UniqueName, Set OtherName)] + -> Set UniqueName + -> IO NameStore +makeStore names currentlyHidden = do + listStoreNew $ map toPair names + where + toPair (name@(u, _)) = (not (Set.member u currentlyHidden), name) + +makeView :: NameStore + -> IO ScrolledWindow +makeView nameStore = do + nameView <- treeViewNewWithModel nameStore + -- We want rules because otherwise it's tough to see where each group + -- starts and ends + treeViewSetRulesHint nameView True + treeViewSetHeadersVisible nameView False + widgetSetSizeRequest nameView 600 371 + + tickyCell <- cellRendererToggleNew + tickyColumn <- treeViewColumnNew + treeViewColumnPackStart tickyColumn tickyCell True + treeViewAppendColumn nameView tickyColumn + + cellLayoutSetAttributes tickyColumn tickyCell nameStore $ \(ticked, _) -> + [ cellToggleActive := ticked ] + + on tickyCell cellToggled $ \pathstr -> do + let [i] = stringToTreePath pathstr + (v, ns) <- listStoreGetValue nameStore i + listStoreSetValue nameStore i (not v, ns) + + nameCell <- cellRendererTextNew + nameColumn <- treeViewColumnNew + treeViewColumnPackStart nameColumn nameCell True + treeViewAppendColumn nameView nameColumn + + cellLayoutSetAttributes nameColumn nameCell nameStore $ \(_, ns) -> + [ cellText := formatNames ns ] + + sw <- scrolledWindowNew Nothing Nothing + scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic + containerAdd sw nameView + + return sw + +runFilterDialog :: WindowClass parent + => parent -- ^ The window to which to attach the dialog + -> [(UniqueName, Set OtherName)] -- ^ Names, in order of appearance + -> Set UniqueName -- ^ Currently-hidden names + -> IO (Set UniqueName) -- ^ The set of names to *hide* +runFilterDialog parent names currentlyHidden = do + d <- dialogNew + windowSetTransientFor d parent + dialogAddButton d stockClose ResponseClose + vbox <- dialogGetUpper d + boxSetSpacing vbox 6 + + nameStore <- makeStore names currentlyHidden + sw <- makeView nameStore + + instructions <- labelNew Nothing + widgetSetSizeRequest instructions 600 (-1) + labelSetMarkup instructions + "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." + labelSetLineWrap instructions True + boxPackStart vbox instructions PackNatural 0 + + containerAdd vbox sw + widgetShowAll vbox + + _ <- dialogRun d + + widgetDestroy d + + results <- listStoreToList nameStore + return $ Set.fromList [ u + | (ticked, (u, _)) <- results + , not ticked + ] diff --git a/Bustle/UI/OpenTwoDialog.hs b/Bustle/UI/OpenTwoDialog.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI/OpenTwoDialog.hs @@ -0,0 +1,93 @@ +{- +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) + +import Graphics.UI.Gtk + +import Bustle.Util + +-- 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 `onCurrentFolderChanged` do + f1 <- fileChooserGetCurrentFolder d1 + f2 <- fileChooserGetCurrentFolder d2 + otherFile <- fileChooserGetFilename d2 + when (and [ isNothing otherFile + , f1 /= f2 + , isJust f1 + ]) $ do + fileChooserSetCurrentFolder d2 (fromJust f1) + return () + +setupOpenTwoDialog :: Builder + -> Window + -> (FilePath -> FilePath -> IO ()) + -> IO Dialog +setupOpenTwoDialog builder parent callback = do + dialog <- builderGetObject builder castToDialog "openTwoDialog" + [sessionBusChooser, systemBusChooser] <- + mapM (builderGetObject builder castToFileChooserButton) + ["sessionBusChooser", "systemBusChooser"] + openTwoOpenButton <- builderGetObject builder castToButton "openTwoOpenButton" + + windowSetTransientFor dialog parent + dialog `on` deleteEvent $ tryEvent $ io $ widgetHide dialog + + propagateCurrentFolder sessionBusChooser systemBusChooser + propagateCurrentFolder systemBusChooser sessionBusChooser + + let hideMyself = do + widgetHideAll 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 `afterResponse` \resp -> do + when (resp == ResponseAccept) $ do + Just f1 <- fileChooserGetFilename sessionBusChooser + Just f2 <- fileChooserGetFilename systemBusChooser + callback f1 f2 + + hideMyself + + return dialog diff --git a/Bustle/UI/Recorder.hs b/Bustle/UI/Recorder.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI/Recorder.hs @@ -0,0 +1,166 @@ +{- +Bustle.UI.Recorder: dialogs for driving Bustle.Monitor +Copyright © 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.Recorder + ( + recorderChooseFile + , recorderRun + ) +where + +import Control.Monad (when, liftM) +import Control.Concurrent.MVar +import qualified Data.Map as Map +import Data.Monoid +import Control.Monad.State (runStateT) + +import qualified Control.Exception as C +import System.Glib.GError +import Graphics.UI.Gtk + +import Bustle.Loader.Pcap (convert) +import Bustle.Loader (isRelevant) +import Bustle.Monitor +import Bustle.Renderer +import Bustle.Types +import Bustle.UI.Util (displayError) +import Bustle.Util + +type RecorderIncomingCallback = RendererResult Participants + -> IO () +type RecorderFinishedCallback = Bool -- ^ was anything meaningful actually recorded? + -> IO () + +processBatch :: MVar [DetailedEvent] + -> MVar Int + -> Label + -> RecorderIncomingCallback + -> IO (IO Bool) +processBatch pendingRef n label incoming = do + rendererStateRef <- newMVar rendererStateNew + -- FIXME: this is stupid. If we have to manually combine the outputs, it's + -- basically just more state. + rendererResultRef <- newMVar mempty + + return $ do + pending <- takeMVar pendingRef + putMVar pendingRef [] + + when (not (null pending)) $ do + rr <- modifyMVar rendererStateRef $ \s -> do + let (rr, s') = processSome (reverse pending) [] s + return (s', rr) + + oldRR <- takeMVar rendererResultRef + let rr' = oldRR `mappend` rr + putMVar rendererResultRef rr' + + when (not (null (rrShapes rr))) $ do + -- If the renderer produced some visible output, count it as a + -- message from the user's perspective. + i <- takeMVar n + let j = i + (length pending) + labelSetMarkup label $ + "Logged " ++ show j ++ " messages…" + putMVar n j + + incoming rr' + + return True + +recorderRun :: FilePath + -> Maybe Window + -> RecorderIncomingCallback + -> RecorderFinishedCallback + -> IO () +recorderRun filename mwindow incoming finished = C.handle newFailed $ do + monitor <- monitorNew BusTypeSession filename + dialog <- dialogNew + + maybe (return ()) (windowSetTransientFor dialog) mwindow + dialog `set` [ windowModal := True ] + + label <- labelNew Nothing + labelSetMarkup label "Logged 0 messages…" + loaderStateRef <- newMVar Map.empty + pendingRef <- newMVar [] + let updateLabel µs body = do + -- of course, modifyMVar and runStateT have their tuples back to front. + m <- modifyMVar loaderStateRef $ \s -> do + (m, s') <- runStateT (convert µs body) s + return (s', m) + + case m of + Left e -> warn e + Right message + | isRelevant (deEvent message) -> do + modifyMVar_ pendingRef $ \pending -> return (message:pending) + | otherwise -> return () + + handlerId <- monitor `on` monitorMessageLogged $ updateLabel + n <- newMVar (0 :: Int) + processor <- processBatch pendingRef n label incoming + processorId <- timeoutAdd processor 200 + + bar <- progressBarNew + pulseId <- timeoutAdd (progressBarPulse bar >> return True) 100 + + vbox <- dialogGetUpper dialog + boxPackStart vbox label PackGrow 0 + boxPackStart vbox bar PackNatural 0 + + dialogAddButton dialog "gtk-media-stop" ResponseClose + + dialog `afterResponse` \_ -> do + monitorStop monitor + signalDisconnect handlerId + timeoutRemove pulseId + timeoutRemove processorId + -- Flush out any last messages from the queue. + processor + widgetDestroy dialog + hadOutput <- liftM (/= 0) (readMVar n) + finished hadOutput + + widgetShowAll dialog + where + newFailed (GError _ _ message) = do + displayError mwindow message Nothing + +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 `afterResponse` \resp -> do + when (resp == ResponseAccept) $ do + Just fn <- fileChooserGetFilename chooser + callback fn + widgetDestroy chooser + + widgetShowAll chooser diff --git a/Bustle/UI/Util.hs b/Bustle/UI/Util.hs new file mode 100644 --- /dev/null +++ b/Bustle/UI/Util.hs @@ -0,0 +1,45 @@ +{- +Bustle.UI.Util: miscellaneous clickable utility functions +Copyright © 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.Util + ( + displayError + ) +where + +import Graphics.UI.Gtk + +import Bustle.Util (maybeM) + +-- Displays a modal error dialog, with the given strings as title and body +-- respectively. +displayError :: Maybe Window + -> String + -> Maybe String + -> IO () +displayError mwindow title mbody = do + dialog <- messageDialogNew mwindow + [DialogModal] + MessageError + ButtonsClose + title + + maybeM mbody $ messageDialogSetSecondaryText dialog + + dialog `afterResponse` \_ -> widgetDestroy dialog + widgetShowAll dialog diff --git a/Bustle/Upgrade.hs b/Bustle/Upgrade.hs new file mode 100644 --- /dev/null +++ b/Bustle/Upgrade.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} +{- +Bustle.Upgrade: synthesise information missing from old logs +Copyright (C) 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.Upgrade (upgrade) where + +import Control.Monad.State +import Data.Set (Set) +import qualified Data.Set as Set + +import Bustle.Types + +-- Bustle <0.2.0 did not log NameOwnerChanged; this adds fake ones to logs +-- lacking them +upgrade :: [DetailedEvent] -> [DetailedEvent] +upgrade es = + case partitionDetaileds es of + ([], ms) -> concat $ evalState (mapM synthesiseNOC ms) Set.empty + _ -> es + +synthesiseNOC :: Detailed Message -> State (Set TaggedBusName) [DetailedEvent] +synthesiseNOC de@(Detailed µs m _) = do + fakes <- mapM synthDM $ mentionedNames m + return ( concat fakes ++ [fmap MessageEvent de] ) + where + synthDM :: TaggedBusName -> State (Set TaggedBusName) [DetailedEvent] + synthDM n = do + fakes <- synth n + return $ map (\fake -> Detailed µs (NOCEvent fake) Nothing) fakes + +synth :: TaggedBusName + -> State (Set TaggedBusName) [NOC] +synth n = do + b <- gets (Set.member n) + if b + then return [] + else do + modify (Set.insert n) + return $ case n of + U u -> [ Connected u ] + O o -> [ Connected (fakeName o) + , NameChanged o (Claimed (fakeName o)) + ] + +fakeName :: OtherName -> UniqueName +fakeName = fakeUniqueName . unOtherName + +-- vim: sw=2 sts=2 diff --git a/Bustle/Util.hs b/Bustle/Util.hs new file mode 100644 --- /dev/null +++ b/Bustle/Util.hs @@ -0,0 +1,85 @@ +{-# 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 + + , maybeM + + , getCacheDir + + -- You probably don't actually want to use this function. + , traceM + + , NonEmpty(..) + , mapNonEmpty + , nonEmptyToList + ) +where + +import Control.Monad.Trans (MonadIO, liftIO) +import Debug.Trace (trace) +import System.IO (hPutStrLn, stderr) +import Foreign.C.String +import System.Directory +import System.FilePath (()) + +-- Escape hatch to log a value from a non-IO monadic context. +traceM :: (Show a, Monad m) => a -> m () +traceM x = trace (show x) $ return () + +-- 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 + +maybeM :: Monad m + => Maybe a + -> (a -> m b) + -> m () +maybeM Nothing _ = return () +maybeM (Just x) act = act x >> return () + +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 + +-- I don't want to depend on 'semigroups' for this. +data NonEmpty a = a :| [a] + deriving (Show, Eq) + +mapNonEmpty :: (a -> b) + -> NonEmpty a + -> NonEmpty b +mapNonEmpty f (x :| xs) = f x :| map f xs + +nonEmptyToList :: NonEmpty a -> [a] +nonEmptyToList (x :| xs) = x:xs diff --git a/Bustle/VariantFormatter.hs b/Bustle/VariantFormatter.hs new file mode 100644 --- /dev/null +++ b/Bustle/VariantFormatter.hs @@ -0,0 +1,145 @@ +{- +Bustle.VariantFormatter: produces GVariant strings representing D-Bus values +Copyright © 2011 Will Thompson + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +-} +module Bustle.VariantFormatter + ( format_Variant + , VariantStyle(..) + ) +where + +import Data.Word +import Data.Int +import Data.List (intercalate) +import Data.Char (chr, isPrint) +-- :'( +import Data.Maybe (fromJust) + +import DBus + +format_Bool :: Bool -> String +format_Bool = show + +format_Word8 :: Word8 -> String +format_Word8 = show + +format_ByteArray :: Array -> String +format_ByteArray ay = + if all (\y -> isPrint (chr (fromIntegral y))) bytes + then show (map (chr . fromIntegral) bytes :: String) + else format_Array ay + where + bytes = map (fromJust . fromVariant) (arrayItems ay) :: [Word8] + + +format_Int16 :: Int16 -> String +format_Int16 = show +format_Int32 :: Int32 -> String +format_Int32 = show +format_Int64 :: Int64 -> String +format_Int64 = show + +format_Word16 :: Word16 -> String +format_Word16 = show +format_Word32 :: Word32 -> String +format_Word32 = show +format_Word64 :: Word64 -> String +format_Word64 = show + +format_Double :: Double -> String +format_Double = show + +format_String :: String -> String +format_String = show + +format_Signature :: Signature -> String +format_Signature = show . formatSignature + +format_ObjectPath :: ObjectPath -> String +format_ObjectPath = show . formatObjectPath + +format_Array :: Array -> String +format_Array a = "[" ++ intercalate ", " items ++ "]" + where + items = map (format_Variant VariantStyleBare) $ arrayItems a + +format_Dictionary :: Dictionary -> String +format_Dictionary d = "{" ++ intercalate ", " items ++ "}" + where + items = map (\(k, v) -> format_Variant VariantStyleBare k ++ ": " ++ format_Variant VariantStyleBare v) $ dictionaryItems d + +-- FIXME… +format_Structure :: Structure -> String +format_Structure s = case structureItems s of + [] -> "()" + [v] -> "(" ++ format_Variant VariantStyleBare v ++ ",)" + vs -> "(" ++ intercalate ", " items ++ ")" + where + items = map (format_Variant VariantStyleBare) vs + +data VariantStyle = + VariantStyleBare + | VariantStyleSignature + | VariantStyleAngleBrackets + +-- why did you remove typeCode from the public API, John… +typeCode :: Type -> String +typeCode TypeBoolean = "b" +typeCode TypeWord8 = "y" +typeCode TypeWord16 = "q" +typeCode TypeWord32 = "u" +typeCode TypeWord64 = "t" +typeCode TypeInt16 = "n" +typeCode TypeInt32 = "i" +typeCode TypeInt64 = "x" +typeCode TypeDouble = "d" +typeCode TypeString = "s" +typeCode TypeSignature = "g" +typeCode TypeObjectPath = "o" +typeCode TypeVariant = "v" +typeCode (TypeArray t) = 'a':typeCode t +typeCode (TypeDictionary kt vt) = concat [ "a{", typeCode kt , typeCode vt, "}"] +typeCode (TypeStructure ts) = concat ["(", concatMap typeCode ts, ")"] + +format_Variant :: VariantStyle -> Variant -> String +format_Variant style v = + case style of + VariantStyleBare -> formatted + VariantStyleSignature -> typeSignature ++ " " ++ formatted + VariantStyleAngleBrackets -> "<" ++ typeSignature ++ " " ++ formatted ++ ">" + where + ty = variantType v + typeSignature = ('@':) . typeCode $ ty + format = case ty of + TypeBoolean -> format_Bool . fromJust . fromVariant + TypeInt16 -> format_Int16 . fromJust . fromVariant + TypeInt32 -> format_Int32 . fromJust . fromVariant + TypeInt64 -> format_Int64 . fromJust . fromVariant + TypeWord8 -> format_Word8 . fromJust . fromVariant + TypeWord16 -> format_Word16 . fromJust . fromVariant + TypeWord32 -> format_Word32 . fromJust . fromVariant + TypeWord64 -> format_Word64 . fromJust . fromVariant + TypeDouble -> format_Double . fromJust . fromVariant + TypeString -> format_String . fromJust . fromVariant + TypeSignature -> format_Signature . fromJust . fromVariant + TypeObjectPath -> format_ObjectPath . fromJust . fromVariant + TypeVariant -> format_Variant VariantStyleAngleBrackets . fromJust . fromVariant + TypeArray TypeWord8 -> format_ByteArray . fromJust . fromVariant + TypeArray _ -> format_Array . fromJust . fromVariant + TypeDictionary _ _ -> format_Dictionary . fromJust . fromVariant + TypeStructure _ -> format_Structure . fromJust . fromVariant + formatted = format v diff --git a/HACKING b/HACKING new file mode 100644 --- /dev/null +++ b/HACKING @@ -0,0 +1,14 @@ +Want to get involved? Great! +============================ + +Grab the latest code from git: + + git clone git://anongit.freedesktop.org/bustle + +and get stuck in! Please submit patches, or links to git branches, as +bugs on . + +In new code, try to follow +. +Certain authors did not follow it in the past but it seems like a good kind of +thing to aim for. diff --git a/INSTALL b/INSTALL new file mode 100644 --- /dev/null +++ b/INSTALL @@ -0,0 +1,33 @@ +Building from source +==================== + +First, make sure the Haskell Platform is installed, preferably along with the +Gtk+ bindings for Haskell. On Debian-flavoured systems: + + sudo apt-get install haskell-platform libghc-gtk-dev + +If you can't get the Haskell Platform via your package manager, see +. If you can't get the Gtk+ binding for +Haskell via your package manager, you'll need to run: + + cabal install gtk2hs-buildtools + +and ensure that ~/.cabal/bin is in your PATH before continuing. + +Got that? Great! + + export PREFIX=/opt/bustle + + # Build and install Bustle itself. + cabal install --prefix=$PREFIX + + # Build and install the stand-alone logger binary. + make install PREFIX=$PREFIX + +If the Haskell Platform is not available on the platform you want to do +some D-Bus profiling on, that's fine: the logger is written in C, and +you can view logs generated on your fancy embedded hardware on your more +pedestrian Linux laptop. The logger depends on a few widely-available +libraries: + + sudo apt-get install libglib2.0-dev libpcap-dev diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1541 @@ +All code in this project is licensed under the GNU LGPL Version 2.1 or (at your +option) any later version. + +dbus-core, a Haskell reimplementation of the D-Bus wire protocol which Bustle +depends on, is covered by the GNU GPL version 3. Hence, Bustle binaries may be +distributed under the GNU GPL version 3. + +dfeet-method.png and dfeet-signal.png were, as their names suggest, +taken from D-Feet, and are licensed under the GNU GPL Version 2 or +(at your option) any later version. + +The LGPL v2.1, GPL v2 and GPL v3 follow. + +--- + + 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! + +--- + + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, 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. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, 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 or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +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 give any other recipients of the Program a copy of this License +along with the Program. + +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 Program or any portion +of it, thus forming a work based on the Program, 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) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +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 Program, 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 Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) 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; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, 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 executable. However, as a +special exception, the source code 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. + +If distribution of executable or 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 counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program 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. + + 5. 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 Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program 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 to +this License. + + 7. 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 Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program 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 Program. + +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. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program 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. + + 9. The Free Software Foundation may publish revised and/or new versions +of the 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 Program +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 Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, 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 + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "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 PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. 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 PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), 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 Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. 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 program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. + +--- + + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, 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 +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If 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 convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU 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 +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "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 PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM 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 PROGRAM (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 PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state 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 program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/LICENSE.bundled-libraries b/LICENSE.bundled-libraries new file mode 100644 --- /dev/null +++ b/LICENSE.bundled-libraries @@ -0,0 +1,238 @@ +Shipping these libraries in the tarball is monstrous, and I'm sorry. I just +wanted to ship this thing. Anyway, these libraries are slurped right out of the +Debian packages on the system the tarball was built on. Here are some licenses: + +libffi: + + libffi - Copyright (c) 1996-2010 Red Hat, Inc and others. + See source files for details. + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, + EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY + CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, + TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE + SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +libpcap: + + Copyright (C) 1993-2008 The Regents of the University of California. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + 3. The names of the authors may not be used to endorse or promote + products derived from this software without specific prior + written permission. + + THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +libgmp: + + Copyright 1991, 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, + 2004, 2005, 2006, 2007 Free Software Foundation, Inc. + + This file is part of the GNU MP Library. + + The GNU MP 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 3 of the License, or (at your + option) any later version. + + The GNU MP 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 the GNU MP Library. If not, see http://www.gnu.org/licenses/. + +The source code is available from http://willthompson.co.uk/bustle/releases/. +Your complimentary copy of the GNU Lesser General Public License follows: + + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + 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 that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU 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 as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,71 @@ +CFLAGS = -g -O2 -Wall -Wunused +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_FLAGS := $(shell pcap-config --cflags pcap-config --libs) +DESTDIR = +PREFIX = /usr/local +BINDIR = $(DESTDIR)$(PREFIX)/bin +MAN1DIR = $(DESTDIR)$(PREFIX)/share/man/man1 + +BINARIES = \ + dist/build/bustle-pcap \ + $(NULL) + +MANPAGE = bustle-pcap.1 + +all: $(BINARIES) $(MANPAGE) + +BUSTLE_PCAP_SOURCES = c-sources/pcap-monitor.c c-sources/bustle-pcap.c +BUSTLE_PCAP_GENERATED_HEADERS = dist/build/autogen/version.h +BUSTLE_PCAP_HEADERS = c-sources/pcap-monitor.h $(BUSTLE_PCAP_GENERATED_HEADERS) + +bustle-pcap.1: dist/build/bustle-pcap + -help2man --output=$@ --no-info --name='Generate D-Bus logs for bustle' $< + +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.h: bustle.cabal + @mkdir -p `dirname $@` + perl -nle 'm/^Version:\s+(.*)$$/ and print qq(#define BUSTLE_VERSION "$$1")' \ + $< > $@ + +install: all + mkdir -p $(BINDIR) + cp $(BINARIES) $(BINDIR) + -mkdir -p $(MAN1DIR) + -cp bustle-pcap.1 $(MAN1DIR) + +uninstall: + rm -f $(notdir $(BINARIES)) + +clean: + rm -f $(BINARIES) $(MANPAGE) $(BUSTLE_PCAP_GENERATED_HEADERS) + if test -d ./$(TARBALL_DIR); then rm -r ./$(TARBALL_DIR); fi + rm -f ./$(TARBALL) + +# Binary tarball stuff. Please ignore this unless you're making a release. +TOP := $(shell pwd) +TARBALL_PARENT_DIR := dist +TARBALL_DIR := $(shell git describe --tags)-$(shell gcc -dumpmachine | perl -pe 's/-.*//') +TARBALL_FULL_DIR := $(TARBALL_PARENT_DIR)/$(TARBALL_DIR) +TARBALL := $(TARBALL_DIR).tar.bz2 +maintainer-binary-tarball: all + mkdir -p $(TARBALL_FULL_DIR) + cabal-dev configure --prefix=$(TOP)/$(TARBALL_FULL_DIR) \ + --datadir=$(TOP)/$(TARBALL_FULL_DIR) --datasubdir=. + cabal-dev build + cabal-dev copy + cp bustle.sh README $(TARBALL_FULL_DIR) + perl -pi -e 's{^ bustle-pcap}{ ./bustle-pcap};' \ + -e 's{^ bustle} { ./bustle.sh};' \ + $(TARBALL_FULL_DIR)/README + cp $(BINARIES) $(MANPAGE) $(TARBALL_FULL_DIR) + mkdir -p $(TARBALL_FULL_DIR)/lib + cp LICENSE.bundled-libraries $(TARBALL_FULL_DIR)/lib + ./ldd-me-up.sh $(TARBALL_FULL_DIR)/bin/bustle \ + | xargs -I XXX cp XXX $(TARBALL_FULL_DIR)/lib + cd $(TARBALL_PARENT_DIR) && tar cjf $(TARBALL) $(TARBALL_DIR) diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,268 @@ +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 diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,47 @@ +Bustle 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. + + +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 + +If you want to log all system bus traffic, you need to edit +`/etc/dbus/system.conf` to enable eavesdropping, and then remove the include of +`/etc/dbus-1/system.conf.d` which seems to re-enable strictness. Then you can run +the stand-alone logger against the system bus: + + bustle-pcap --system system-log.bustle + +Please remember to **undo these changes** when you're done. + + +More information +================ + +See . diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/DumpMessages.hs b/Test/DumpMessages.hs new file mode 100644 --- /dev/null +++ b/Test/DumpMessages.hs @@ -0,0 +1,15 @@ +module 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" + (Right (warnings, messages)) <- readPcap file + forM_ (zip [1..] messages) $ \(i, message) -> + putStrLn $ show i ++ ": " ++ show message diff --git a/Test/PcapCrash.hs b/Test/PcapCrash.hs new file mode 100644 --- /dev/null +++ b/Test/PcapCrash.hs @@ -0,0 +1,21 @@ +-- 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 _ -> do + return () diff --git a/Test/Regions.hs b/Test/Regions.hs new file mode 100644 --- /dev/null +++ b/Test/Regions.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE TemplateHaskell #-} +import Test.QuickCheck +import Test.QuickCheck.All + +import Data.List (sort, group) +import Data.Maybe (isNothing, isJust) + +import Bustle.Regions + +instance Arbitrary Stripe where + arbitrary = do + top <- fmap abs arbitrary + bottom <- arbitrary `suchThat` (>= top) + return $ Stripe top bottom + +newtype NonOverlappingStripes = NonOverlappingStripes [Stripe] + deriving + (Show, Eq, Ord) + +instance Arbitrary NonOverlappingStripes where + arbitrary = do + -- there is no orderedList1 sadly + stripes <- fmap sort (listOf1 arbitrary) `suchThat` nonOverlapping + 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 xs = all (== 1) . map length . group $ xs + +instance (Eq a, Arbitrary a) => Arbitrary (RegionSelection a) where + arbitrary = do + ValidRegions rs <- arbitrary + return $ regionSelectionNew rs + +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 = do + fs <- listOf randomMutation + return $ foldr (.) id fs + +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 + +runTests = $quickCheckAll + +main = do + runTests + return () diff --git a/Test/Renderer.hs b/Test/Renderer.hs new file mode 100644 --- /dev/null +++ b/Test/Renderer.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE OverloadedStrings #-} +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 DBus (objectPath_, busName_) + +import Bustle.Types +import Bustle.Renderer + +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" +swaddle messages timestamps = map (\(e, ts) -> Detailed ts e Nothing) + (zip messages timestamps) +sessionLogWithoutDisconnect = + [ NOCEvent $ Connected activeService + , MessageEvent $ Signal (U activeService) Nothing $ Member (objectPath_ "/") Nothing "Hello" + ] +sessionLogWithDisconnect = sessionLogWithoutDisconnect ++ [ NOCEvent $ Disconnected activeService ] +expectedParticipants = [ (activeService, Set.empty) ] + +test_ l expected = expected @=? ps + where + rr = process (swaddle l [1..]) [] + ps = sessionParticipants (rrApplications rr) + +test_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 = swaddle bareLog [1,3..] +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 = f fullRR incrementalRR + +-- TODO: it should be possible to make this work for side-by-side logs too. +-- Currently it doesn't seem to... +fullRR, incrementalRR :: RendererResult Participants +fullRR = process sessionLog [] +incrementalRR = mconcat rrs + where + processOne m = state $ processSome [m] [] + (rrs, _) = runState (mapM processOne sessionLog) rendererStateNew diff --git a/Test/data/log-with-h.bustle b/Test/data/log-with-h.bustle new file mode 100644 Binary files /dev/null and b/Test/data/log-with-h.bustle differ diff --git a/bustle.cabal b/bustle.cabal new file mode 100644 --- /dev/null +++ b/bustle.cabal @@ -0,0 +1,177 @@ +Name: bustle +Category: Network, Desktop +Version: 0.4.3 +Cabal-Version: >= 1.8 +Synopsis: Draw pretty sequence diagrams of D-Bus traffic +Description: Draw pretty sequence diagrams of D-Bus traffic +License: OtherLicense +License-file: LICENSE +Author: Will Thompson +Maintainer: Will Thompson +Data-files: data/bustle.png, + data/dfeet-method.png, + data/dfeet-signal.png, + data/bustle.ui, + LICENSE +Build-type: Simple +Extra-source-files: + -- C bits + c-sources/bustle-pcap.c, + c-sources/pcap-monitor.h, + c-sources/config.h, + Makefile, + + -- Stuff for nerds + README, + NEWS, + HACKING, + INSTALL, + run-uninstalled.sh + , Test/data/log-with-h.bustle + + -- Stuff for the stupid binary tarballs + , bustle.sh + , ldd-me-up.sh + , LICENSE.bundled-libraries + + +Source-Repository head + Type: git + Location: git://anongit.freedesktop.org/bustle + +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.Loader + , Bustle.Loader.OldSkool + , Bustle.Loader.Pcap + , Bustle.Markup + , Bustle.Monitor + , Bustle.Noninteractive + , Bustle.Regions + , Bustle.Renderer + , Bustle.StatisticsPane + , Bustle.Stats + , Bustle.Types + , Bustle.UI + , Bustle.UI.AboutDialog + , Bustle.UI.Canvas + , Bustle.UI.DetailsView + , Bustle.UI.FilterDialog + , Bustle.UI.OpenTwoDialog + , Bustle.UI.Recorder + , Bustle.UI.Util + , Bustle.Upgrade + , Bustle.Util + , Bustle.VariantFormatter + Ghc-options: -Wall + -fno-warn-unused-do-bind + if flag(threaded) + ghc-options: -threaded + C-sources: c-sources/pcap-monitor.c + pkgconfig-depends: glib-2.0 >= 2.26 + + Build-Depends: base >= 4 && < 5 + , bytestring + , cairo + , containers + , dbus >= 0.10 + , directory + , filepath + , glib + , gtk >= 0.12.4 + , mtl + , pango + , parsec + , pcap + , process + , text + , time + +Executable test-monitor + if flag(InteractiveTests) + buildable: True + else + buildable: False + + main-is: tests/Monitor.hs + other-modules: Bustle.Monitor + if flag(threaded) + Ghc-options: -threaded + C-sources: c-sources/pcap-monitor.c + pkgconfig-depends: glib-2.0 + Build-Depends: base >= 4 && < 5 + , bytestring + , cairo + , containers + , dbus + , directory + , filepath + , gtk > 0.12 + , glib + , mtl + , pango + , parsec + , pcap + , text + +Executable dump-messages + if flag(InteractiveTests) + buildable: True + else + buildable: False + + main-is: Test/DumpMessages.hs + Build-Depends: base + , bytestring + , containers + , dbus >= 0.10 + , mtl + , pcap + , text + +Test-suite test-pcap-crash + type: exitcode-stdio-1.0 + main-is: Test/PcapCrash.hs + other-modules: Bustle.Loader.Pcap + Build-Depends: base + , bytestring + , containers + , dbus >= 0.10 + , mtl + , pcap + , text + +Test-suite test-regions + type: exitcode-stdio-1.0 + main-is: Test/Regions.hs + other-modules: Bustle.Regions + Build-Depends: base + , QuickCheck + +Test-suite test-renderer + type: exitcode-stdio-1.0 + main-is: Test/Renderer.hs + other-modules: Bustle.Renderer + Build-Depends: base + , cairo + , containers + , dbus >= 0.10 + , directory + , filepath + , gtk + , mtl + , text + , pango + , test-framework + , test-framework-hunit + , HUnit diff --git a/bustle.sh b/bustle.sh new file mode 100644 --- /dev/null +++ b/bustle.sh @@ -0,0 +1,14 @@ +#!/bin/sh +set -e + +root="$(dirname $(readlink -f ${0}))" + +bustle_datadir="${root}" +export bustle_datadir + +LD_LIBRARY_PATH="${root}/lib:${LD_LIBRARY_PATH}" +export LD_LIBRARY_PATH + +bustle="${root}"/bin/bustle + +exec $bustle "${@}" diff --git a/c-sources/bustle-pcap.c b/c-sources/bustle-pcap.c new file mode 100644 --- /dev/null +++ b/c-sources/bustle-pcap.c @@ -0,0 +1,219 @@ +/* bustle-pcap.c: utility to log D-Bus traffic to a pcap file. + * + * Copyright © 2011 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; + +#if GLIB_CHECK_VERSION (2, 30, 0) +static void +let_me_quit (GMainLoop *loop) +{ + g_unix_signal_add (SIGINT, (GSourceFunc) g_main_loop_quit, loop); + + if (!quiet) + g_printf ("Hit Control-C to stop logging.\n"); +} +#else +static gboolean +stdin_func ( + GPollableInputStream *g_stdin, + GMainLoop *loop) +{ + char buf[2]; + + if (g_pollable_input_stream_read_nonblocking (g_stdin, buf, 1, NULL, NULL) + != -1) + { + g_main_loop_quit (loop); + return FALSE; + } + + return TRUE; +} + +static void +let_me_quit (GMainLoop *loop) +{ + GInputStream *g_stdin = g_unix_input_stream_new (0, FALSE); + GSource *source = g_pollable_input_stream_create_source ( + G_POLLABLE_INPUT_STREAM (g_stdin), NULL); + + g_source_set_callback (source, (GSourceFunc) stdin_func, loop, NULL); + g_source_attach (source, NULL); + g_printf ("Hit Enter to stop logging. (Do not hit Control-C.)\n"); +} +#endif + +static gboolean session_specified = FALSE; +static gboolean system_specified = FALSE; +static gchar **filenames = NULL; + +static GOptionEntry 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 + }, + { "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 + }, + { 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, + GBusType *bus_type, + gchar **filename) +{ + GOptionContext *context; + gchar *usage; + GError *error = NULL; + gboolean ret; + + context = g_option_context_new ("FILENAME"); + 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"); + + ret = g_option_context_parse (context, argc, argv, &error); + usage = g_option_context_get_help (context, TRUE, NULL); + + if (!ret) + { + fprintf (stderr, "%s\n", error->message); + fprintf (stderr, "%s", usage); + exit (2); + } + + if (version) + { + fprintf (stdout, "bustle-pcap " BUSTLE_VERSION "\n\n"); + fprintf (stdout, "Copyright 2011 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 (0); + } + else if (session_specified && system_specified) + { + fprintf (stderr, "You may only specify one of --session and --system\n"); + fprintf (stderr, "%s", usage); + exit (2); + } + 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 (2); + } + + *filename = filenames[0]; +} + +static void +message_logged_cb ( + BustlePcapMonitor *pcap, + GDBusMessage *message, + gboolean is_incoming, + glong sec, + glong usec, + guint8 *data, + guint len, + gpointer user_data) +{ + g_print ("(%s) %s -> %s: %u %s\n", + is_incoming ? "incoming" : "outgoing", + 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)); +} + +int +main ( + int argc, + char **argv) +{ + GMainLoop *loop; + GBusType bus_type; + gchar *filename; + GError *error = NULL; + BustlePcapMonitor *pcap; + + g_type_init (); + parse_arguments (&argc, &argv, &bus_type, &filename); + + pcap = bustle_pcap_monitor_new (bus_type, filename, &error); + if (pcap == NULL) + { + fprintf (stderr, "%s", 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); + + if (!quiet) + g_printf ("Logging D-Bus traffic to '%s'...\n", filename); + + let_me_quit (loop); + g_main_loop_run (loop); + g_main_loop_unref (loop); + + bustle_pcap_monitor_stop (pcap); + g_object_unref (pcap); + + return 0; +} diff --git a/c-sources/config.h b/c-sources/config.h new file mode 100644 --- /dev/null +++ b/c-sources/config.h @@ -0,0 +1,25 @@ +/* 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_26 +#define GLIB_VERSION_MAX_ALLOWED GLIB_VERSION_2_30 + +#endif /* BUSTLE_CONFIG_H */ diff --git a/c-sources/pcap-monitor.c b/c-sources/pcap-monitor.c new file mode 100644 --- /dev/null +++ b/c-sources/pcap-monitor.c @@ -0,0 +1,597 @@ +/* + * pcap-monitor.c - monitors a bus and dumps messages to a pcap file + * 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 + */ + +#include "config.h" +#include "pcap-monitor.h" + +#include +#include + +typedef struct { + struct timeval ts; + GByteArray *blob; +} Message; + +typedef struct { + BustlePcapMonitor *self; + GDBusMessage *dbus_message; + gboolean is_incoming; + Message message; +} IdleEmitData; + +#define STOP ((Message *) 0x1) + +typedef struct { + pcap_dumper_t *dumper; + GAsyncQueue *message_queue; +} ThreadData; + +struct _BustlePcapMonitorPrivate { + GBusType bus_type; + GDBusConnection *connection; + GDBusCapabilityFlags caps; + + guint filter_id; + + gchar *filename; + pcap_t *p; + + GThread *thread; + ThreadData td; +}; + +enum { + PROP_BUS_TYPE = 1, + PROP_FILENAME, +}; + +enum { + SIG_MESSAGE_LOGGED, + 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); + ) + +static void +bustle_pcap_monitor_init (BustlePcapMonitor *self) +{ + self->priv = G_TYPE_INSTANCE_GET_PRIVATE (self, BUSTLE_TYPE_PCAP_MONITOR, + BustlePcapMonitorPrivate); + self->priv->bus_type = G_BUS_TYPE_SESSION; + self->priv->td.message_queue = g_async_queue_new (); +} + +static void +bustle_pcap_monitor_get_property ( + GObject *object, + guint property_id, + GValue *value, + GParamSpec *pspec) +{ + BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (object); + BustlePcapMonitorPrivate *priv = self->priv; + + switch (property_id) + { + case PROP_BUS_TYPE: + g_value_set_enum (value, priv->bus_type); + break; + case PROP_FILENAME: + g_value_set_string (value, priv->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); + BustlePcapMonitorPrivate *priv = self->priv; + + switch (property_id) + { + case PROP_BUS_TYPE: + priv->bus_type = g_value_get_enum (value); + break; + case PROP_FILENAME: + priv->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); + BustlePcapMonitorPrivate *priv = self->priv; + GObjectClass *parent_class = bustle_pcap_monitor_parent_class; + + if (parent_class->dispose != NULL) + parent_class->dispose (object); + + /* Make sure we're all closed up. */ + bustle_pcap_monitor_stop (self); + + g_clear_object (&priv->connection); +} + +static void +bustle_pcap_monitor_finalize (GObject *object) +{ + BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (object); + BustlePcapMonitorPrivate *priv = self->priv; + GObjectClass *parent_class = bustle_pcap_monitor_parent_class; + + if (parent_class->finalize != NULL) + parent_class->finalize (object); + + g_free (priv->filename); + priv->filename = NULL; + + g_async_queue_unref (priv->td.message_queue); + priv->td.message_queue = NULL; +} + +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; + + g_type_class_add_private (klass, sizeof (BustlePcapMonitorPrivate)); + +#define THRICE(x) x, x, x + + param_spec = g_param_spec_enum (THRICE ("bus-type"), + G_TYPE_BUS_TYPE, G_BUS_TYPE_SESSION, + 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 (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. + * @message: the #GDBusMessage object logged. + * @is_incoming: if %TRUE, @message has come in from the bus daemon; if + * %FALSE, this is a message we're in the process of sending. Note that this + * can be %TRUE for messages our process sends, because we eavesdrop all + * messages, including our own. + * @sec: seconds since 1970. + * @usec: microseconds! (These are not combined into a single %gint64 because + * my version of gtk2hs 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. + */ + signals[SIG_MESSAGE_LOGGED] = g_signal_new ("message-logged", + BUSTLE_TYPE_PCAP_MONITOR, G_SIGNAL_RUN_FIRST, + 0, NULL, NULL, + NULL, G_TYPE_NONE, 6, + G_TYPE_DBUS_MESSAGE, + G_TYPE_BOOLEAN, + G_TYPE_LONG, + G_TYPE_LONG, + G_TYPE_POINTER, + G_TYPE_UINT); +} + +static gpointer +log_thread (gpointer data) +{ + ThreadData *td = data; + Message *message; + + while (STOP != (message = g_async_queue_pop (td->message_queue))) + { + struct pcap_pkthdr hdr; + hdr.ts = message->ts; + + hdr.caplen = message->blob->len; + hdr.len = message->blob->len; + + /* The cast is necessary because libpcap is weird. */ + pcap_dump ((u_char *) td->dumper, &hdr, message->blob->data); + g_byte_array_unref (message->blob); + g_slice_free (Message, message); + } + + return NULL; +} + +static gboolean +emit_me (gpointer data) +{ + IdleEmitData *ied = data; + BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (ied->self); + glong sec = ied->message.ts.tv_sec; + glong usec = ied->message.ts.tv_usec; + + g_signal_emit (self, signals[SIG_MESSAGE_LOGGED], 0, + ied->dbus_message, + ied->is_incoming, + sec, + usec, + ied->message.blob->data, + ied->message.blob->len); + g_object_unref (self); + g_object_unref (ied->dbus_message); + g_byte_array_unref (ied->message.blob); + g_slice_free (IdleEmitData, ied); + return FALSE; +} + +GDBusMessage * +filter ( + GDBusConnection *connection, + GDBusMessage *message, + gboolean is_incoming, + gpointer user_data) +{ + BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (user_data); + const gchar *dest; + gsize size; + guchar *blob; + IdleEmitData ied = { g_object_ref (self), g_object_ref (message), is_incoming }; + GError *error = NULL; + + gettimeofday (&ied.message.ts, NULL); + blob = g_dbus_message_to_blob (message, &size, self->priv->caps, &error); + if (blob == NULL) + { + g_critical ("Couldn't marshal message: %s", error->message); + g_return_val_if_reached (NULL); + } + if (size > G_MAXUINT) + { + g_critical ("Message is longer than " G_STRINGIFY (G_MAXUINT) + "(which is surprising because the specification says the " + "maximum length of a message is 2**27 and guint is always " + "at least 32 bits wide"); + g_return_val_if_reached (NULL); + } + ied.message.blob = g_byte_array_append ( + g_byte_array_sized_new ((guint) size), + blob, (guint) size); + g_byte_array_ref (ied.message.blob); + g_async_queue_push (self->priv->td.message_queue, + g_slice_dup (Message, &(ied.message))); + + dest = g_dbus_message_get_destination (message); + + /* The idle steals the remaining refs to self, message, and message_blob. */ + g_idle_add (emit_me, g_slice_dup (IdleEmitData, &ied)); + + if (!is_incoming || + g_strcmp0 (dest, g_dbus_connection_get_unique_name (connection)) == 0) + { + /* This message is either outgoing or actually for us, as opposed to + * being eavesdropped; it should be allowed to escape from this handler. + */ + return message; + } + else + { + /* Otherwise, we need to handle it within this function, or else GDBus + * replies to other people's method calls and we all get really confused. + */ + g_clear_object (&message); + return NULL; + } +} + +static gboolean +match_everything ( + GDBusProxy *bus, + gboolean with_eavesdrop, + GError **error) +{ +#define EAVESDROP "eavesdrop=true," + char *rules[] = { + EAVESDROP "type='signal'", + EAVESDROP "type='method_call'", + EAVESDROP "type='method_return'", + EAVESDROP "type='error'", + NULL + }; + const gsize offset = with_eavesdrop ? 0 : strlen (EAVESDROP); + char **r; + + for (r = rules; *r != NULL; r++) + { + const gchar *rule = *r + offset; + GVariant *ret = g_dbus_proxy_call_sync ( + bus, + "AddMatch", + g_variant_new ("(s)", rule), + G_DBUS_CALL_FLAGS_NONE, + -1, + NULL, + error); + + if (ret == NULL) + { + g_prefix_error (error, "Couldn't AddMatch(%s): ", *r); + return FALSE; + } + else + { + g_variant_unref (ret); + } + } + + return TRUE; +} + +static gboolean +list_all_names ( + GDBusProxy *bus, + GError **error) +{ + GVariant *ret; + gchar **names; + + g_assert (G_IS_DBUS_PROXY (bus)); + + 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) + { + GVariant *owner = g_dbus_proxy_call_sync (bus, "GetNameOwner", + g_variant_new ("(s)", name), + G_DBUS_CALL_FLAGS_NONE, -1, NULL, NULL); + + if (owner != NULL) + g_variant_unref (owner); + /* else they were too quick for us! */ + } + } + + g_variant_unref (ret); + return TRUE; +} + +static gboolean +initable_init ( + GInitable *initable, + GCancellable *cancellable, + GError **error) +{ + BustlePcapMonitor *self = BUSTLE_PCAP_MONITOR (initable); + BustlePcapMonitorPrivate *priv = self->priv; + gchar *address; + GDBusProxy *bus; + + if (priv->bus_type == G_BUS_TYPE_NONE) + { + g_set_error (error, G_IO_ERROR, G_IO_ERROR_NOT_SUPPORTED, + "Logging things other than message busses is not supported"); + return FALSE; + } + + if (priv->filename == NULL) + { + g_set_error (error, G_IO_ERROR, G_IO_ERROR_INVALID_ARGUMENT, + "You must specify a filename"); + return FALSE; + } + + /* FIXME: use DLT_DBUS when it makes it into libpcap. */ + priv->p = pcap_open_dead (DLT_NULL, 1 << 27); + if (priv->p == NULL) + { + g_set_error (error, G_IO_ERROR, G_IO_ERROR_FAILED, + "pcap_open_dead failed. wtf"); + return FALSE; + } + + priv->td.dumper = pcap_dump_open (priv->p, priv->filename); + if (priv->td.dumper == NULL) + { + g_set_error (error, G_IO_ERROR, G_IO_ERROR_FAILED, + "Couldn't open target file %s", pcap_geterr (priv->p)); + return FALSE; + } + + priv->thread = g_thread_create (log_thread, &priv->td, TRUE, error); + if (priv->thread == NULL) + { + g_prefix_error (error, "Couldn't spawn logging thread: "); + return FALSE; + } + + address = g_dbus_address_get_for_bus_sync (priv->bus_type, NULL, error); + if (address == NULL) + { + g_prefix_error (error, "Couldn't get %s bus address: ", + priv->bus_type == G_BUS_TYPE_SESSION ? "session" : "system"); + return FALSE; + } + + if (*address == '\0') + { + g_set_error (error, + G_IO_ERROR, + G_IO_ERROR_FAILED, + "Failed to look up the %s bus address. %s", + priv->bus_type == G_BUS_TYPE_SESSION ? "session" : "system", + priv->bus_type == G_BUS_TYPE_SESSION + ? "Is DBUS_SESSION_BUS_ADDRESS properly set?" + : ""); + g_free (address); + return FALSE; + } + + priv->connection = g_dbus_connection_new_for_address_sync (address, + G_DBUS_CONNECTION_FLAGS_AUTHENTICATION_CLIENT | + G_DBUS_CONNECTION_FLAGS_MESSAGE_BUS_CONNECTION, + NULL, /* auth observer */ + NULL, /* cancellable */ + error); + g_free (address); + if (priv->connection == NULL) + { + g_prefix_error (error, "Couldn't connect to %s bus: ", + priv->bus_type == G_BUS_TYPE_SESSION ? "session" : "system"); + return FALSE; + } + + priv->caps = g_dbus_connection_get_capabilities (priv->connection); + + bus = g_dbus_proxy_new_sync (priv->connection, + G_DBUS_PROXY_FLAGS_DO_NOT_LOAD_PROPERTIES | + G_DBUS_PROXY_FLAGS_DO_NOT_CONNECT_SIGNALS, + NULL, + "org.freedesktop.DBus", + "/org/freedesktop/DBus", + "org.freedesktop.DBus", + NULL, + error); + if (bus == NULL) + { + g_prefix_error (error, "Couldn't construct bus proxy: "); + return FALSE; + } + + /* As of DBus 1.5.something you have to specify eavesdrop=true to be sure of + * getting everything. (Specifically, you don't get directed signals unless + * you specify it.) + * + * So first we try to add match rules with "eavesdrop=true" on them. If that + * fails, we try again without that; if that also fails, we return the second error. + */ + if (!match_everything (bus, TRUE, NULL) && + !match_everything (bus, FALSE, error)) + return FALSE; + + priv->filter_id = g_dbus_connection_add_filter (priv->connection, filter, + g_object_ref (self), g_object_unref); + + { + /* FIXME: there's a race between listing all the names and binding to all + * signals (and hence getting NameOwnerChanged). Old bustle-dbus-monitor had + * it too. + */ + gboolean ret = list_all_names (bus, error); + g_object_unref (bus); + + return ret; + } +} + +/* FIXME: make this async? */ +void +bustle_pcap_monitor_stop ( + BustlePcapMonitor *self) +{ + BustlePcapMonitorPrivate *priv = self->priv; + + if (priv->filter_id != 0) + { + g_return_if_fail (priv->connection != NULL); + g_dbus_connection_remove_filter (priv->connection, priv->filter_id); + priv->filter_id = 0; + } + + if (priv->connection != NULL && + !g_dbus_connection_is_closed (priv->connection)) + { + g_dbus_connection_close_sync (priv->connection, NULL, NULL); + } + + if (priv->thread != NULL) + { + g_return_if_fail (priv->td.message_queue != NULL); + /* Wait for the writer thread to spit out all the messages, then close up. */ + g_async_queue_push (priv->td.message_queue, STOP); + g_thread_join (priv->thread); + priv->thread = NULL; + } + + if (priv->td.dumper != NULL) + { + pcap_dump_close (priv->td.dumper); + priv->td.dumper = NULL; + } + + if (priv->p != NULL) + { + pcap_close (priv->p); + priv->p = NULL; + } +} + +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 *filename, + GError **error) +{ + return g_initable_new ( + BUSTLE_TYPE_PCAP_MONITOR, NULL, error, + "bus-type", bus_type, + "filename", filename, + NULL); +} diff --git a/c-sources/pcap-monitor.h b/c-sources/pcap-monitor.h new file mode 100644 --- /dev/null +++ b/c-sources/pcap-monitor.h @@ -0,0 +1,65 @@ +/* + * pcap-monitor.h - monitors a bus and dumps messages to a pcap file + * 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 + */ + +#ifndef BUSTLE_PCAP_MONITOR_H +#define BUSTLE_PCAP_MONITOR_H + +#include +#include + +typedef struct _BustlePcapMonitor BustlePcapMonitor; +typedef struct _BustlePcapMonitorClass BustlePcapMonitorClass; +typedef struct _BustlePcapMonitorPrivate BustlePcapMonitorPrivate; + +struct _BustlePcapMonitorClass { + GObjectClass parent_class; +}; + +struct _BustlePcapMonitor { + GObject parent; + + BustlePcapMonitorPrivate *priv; +}; + +GType bustle_pcap_monitor_get_type (void); + +BustlePcapMonitor *bustle_pcap_monitor_new ( + GBusType bus_type, + const gchar *filename, + GError **error); +void bustle_pcap_monitor_stop ( + BustlePcapMonitor *self); + +/* TYPE MACROS */ +#define BUSTLE_TYPE_PCAP_MONITOR \ + (bustle_pcap_monitor_get_type ()) +#define BUSTLE_PCAP_MONITOR(obj) \ + (G_TYPE_CHECK_INSTANCE_CAST((obj), BUSTLE_TYPE_PCAP_MONITOR, BustlePcapMonitor)) +#define BUSTLE_PCAP_MONITOR_CLASS(klass) \ + (G_TYPE_CHECK_CLASS_CAST((klass), BUSTLE_TYPE_PCAP_MONITOR,\ + BustlePcapMonitorClass)) +#define BUSTLE_IS_PCAP_MONITOR(obj) \ + (G_TYPE_CHECK_INSTANCE_TYPE((obj), BUSTLE_TYPE_PCAP_MONITOR)) +#define BUSTLE_IS_PCAP_MONITOR_CLASS(klass) \ + (G_TYPE_CHECK_CLASS_TYPE((klass), BUSTLE_TYPE_PCAP_MONITOR)) +#define BUSTLE_PCAP_MONITOR_GET_CLASS(obj) \ + (G_TYPE_INSTANCE_GET_CLASS ((obj), BUSTLE_TYPE_PCAP_MONITOR, \ + BustlePcapMonitorClass)) + +#endif /* BUSTLE_PCAP_MONITOR_H */ diff --git a/data/bustle.png b/data/bustle.png new file mode 100644 Binary files /dev/null and b/data/bustle.png differ diff --git a/data/bustle.ui b/data/bustle.ui new file mode 100644 --- /dev/null +++ b/data/bustle.ui @@ -0,0 +1,620 @@ + + + + + False + 900 + 700 + + + True + False + + + True + False + + + False + True + False + _File + True + + + True + False + + + gtk-new + False + True + False + True + True + + + + + + gtk-open + False + True + False + True + True + + + + + + False + 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 + + + + + gtk-save-as + False + True + False + False + True + True + + + + + + False + True + False + False + _Export as PDF… + True + + + + + + False + True + False + + + + + gtk-close + False + True + True + False + True + True + + + + + + + + + + False + True + False + _View + True + + + True + False + + + False + True + False + False + _Filter visible services… + True + + + + + + False + True + False + False + _Statistics + True + + + + + + + + + + False + True + False + _Help + True + + + True + False + + + gtk-about + False + True + False + True + True + + + + + + + + + False + True + 0 + + + + + True + True + False + False + + + True + False + 0 + 0 + + + True + False + 12 + + + True + False + 12 + True + center + + + False + True + True + True + False + + + True + False + 12 + + + True + False + gtk-new + 6 + + + True + True + 0 + + + + + True + False + Record a new log + + + True + True + 1 + + + + + + + False + True + 0 + + + + + False + True + True + True + False + + + True + False + 12 + + + True + False + gtk-open + 6 + + + True + True + 0 + + + + + True + False + Open an existing log + + + True + True + 1 + + + + + + + False + True + 1 + + + + + False + True + 0 + + + + + True + False + You may also use the <i>bustle-pcap</i> command-line tool to record logs. + True + + + False + False + 1 + + + + + + + + + True + False + Instructions + + + False + + + + + True + False + <big><b>Waiting for D-Bus traffic; please hold…</b></big> + True + + + 1 + + + + + True + False + Please hold + + + 1 + False + + + + + True + True + + + True + True + + + True + True + never + automatic + in + + + + + + + + True + False + Message frequencies + + + False + + + + + True + True + never + automatic + in + + + + + + 1 + + + + + True + False + Method durations + + + 1 + False + + + + + True + True + never + automatic + in + + + + + + 2 + + + + + True + False + Message sizes + + + 2 + False + + + + + False + True + + + + + True + True + + + True + True + always + automatic + in + + + True + True + + + + + True + False + + + + + + + + True + True + + + + + 2 + + + + + True + False + Diagram + + + 2 + False + + + + + True + True + 1 + + + + + + + False + 5 + Open a pair of logs + False + True + dialog + + + 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 + + + diff --git a/data/dfeet-method.png b/data/dfeet-method.png new file mode 100644 Binary files /dev/null and b/data/dfeet-method.png differ diff --git a/data/dfeet-signal.png b/data/dfeet-signal.png new file mode 100644 Binary files /dev/null and b/data/dfeet-signal.png differ diff --git a/ldd-me-up.sh b/ldd-me-up.sh new file mode 100644 --- /dev/null +++ b/ldd-me-up.sh @@ -0,0 +1,4 @@ +#!/bin/sh +set -e + +ldd $1 | perl -lne 'm{(lib(?:ffi|gmp|pcap)\S+) => (\S+) } and print $2' diff --git a/run-uninstalled.sh b/run-uninstalled.sh new file mode 100644 --- /dev/null +++ b/run-uninstalled.sh @@ -0,0 +1,12 @@ +#!/bin/sh +set -e + +root="$(dirname ${0}})" + +bustle_datadir="${root}" +export bustle_datadir + +bustle="${root}"/dist/build/bustle/bustle + +cabal build 1>&2 +exec $bustle "${@}" diff --git a/tests/Monitor.hs b/tests/Monitor.hs new file mode 100644 --- /dev/null +++ b/tests/Monitor.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Bustle.UI.Recorder + +import Graphics.UI.Gtk +import System.Glib.GError +import Control.Concurrent.MVar + +main = do + args <- initGUI + let filename = case args of + x:xs -> x + _ -> error "gimme a filename" + recorderRun filename Nothing (\_ -> return ()) (\_ -> mainQuit) + mainGUI