bustle (empty) → 0.4.3
raw patch · 51 files changed
+9308/−0 lines, 51 filesdep +HUnitdep +QuickCheckdep +basesetup-changedbinary-added
Dependencies added: HUnit, QuickCheck, base, bytestring, cairo, containers, dbus, directory, filepath, glib, gtk, mtl, pango, parsec, pcap, process, test-framework, test-framework-hunit, text, time
Files
- Bustle.hs +61/−0
- Bustle/Application/Monad.hs +105/−0
- Bustle/Diagram.hs +520/−0
- Bustle/Loader.hs +88/−0
- Bustle/Loader/OldSkool.hs +256/−0
- Bustle/Loader/Pcap.hs +257/−0
- Bustle/Markup.hs +112/−0
- Bustle/Monitor.hs +109/−0
- Bustle/Noninteractive.hs +89/−0
- Bustle/Regions.hs +214/−0
- Bustle/Renderer.hs +746/−0
- Bustle/StatisticsPane.hs +265/−0
- Bustle/Stats.hs +184/−0
- Bustle/Types.hs +201/−0
- Bustle/UI.hs +591/−0
- Bustle/UI/AboutDialog.hs +70/−0
- Bustle/UI/Canvas.hs +295/−0
- Bustle/UI/DetailsView.hs +145/−0
- Bustle/UI/FilterDialog.hs +122/−0
- Bustle/UI/OpenTwoDialog.hs +93/−0
- Bustle/UI/Recorder.hs +166/−0
- Bustle/UI/Util.hs +45/−0
- Bustle/Upgrade.hs +63/−0
- Bustle/Util.hs +85/−0
- Bustle/VariantFormatter.hs +145/−0
- HACKING +14/−0
- INSTALL +33/−0
- LICENSE +1541/−0
- LICENSE.bundled-libraries +238/−0
- Makefile +71/−0
- NEWS +268/−0
- README +47/−0
- Setup.hs +2/−0
- Test/DumpMessages.hs +15/−0
- Test/PcapCrash.hs +21/−0
- Test/Regions.hs +172/−0
- Test/Renderer.hs +110/−0
- Test/data/log-with-h.bustle binary
- bustle.cabal +177/−0
- bustle.sh +14/−0
- c-sources/bustle-pcap.c +219/−0
- c-sources/config.h +25/−0
- c-sources/pcap-monitor.c +597/−0
- c-sources/pcap-monitor.h +65/−0
- data/bustle.png binary
- data/bustle.ui +620/−0
- data/dfeet-method.png binary
- data/dfeet-signal.png binary
- ldd-me-up.sh +4/−0
- run-uninstalled.sh +12/−0
- tests/Monitor.hs +16/−0
+ Bustle.hs view
@@ -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
+ Bustle/Application/Monad.hs view
@@ -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:+ - <http://www.haskell.org/pipermail/haskell-cafe/2007-July/028501.html>+ -+ - 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
+ Bustle/Diagram.hs view
@@ -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
+ Bustle/Loader.hs view
@@ -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 <none>.+ isDisconnected = sender m == O (OtherName Old.senderWhenDisconnected)++ none bs = not $ or bs+ none3 = none [senderIsBus, destIsBus, isDisconnected]++
+ Bustle/Loader/OldSkool.hs view
@@ -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 "<none>"+ 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
+ Bustle/Loader/Pcap.hs view
@@ -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
+ Bustle/Markup.hs view
@@ -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+ , "</", name, ">"+ ]++b, i :: Markup -> Markup+b = tag "b"+i = tag "i"++a :: String+ -> String+ -> Markup+a href contents =+ Markup $ concat [ "<a href=\"", escapeMarkup href, "\">"+ , escapeMarkup contents+ , "</a>"+ ]++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) ")
+ Bustle/Monitor.hs view
@@ -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
+ Bustle/Noninteractive.hs view
@@ -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
+ Bustle/Regions.hs view
@@ -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
+ Bustle/Renderer.hs view
@@ -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
+ Bustle/StatisticsPane.hs view
@@ -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 <i> 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)
+ Bustle/Stats.hs view
@@ -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)
+ Bustle/Types.hs view
@@ -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
+ Bustle/UI.hs view
@@ -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
+ Bustle/UI/AboutDialog.hs view
@@ -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 <will@willthompson.co.uk>"+ , "Dafydd Harries"+ , "Chris Lamb"+ , "Marc Kleine-Budde"+ , "Cosimo Alfarano"+ , "Sergei Trofimovich"+ , "Alex Merry"+ ]
+ Bustle/UI/Canvas.hs view
@@ -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))
+ Bustle/UI/DetailsView.hs view
@@ -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
+ Bustle/UI/FilterDialog.hs view
@@ -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+ ]
+ Bustle/UI/OpenTwoDialog.hs view
@@ -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
+ Bustle/UI/Recorder.hs view
@@ -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 <b>" ++ show j ++ "</b> 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 <b>0</b> 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
+ Bustle/UI/Util.hs view
@@ -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
+ Bustle/Upgrade.hs view
@@ -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
+ Bustle/Util.hs view
@@ -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
+ Bustle/VariantFormatter.hs view
@@ -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
+ HACKING view
@@ -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 <https://bugs.freedesktop.org/enter_bug.cgi?product=Bustle>.++In new code, try to follow+<https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md>.+Certain authors did not follow it in the past but it seems like a good kind of+thing to aim for.
+ INSTALL view
@@ -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+<http://hackage.haskell.org/platform/>. 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
+ LICENSE view
@@ -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.+++ <one line to give the library's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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.++ <signature of Ty Coon>, 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.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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.++ <signature of Ty Coon>, 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. <http://fsf.org/>+ 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.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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 <http://www.gnu.org/licenses/>.++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:++ <program> Copyright (C) <year> <name of author>+ 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+<http://www.gnu.org/licenses/>.++ 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+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ LICENSE.bundled-libraries view
@@ -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. <http://fsf.org/>+ 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.
+ Makefile view
@@ -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)
+ NEWS view
@@ -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+<http://cgit.freedesktop.org/bustle/>; see open bugs at+<http://wjt.me.uk/bustle/bugs>; file new ones at+<http://wjt.me.uk/bustle/new-bug>. 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.++<div>[[!img bustle-0.2.3.png size="200x143" alt="screenshot of side-by-side session and system bus logs" class="floated screenshot"]]</div>++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:++> <kbd>% bustle-dbus-monitor --session \> session.bustle &<br/>+> % bustle-dbus-monitor --system \> system.bustle &</kbd>++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+ "<none>".++* Compile with new Gtk2HS and GHC 6.10 (Chris Lamb).+++Bustle 0.1 (2008-11-13)+-----------------------++Initial release.++vim: tw=72
+ README view
@@ -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 <http://wjt.me.uk/bustle/>.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/DumpMessages.hs view
@@ -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
+ Test/PcapCrash.hs view
@@ -0,0 +1,21 @@+-- A regression test for <https://bugs.freedesktop.org/show_bug.cgi?id=44714>.+--+-- 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 ()
+ Test/Regions.hs view
@@ -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 ()
+ Test/Renderer.hs view
@@ -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
+ Test/data/log-with-h.bustle view
binary file changed (absent → 39595 bytes)
+ bustle.cabal view
@@ -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 <will.thompson@collabora.co.uk>+Maintainer: Will Thompson <will.thompson@collabora.co.uk>+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
+ bustle.sh view
@@ -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 "${@}"
+ c-sources/bustle-pcap.c view
@@ -0,0 +1,219 @@+/* bustle-pcap.c: utility to log D-Bus traffic to a pcap file.+ *+ * Copyright © 2011 Will Thompson <will@willthompson.co.uk>+ *+ * 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 <string.h>+#include <glib.h>+#include <glib-unix.h>+#include <glib/gprintf.h>+#include <gio/gunixinputstream.h>++#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 <will.thompson@collabora.co.uk>\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 <will.thompson@collabora.co.uk>\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;+}
+ c-sources/config.h view
@@ -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 */
+ c-sources/pcap-monitor.c view
@@ -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 <string.h>+#include <pcap/pcap.h>++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);+}
+ c-sources/pcap-monitor.h view
@@ -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 <glib-object.h>+#include <gio/gio.h>++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 */
+ data/bustle.png view
binary file changed (absent → 1282 bytes)
+ data/bustle.ui view
@@ -0,0 +1,620 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <!-- interface-requires gtk+ 3.0 -->+ <object class="GtkWindow" id="diagramWindow">+ <property name="can_focus">False</property>+ <property name="default_width">900</property>+ <property name="default_height">700</property>+ <child>+ <object class="GtkVBox" id="box1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkMenuBar" id="menubar1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkMenuItem" id="menuitem1">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">_File</property>+ <property name="use_underline">True</property>+ <child type="submenu">+ <object class="GtkMenu" id="menu1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkImageMenuItem" id="new">+ <property name="label">gtk-new</property>+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <accelerator key="n" signal="activate" modifiers="GDK_CONTROL_MASK"/>+ </object>+ </child>+ <child>+ <object class="GtkImageMenuItem" id="open">+ <property name="label">gtk-open</property>+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <accelerator key="o" signal="activate" modifiers="GDK_CONTROL_MASK"/>+ </object>+ </child>+ <child>+ <object class="GtkMenuItem" id="openTwo">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="tooltip_text" translatable="yes">Display two logs—one for the session bus, one for the system bus—side by side.</property>+ <property name="label" translatable="yes">O_pen a pair of logs…</property>+ <property name="use_underline">True</property>+ </object>+ </child>+ <child>+ <object class="GtkImageMenuItem" id="save">+ <property name="label">gtk-save-as</property>+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="sensitive">False</property>+ <property name="can_focus">False</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <accelerator key="s" signal="activate" modifiers="GDK_CONTROL_MASK"/>+ </object>+ </child>+ <child>+ <object class="GtkMenuItem" id="export">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="sensitive">False</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">_Export as PDF…</property>+ <property name="use_underline">True</property>+ <accelerator key="s" signal="activate" modifiers="GDK_SHIFT_MASK | GDK_CONTROL_MASK"/>+ </object>+ </child>+ <child>+ <object class="GtkSeparatorMenuItem" id="separatormenuitem1">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ </object>+ </child>+ <child>+ <object class="GtkImageMenuItem" id="close">+ <property name="label">gtk-close</property>+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="sensitive">True</property>+ <property name="can_focus">False</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <accelerator key="w" signal="activate" modifiers="GDK_CONTROL_MASK"/>+ </object>+ </child>+ </object>+ </child>+ </object>+ </child>+ <child>+ <object class="GtkMenuItem" id="menuitem3">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">_View</property>+ <property name="use_underline">True</property>+ <child type="submenu">+ <object class="GtkMenu" id="menu2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkMenuItem" id="filter">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="sensitive">False</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">_Filter visible services…</property>+ <property name="use_underline">True</property>+ <accelerator key="f" signal="activate" modifiers="GDK_CONTROL_MASK"/>+ </object>+ </child>+ <child>+ <object class="GtkCheckMenuItem" id="statistics">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="sensitive">False</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">_Statistics</property>+ <property name="use_underline">True</property>+ <accelerator key="F9" signal="activate"/>+ </object>+ </child>+ </object>+ </child>+ </object>+ </child>+ <child>+ <object class="GtkMenuItem" id="menuitem4">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">_Help</property>+ <property name="use_underline">True</property>+ <child type="submenu">+ <object class="GtkMenu" id="menu3">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkImageMenuItem" id="about">+ <property name="label">gtk-about</property>+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </object>+ </child>+ </object>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkNotebook" id="diagramOrNot">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="show_tabs">False</property>+ <property name="show_border">False</property>+ <child>+ <object class="GtkAlignment" id="alignment1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xscale">0</property>+ <property name="yscale">0</property>+ <child>+ <object class="GtkVBox" id="box2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="spacing">12</property>+ <child>+ <object class="GtkHButtonBox" id="buttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="spacing">12</property>+ <property name="homogeneous">True</property>+ <property name="layout_style">center</property>+ <child>+ <object class="GtkButton" id="newButton">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_action_appearance">False</property>+ <child>+ <object class="GtkVBox" id="box3">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="spacing">12</property>+ <child>+ <object class="GtkImage" id="image1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="stock">gtk-new</property>+ <property name="icon-size">6</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="balahah">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Record a new log</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="openButton">+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_action_appearance">False</property>+ <child>+ <object class="GtkVBox" id="box4">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="spacing">12</property>+ <child>+ <object class="GtkImage" id="image2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="stock">gtk-open</property>+ <property name="icon-size">6</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="balahah1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Open an existing log</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="label4">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">You may also use the <i>bustle-pcap</i> command-line tool to record logs.</property>+ <property name="use_markup">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ </child>+ <child type="tab">+ <object class="GtkLabel" id="label1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Instructions</property>+ </object>+ <packing>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="label5">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes"><big><b>Waiting for D-Bus traffic; please hold…</b></big></property>+ <property name="use_markup">True</property>+ </object>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ <child type="tab">+ <object class="GtkLabel" id="label2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Please hold</property>+ </object>+ <packing>+ <property name="position">1</property>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ <child>+ <object class="GtkHPaned" id="paned1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <child>+ <object class="GtkNotebook" id="statsBook">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <child>+ <object class="GtkScrolledWindow" id="frequencySW">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">never</property>+ <property name="vscrollbar_policy">automatic</property>+ <property name="shadow_type">in</property>+ <child>+ <placeholder/>+ </child>+ </object>+ </child>+ <child type="tab">+ <object class="GtkLabel" id="label6">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Message frequencies</property>+ </object>+ <packing>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ <child>+ <object class="GtkScrolledWindow" id="durationSW">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">never</property>+ <property name="vscrollbar_policy">automatic</property>+ <property name="shadow_type">in</property>+ <child>+ <placeholder/>+ </child>+ </object>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ <child type="tab">+ <object class="GtkLabel" id="label7">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Method durations</property>+ </object>+ <packing>+ <property name="position">1</property>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ <child>+ <object class="GtkScrolledWindow" id="sizeSW">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">never</property>+ <property name="vscrollbar_policy">automatic</property>+ <property name="shadow_type">in</property>+ <child>+ <placeholder/>+ </child>+ </object>+ <packing>+ <property name="position">2</property>+ </packing>+ </child>+ <child type="tab">+ <object class="GtkLabel" id="label8">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Message sizes</property>+ </object>+ <packing>+ <property name="position">2</property>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="resize">False</property>+ <property name="shrink">True</property>+ </packing>+ </child>+ <child>+ <object class="GtkVPaned" id="contentVPaned">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <child>+ <object class="GtkScrolledWindow" id="scrolledwindow1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="vscrollbar_policy">always</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="shadow_type">in</property>+ <child>+ <object class="GtkLayout" id="diagramLayout">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ </object>+ </child>+ </object>+ <packing>+ <property name="resize">True</property>+ <property name="shrink">False</property>+ </packing>+ </child>+ <child>+ <placeholder/>+ </child>+ </object>+ <packing>+ <property name="resize">True</property>+ <property name="shrink">True</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="position">2</property>+ </packing>+ </child>+ <child type="tab">+ <object class="GtkLabel" id="label3">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Diagram</property>+ </object>+ <packing>+ <property name="position">2</property>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <object class="GtkDialog" id="openTwoDialog">+ <property name="can_focus">False</property>+ <property name="border_width">5</property>+ <property name="title" translatable="yes">Open a pair of logs</property>+ <property name="resizable">False</property>+ <property name="modal">True</property>+ <property name="type_hint">dialog</property>+ <child internal-child="vbox">+ <object class="GtkBox" id="dialog-vbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="orientation">vertical</property>+ <property name="spacing">2</property>+ <child internal-child="action_area">+ <object class="GtkButtonBox" id="dialog-action_area1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="layout_style">end</property>+ <child>+ <object class="GtkButton" id="openTwoCancelButton">+ <property name="label">gtk-cancel</property>+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_action_appearance">False</property>+ <property name="use_stock">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="openTwoOpenButton">+ <property name="label">gtk-open</property>+ <property name="use_action_appearance">False</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_action_appearance">False</property>+ <property name="use_stock">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="pack_type">end</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkTable" id="table1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="n_rows">2</property>+ <property name="n_columns">2</property>+ <property name="column_spacing">6</property>+ <property name="row_spacing">6</property>+ <child>+ <object class="GtkFileChooserButton" id="systemBusChooser">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Select system bus log</property>+ <property name="width_chars">30</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="label44">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">0</property>+ <property name="label" translatable="yes">System bus log:</property>+ </object>+ <packing>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="label55">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">0</property>+ <property name="label" translatable="yes">Session bus log:</property>+ </object>+ </child>+ <child>+ <object class="GtkFileChooserButton" id="sessionBusChooser">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Select session bus log</property>+ <property name="width_chars">30</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="y_options">GTK_EXPAND</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ <action-widgets>+ <action-widget response="-6">openTwoCancelButton</action-widget>+ <action-widget response="-3">openTwoOpenButton</action-widget>+ </action-widgets>+ </object>+</interface>
+ data/dfeet-method.png view
binary file changed (absent → 459 bytes)
+ data/dfeet-signal.png view
binary file changed (absent → 400 bytes)
+ ldd-me-up.sh view
@@ -0,0 +1,4 @@+#!/bin/sh+set -e++ldd $1 | perl -lne 'm{(lib(?:ffi|gmp|pcap)\S+) => (\S+) } and print $2'
+ run-uninstalled.sh view
@@ -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 "${@}"
+ tests/Monitor.hs view
@@ -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