d-bus 0.1.3.4 → 0.1.4

raw patch · 5 files changed

+69/−27 lines, 5 files

Files

• d-bus.cabal +1/−1
• src/DBus.hs +18/−9
• src/DBus/Auth.hs +7/−0
• src/DBus/MainLoop.hs +32/−14
• src/DBus/Transport.hs +11/−3

@@ -1,5 +1,5 @@ name:                d-bus-version:             0.1.3.4+version:             0.1.4 synopsis:            Permissively licensed D-Bus client library description:         This library uses modern extensions to the Haskell type system                      (including GADTs, DataKinds and TypeFamilies) and the

@@ -4,6 +4,7 @@       DBusConnection     , ConnectionType(..)     , connectClient+    , connectClientWithAuth     , makeServer     , connectBus     , MethodCallHandler@@ -104,15 +105,9 @@     , def     ) where --- $types------ DBus has it's own type system, described here--- <https://dbus.freedesktop.org/doc/dbus-specification.html#type-system>------ Types are divided into basic types, represented in this library by--- 'DBusSimpleType', and composite types, represented by 'DBusType'. Only simple--- types can be the keys in a dictionary+import qualified Data.ByteString as BS +import DBus.Auth import DBus.Introspect import DBus.MainLoop import DBus.Message@@ -129,6 +124,20 @@ -- | Ignore all incoming messages/signals ignore _ _ _ = return () --- | Connect to a message bus as a client++-- | Connect to a message bus as a client, using the @EXTERNAL@ auth mechanism. connectClient :: ConnectionType -> IO DBusConnection connectClient bus = connectBus bus ignore ignore++-- | Connect to a message bus as a client with a custom auth mechanism.+connectClientWithAuth :: ConnectionType -> SASL BS.ByteString -> IO DBusConnection+connectClientWithAuth bus auth = connectBusWithAuth bus auth ignore ignore++-- $types+--+-- DBus has it's own type system, described here+-- <https://dbus.freedesktop.org/doc/dbus-specification.html#type-system>+--+-- Types are divided into basic types, represented in this library by+-- 'DBusSimpleType', and composite types, represented by 'DBusType'. Only simple+-- types can be the keys in a dictionary

@@ -187,3 +187,10 @@     ok <- expectOK     saslSend CMBegin     return ok++anonymous :: SASL BS.ByteString+anonymous = do+    saslSend (CMAuth "ANONYMOUS" "")+    ok <- expectOK+    saslSend CMBegin+    return ok

@@ -222,28 +222,39 @@                               -- DBUS_SESSION_BUS_ADDRESS                     | Address String -- ^ The bus at the give addresss -type MethodCallHandler = ( DBusConnection -- ^ Connection that the call was+type MethodCallHandler = DBusConnection -- ^ Connection that the call was                                           -- received from. Should be used to                                           -- return the result or error-                           -> MessageHeader-                           -> [SomeDBusValue]-                           -> IO ())+                       -> MessageHeader+                       -> [SomeDBusValue]+                       -> IO ()  type SignalHandler = ( DBusConnection                        -> MessageHeader                        -> [SomeDBusValue]                        -> IO ()) --- | General way to connect to a message bus. Takes two callback functions:------ * A 'MethodCallHandler' that is invoked when a method call is received.+-- | General way to connect to a message bus, see 'connectBusWithAuth'. ----- * A SignalHandler that is invoked when a Mesage is received:+-- Uses the @EXTERNAL@ authentication mechanism. connectBus :: ConnectionType -- ^ Bus to connect to            -> MethodCallHandler -- ^ Handler for incoming method calls            -> SignalHandler  -- ^ Handler for incoming signals            -> IO DBusConnection-connectBus transport handleCalls handleSignals = do+connectBus transport = connectBusWithAuth transport external++-- | General way to connect to a message bus, with a custom authentication+-- method. Takes two callback functions:+--+-- * A 'MethodCallHandler' that is invoked when a method call is received.+--+-- * A SignalHandler that is invoked when a Mesage is received:+connectBusWithAuth :: ConnectionType -- ^ Bus to connect to+                   -> SASL BS.ByteString -- ^ The authentication mechanism+                   -> MethodCallHandler -- ^ Handler for incoming method calls+                   -> SignalHandler  -- ^ Handler for incoming signals+                   -> IO DBusConnection+connectBusWithAuth transport auth handleCalls handleSignals = do     addressString <- case transport of         Session -> getEnv "DBUS_SESSION_BUS_ADDRESS"         System -> do@@ -269,7 +280,7 @@                   bs <- BS.hGetLine h                   debugM "DBus.Sasl" $ "S: " ++ show bs                   return bs)-            external+            auth     serialCounter <- newTVarIO 1     let getSerial = do             s <- readTVar serialCounter@@ -320,11 +331,18 @@         debugM "DBus" $ "Done"         return conn{dBusConnectionName = connName} --- | Create a simple server that exports @Objects@ and ignores all incoming signals+-- | Create a simple server that exports @Objects@ and ignores all incoming signals.+--+-- Use the default @EXTERNAL@ authentication mechanism (see 'makeServerWithAuth'). makeServer :: ConnectionType -> Objects -> IO DBusConnection-makeServer transport objs = do-    connectBus transport (objectRoot (addIntrospectable objs))-                         (\_ _ _ -> return ())+makeServer transport = makeServerWithAuth transport external++-- | Create a simple server with a custom bus authentication mechanism that+-- exports @Objects@ and ignores all incoming signals.+makeServerWithAuth :: ConnectionType -> SASL BS.ByteString -> Objects -> IO DBusConnection+makeServerWithAuth transport auth objs = do+    connectBusWithAuth transport auth (objectRoot (addIntrospectable objs))+                                      (\_ _ _ -> return ())  type Handler = DBusConnection -> MessageHeader -> [SomeDBusValue] -> IO () 

@@ -126,9 +126,9 @@             Nothing -> AF_UNSPEC             Just TCPFamilyIPv4 -> AF_INET             Just TCPFamilyIPv6 -> AF_INET6-    addrInfo <- getAddrInfo (Just $ defaultHints{ addrFamily = family} )-                            (Just . Text.unpack . Text.decodeUtf8 $ host)-                            Nothing+    addrInfo <- withPort port <$> getAddrInfo (Just $ defaultHints{ addrFamily = family} )+                                              (Just . Text.unpack . Text.decodeUtf8 $ host)+                                              Nothing     case addrInfo of         (ai : _) -> Ex.catch             (Ex.bracketOnError (socket (addrFamily ai)@@ -143,6 +143,14 @@                        Ex.throwIO $ CouldNotConnect "Could not connect")          _ -> Ex.throwIO $ CouldNotConnect "Host not found"+  where+    withPort p = fmap (addrInfoWithPort $ fromIntegral p)+    addrInfoWithPort p ai = ai { addrAddress = sockAddrWithPort p (addrAddress ai) }++    sockAddrWithPort p (SockAddrInet _ addr) = SockAddrInet p addr+    sockAddrWithPort p (SockAddrInet6 _ info addr sid) = SockAddrInet6 p info addr sid+    sockAddrWithPort _ x = x+ connectTcp _ = Ex.throwIO $ CouldNotConnect "TCP method does not specify necessary data"  connectUnix :: UDS -> IO Socket