File: Monitor.hs

package info (click to toggle)
bustle 0.7.4-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 720 kB
  • sloc: haskell: 3,938; ansic: 939; makefile: 110; sh: 8
file content (131 lines) | stat: -rw-r--r-- 4,124 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
{-
Bustle.Monitor: Haskell binding for pcap-monitor.c
Copyright © 2012 Collabora Ltd.
Copyright © 2018 Will Thompson

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Bustle.Monitor
  (
-- * Types
    Monitor
  , BusType(..)

-- * Methods
  , monitorNew
  , monitorStop

-- * Signals
  , monitorMessageLogged
  , monitorStopped
  )
where

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C

import qualified Data.ByteString as BS

import System.Glib.GObject
import System.Glib.GError
import System.Glib.Signals

import Bustle.Types (Microseconds)

-- Gtk2HS boilerplate
newtype Monitor = Monitor { unMonitor :: ForeignPtr Monitor }
    deriving (Eq, Ord)

mkMonitor :: (ForeignPtr Monitor -> Monitor, FinalizerPtr a)
mkMonitor = (Monitor, objectUnref)

instance GObjectClass Monitor where
    toGObject = GObject . castForeignPtr . unMonitor
    unsafeCastGObject = Monitor . castForeignPtr . unGObject

-- Foreign imports
foreign import ccall "bustle_pcap_monitor_new"
    bustle_pcap_monitor_new :: CInt
                    -> CString
                    -> CString
                    -> Ptr (Ptr ())
                    -> IO (Ptr Monitor)
foreign import ccall "bustle_pcap_monitor_stop"
    bustle_pcap_monitor_stop :: Ptr Monitor
                     -> IO ()

-- Bindings for said imports
data BusType = BusTypeNone
             | BusTypeSystem
             | BusTypeSession
  deriving
    Enum

-- Throws a GError if the file can't be opened, we can't get on the bus, or whatever.
monitorNew :: Either BusType String
           -> FilePath
           -> IO Monitor
monitorNew target filename =
    wrapNewGObject mkMonitor $
      propagateGError $ \gerrorPtr ->
        withAddress $ \c_address ->
          withCString filename $ \c_filename ->
            bustle_pcap_monitor_new c_busType c_address c_filename gerrorPtr
  where
    c_busType = fromIntegral . fromEnum $ case target of
        Left busType  -> busType
        Right _       -> BusTypeNone
    withAddress f = case target of
        Left _        -> f nullPtr
        Right address -> withCString address f

monitorStop :: Monitor
            -> IO ()
monitorStop monitor =
    withForeignPtr (unMonitor monitor) bustle_pcap_monitor_stop

messageLoggedHandler :: (Microseconds -> BS.ByteString -> IO ())
                     -> a
                     -> CLong
                     -> CLong
                     -> Ptr CChar
                     -> CUInt
                     -> IO ()
messageLoggedHandler user _obj 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

stoppedHandler :: (Quark -> Int -> String -> IO ())
             -> a
             -> CUInt
             -> CInt
             -> Ptr CChar
             -> IO ()
stoppedHandler user _obj domain code messagePtr = do
    message <- peekCString messagePtr
    failOnGError $ user domain (fromIntegral code) message

monitorStopped :: Signal Monitor (Quark -> Int -> String -> IO ())
monitorStopped =
    Signal $ \after_ obj user ->
        connectGeneric "stopped" after_ obj $ stoppedHandler user