avahi (empty) → 0.1
raw patch · 7 files changed
+296/−0 lines, 7 filesdep +basedep +dbus-coredep +textsetup-changed
Dependencies added: base, dbus-core, text
Files
- LICENSE +30/−0
- Network/Avahi.hs +11/−0
- Network/Avahi/Announce.hs +33/−0
- Network/Avahi/Browse.hs +86/−0
- Network/Avahi/Common.hs +79/−0
- Setup.hs +2/−0
- avahi.cabal +55/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Ilya Portnov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Ilya Portnov nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Avahi.hs view
@@ -0,0 +1,11 @@++module Network.Avahi+ (module Network.Avahi.Common,+ module Network.Avahi.Browse,+ module Network.Avahi.Announce+ ) where++import Network.Avahi.Common+import Network.Avahi.Browse+import Network.Avahi.Announce+
+ Network/Avahi/Announce.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module Network.Avahi.Announce where++import Data.Int+import Data.Word+import Data.Char+import Data.Maybe+import qualified DBus.Client as C+import DBus.Client.Simple++import Network.Avahi.Common++-- | Announce network service+announce :: Service -- ^ Service to announce+ -> IO ()+announce (Service {..}) = do+ bus <- connectSystem+ server <- proxy bus avahiBus "/"+ [newGroup] <- call server serverInterface "EntryGroupNew" []+ new <- proxy bus avahiBus (fromJust $ fromVariant newGroup)+ let text' = [map (fromIntegral . ord) serviceText] :: [[Word8]]+ call new entryGroupInterface "AddService" [toVariant (-1 :: Int32), -- IF_UNSPEC+ proto2variant serviceProtocol,+ flags_empty,+ toVariant serviceName,+ toVariant serviceType,+ toVariant serviceDomain,+ toVariant serviceHost,+ toVariant servicePort,+ toVariant text']+ call new entryGroupInterface "Commit" []+ return ()+
+ Network/Avahi/Browse.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+module Network.Avahi.Browse+ (browse,+ dispatch+ ) where++import Control.Monad+import Control.Concurrent+import Data.Text (Text)+import Data.Word+import Data.Int+import Data.Char+import qualified DBus.Client as C+import DBus.Message+import DBus.Client.Simple++import Network.Avahi.Common++listenAvahi :: Maybe BusName -> C.MatchRule+listenAvahi name = C.MatchRule {+ C.matchSender = name,+ C.matchDestination = Nothing,+ C.matchPath = Nothing,+ C.matchInterface = Nothing,+ C.matchMember = Nothing }++-- | Browse for specified service+browse :: BrowseQuery -> IO ()+browse (BrowseQuery {..}) = do+ bus <- connectSystem+ server <- proxy bus avahiBus "/"+ [sb] <- call server serverInterface "ServiceBrowserNew" [iface_unspec,+ proto2variant lookupProtocol,+ toVariant lookupServiceName,+ toVariant lookupDomain,+ flags_empty ]+ C.listen bus (listenAvahi $ fromVariant sb) (handler server lookupCallback)+ C.listen bus (listenAvahi $ Just serviceResolver) (handler server lookupCallback)++-- | Dispatch signal and call corresponding function.+dispatch :: [(Text, Signal -> IO b)] -> Signal -> IO ()+dispatch pairs signal = do+ let signame = signalMember signal+ let good = [callback | (name, callback) <- pairs, memberName_ name == signame]+ forM_ good $ \callback ->+ callback signal++handler :: Proxy -> (Service -> IO ()) -> BusName -> Signal -> IO ()+handler server callback busname signal = do+-- print (signalMember signal)+ dispatch [("ItemNew", on_new_item server),+ ("Found", on_service_found callback) ] signal++on_new_item :: Proxy -> Signal -> IO ()+on_new_item server signal = do+ let body = signalBody signal+ [iface,proto,name,stype,domain,flags] = body+-- putStrLn $ "New item: " ++ show body+ call server serverInterface "ServiceResolverNew" [iface,+ proto,+ name,+ stype,+ domain, + proto2variant PROTO_UNSPEC,+ flags_empty ]+ return ()++on_service_found :: (Service -> IO ()) -> Signal -> IO ()+on_service_found callback signal = do+ let body = signalBody signal+ [iface, proto, name, stype, domain, host, aproto, addr, port, text, flags] = body+ service = Service {+ serviceProtocol = variant2proto proto,+ serviceName = fromVariant_ "service name" name,+ serviceType = fromVariant_ "service type" stype,+ serviceDomain = fromVariant_ "domain" domain,+ serviceHost = fromVariant_ "service host" host,+ serviceAddress = fromVariant addr,+ servicePort = fromVariant_ "service port" port,+ serviceText = maybe "" toString (fromVariant text :: Maybe [[Word8]]) }+ putStrLn $ "Service resolved: " ++ show service+ callback service++toString :: [[Word8]] -> String+toString list = concatMap (map (chr . fromIntegral)) list+
+ Network/Avahi/Common.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Avahi.Common where++import Data.Int+import Data.Word+import DBus.Client.Simple++-- | Service specification+data Service = Service {+ serviceProtocol :: InetProtocol,+ serviceName :: String,+ serviceType :: String,+ serviceDomain :: String,+ serviceHost :: String,+ serviceAddress :: Maybe String,+ servicePort :: Word16,+ serviceText :: String }+ deriving (Eq,Show)++-- | Service browsing query+data BrowseQuery = BrowseQuery {+ lookupProtocol :: InetProtocol, -- ^ Protocol to be used for lookup+ lookupServiceName :: String, -- ^ Service name to find+ lookupDomain :: String, -- ^ Domain to search in (usually `local')+ lookupCallback :: Service -> IO () -- ^ Function to be called on found service+ }++-- | Internet protocol specification+data InetProtocol =+ PROTO_UNSPEC -- ^ Unspecified (any) protocol (-1)+ | PROTO_INET -- ^ IPv4 protocol (0)+ | PROTO_INET6 -- ^ IPv6 protocol (1)+ deriving (Eq,Show)++proto2variant :: InetProtocol -> Variant+proto2variant PROTO_UNSPEC = toVariant (-1 :: Int32)+proto2variant PROTO_INET = toVariant (0 :: Int32)+proto2variant PROTO_INET6 = toVariant (1 :: Int32)++variant2proto :: Variant -> InetProtocol+variant2proto x =+ case fromVariant x :: Maybe Int32 of+ Nothing -> error $ "Erroneus PROTO: " ++ show x+ Just (-1) -> PROTO_UNSPEC+ Just 0 -> PROTO_INET+ Just 1 -> PROTO_INET6+ Just y -> error $ "Erroneus PROTO: " ++ show y++forceMaybe :: String -> Maybe a -> a+forceMaybe msg Nothing = error msg+forceMaybe _ (Just x) = x++fromVariant_ :: (IsVariant a) => String -> Variant -> a+fromVariant_ msg x = forceMaybe msg (fromVariant x)++iface_unspec :: Variant+iface_unspec = toVariant (-1 :: Int32)++flags_empty :: Variant+flags_empty = toVariant (0 :: Word32)++avahiBus :: BusName+avahiBus = busName_ "org.freedesktop.Avahi"++hostNameResolver :: BusName+hostNameResolver = busName_ "org.freedesktop.Avahi.HostNameResolver"++serviceResolver :: BusName+serviceResolver = busName_ "org.freedesktop.Avahi.ServiceResolver"++serverInterface :: InterfaceName+serverInterface = interfaceName_ "org.freedesktop.Avahi.Server"++avahiBrowser :: InterfaceName+avahiBrowser = interfaceName_ "org.freedesktop.Avahi.ServiceBrowser"++entryGroupInterface :: InterfaceName+entryGroupInterface = interfaceName_ "org.freedesktop.Avahi.EntryGroup"+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ avahi.cabal view
@@ -0,0 +1,55 @@+-- The name of the package.+Name: avahi++Version: 0.1++Synopsis: Minimal DBus bindings for Avahi daemon (http://avahi.org)++Description: This package provides minimal DBus bindings for Avahi daemon.+ It can be used to browse for network service via Zeroconf protocol+ or to announce a service.++License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Ilya Portnov++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: portnov84@rambler.ru++-- A copyright notice.+-- Copyright: ++Category: Network++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.6+++Library+ -- Modules exported by the library.+ Exposed-modules: Network.Avahi+ Network.Avahi.Common+ Network.Avahi.Browse+ Network.Avahi.Announce+ + -- Packages needed in order to build this package.+ Build-depends: base >= 4 && < 5, dbus-core >= 0.9.2.1,+ text >= 0.11.1+ + -- Modules not exported by this package.+ -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: +