summaryrefslogtreecommitdiff
path: root/Presence/XMPPTypes.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/XMPPTypes.hs')
-rw-r--r--Presence/XMPPTypes.hs86
1 files changed, 84 insertions, 2 deletions
diff --git a/Presence/XMPPTypes.hs b/Presence/XMPPTypes.hs
index e3bbfd16..8af1018c 100644
--- a/Presence/XMPPTypes.hs
+++ b/Presence/XMPPTypes.hs
@@ -2,10 +2,28 @@
2{-# LANGUAGE TypeFamilies #-} 2{-# LANGUAGE TypeFamilies #-}
3module XMPPTypes where 3module XMPPTypes where
4 4
5import Network.Socket (Socket,SockAddr(..)) 5import Network.Socket
6 ( Socket
7 , Family(..)
8 , SockAddr(..)
9 , getAddrInfo
10 , addrCanonName
11 , addrAddress
12 , defaultHints
13 , AddrInfo(..)
14 , AddrInfoFlag(..)
15 )
16import Network.BSD (getHostName)
6import System.IO (Handle) 17import System.IO (Handle)
7import Control.Concurrent.STM (TChan) 18import Control.Concurrent.STM (TChan)
8import Data.ByteString.Lazy.Char8 as L (ByteString,unpack,pack) 19import Data.ByteString.Lazy.Char8 as L
20 ( ByteString
21 , unpack
22 , pack
23 , splitWith
24 , uncons
25 , takeWhile
26 )
9import Text.Show.ByteString as L 27import Text.Show.ByteString as L
10import Data.Binary.Builder as B 28import Data.Binary.Builder as B
11import Data.Binary.Put 29import Data.Binary.Put
@@ -82,4 +100,68 @@ showPeer (RemotePeer addr@(SockAddrInet6 _ _ _ _)) = pack $ stripColon (Prelude.
82 where 100 where
83 (pre,bracket) = break (==']') s 101 (pre,bracket) = break (==']') s
84 102
103is_remote (RemotePeer _) = True
104is_remote _ = False
105
106parseHostNameJID :: ByteString -> IO JID
107parseHostNameJID jid = do
108 let (name,peer_string,rsc) = splitJID jid
109 hints = Just $ defaultHints { addrFlags = [ AI_CANONNAME ] }
110 peer <- do
111 if peer_string=="localhost"
112 then return LocalHost
113 else do
114 -- putStrLn $ "getAddrInfo 3 " ++ Prelude.show ( Just (unpack peer_string))
115 info <- getAddrInfo hints (Just (unpack peer_string)) Nothing -- (Just "xmpp-server")
116 let info0 = head info
117 cname = addrCanonName info0
118 if cname==Just "localhost"
119 then return LocalHost
120 else do
121 self <- getHostName
122 return $ if Just self==cname
123 then LocalHost
124 else RemotePeer (addrAddress info0)
125 return $ JID name peer rsc
126
127splitJID :: ByteString -> (Maybe ByteString,ByteString,Maybe ByteString)
128splitJID bjid =
129 let xs = L.splitWith (=='@') bjid
130 ys = L.splitWith (=='/') (last xs)
131 server = head ys
132 name
133 = case xs of
134 (n:s:_) -> Just n
135 (s:_) -> Nothing
136 rsrc = case ys of
137 (s:_:_) -> Just $ last ys
138 _ -> Nothing
139 in (name,server,rsrc)
140
141strip_brackets s =
142 case L.uncons s of
143 Just ('[',t) -> L.takeWhile (/=']') t
144 _ -> s
145
146
147parseAddressJID :: ByteString -> IO JID
148parseAddressJID jid = do
149 let (name,peer_string,rsc) = splitJID jid
150 hints = Just $ defaultHints { addrFlags = [ {- AI_NUMERICHOST, -} AI_CANONNAME ] }
151 peer_string' = unpack . strip_brackets $ peer_string
152 peer <- do
153 -- putStrLn $ "getAddrInfo 2 " ++ Prelude.show ( Just (unpack peer_string))
154 info <- getAddrInfo hints (Just peer_string') Nothing -- (Just "xmpp-server")
155 let info0 = head info
156 return . RemotePeer . addrAddress $ info0
157 return $ JID name peer rsc
158
159peerAddr :: Peer -> SockAddr
160peerAddr (RemotePeer addr) = addr
161-- peerAddr LocalHost = throw exception
162
163socketFamily (SockAddrInet _ _) = AF_INET
164socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6
165socketFamily (SockAddrUnix _) = AF_UNIX
166
85 167