diff options
Diffstat (limited to 'dht')
-rw-r--r-- | dht/Presence/Presence.hs | 32 | ||||
-rw-r--r-- | dht/ToxManager.hs | 9 | ||||
-rw-r--r-- | dht/examples/dhtd.hs | 14 | ||||
-rw-r--r-- | dht/src/Data/Tox/Msg.hs | 2 | ||||
-rw-r--r-- | dht/src/Network/Tox/NodeId.hs | 72 | ||||
-rwxr-xr-x | dht/vnet/screen-shell.sh | 2 |
6 files changed, 92 insertions, 39 deletions
diff --git a/dht/Presence/Presence.hs b/dht/Presence/Presence.hs index a09a517d..dcc76c5b 100644 --- a/dht/Presence/Presence.hs +++ b/dht/Presence/Presence.hs | |||
@@ -251,7 +251,11 @@ chooseResourceName state k (Remote addr) clientsNameForMe desired = do | |||
251 | flgs <- atomically $ newTVar 0 | 251 | flgs <- atomically $ newTVar 0 |
252 | profile <- fmap (fromMaybe ".") | 252 | profile <- fmap (fromMaybe ".") |
253 | $ forM ((,) <$> clientsNameForMe <*> toxManager state) $ \(wanted_profile0,toxman) -> | 253 | $ forM ((,) <$> clientsNameForMe <*> toxManager state) $ \(wanted_profile0,toxman) -> |
254 | case Text.splitAt 43 wanted_profile0 of | 254 | case splitLast4 wanted_profile0 of |
255 | ("*",".tox") -> do | ||
256 | dput XMisc $ "TODO: Match single tox key profile or generate first." | ||
257 | -- TODO: Match single tox key profile or generate first. | ||
258 | _todo | ||
255 | (pub,".tox") -> do | 259 | (pub,".tox") -> do |
256 | cdir <- ConfigFiles.configPath (L.fromChunks [Text.encodeUtf8 user]) "." "" | 260 | cdir <- ConfigFiles.configPath (L.fromChunks [Text.encodeUtf8 user]) "." "" |
257 | #if !MIN_VERSION_directory(1,2,5) | 261 | #if !MIN_VERSION_directory(1,2,5) |
@@ -274,10 +278,6 @@ chooseResourceName state k (Remote addr) clientsNameForMe desired = do | |||
274 | -- fall back to the Unix account login. | 278 | -- fall back to the Unix account login. |
275 | dput XMisc "failed to find tox secret" | 279 | dput XMisc "failed to find tox secret" |
276 | return "." | 280 | return "." |
277 | ("*.tox","") -> do | ||
278 | dput XMisc $ "TODO: Match single tox key profile or generate first." | ||
279 | -- TODO: Match single tox key profile or generate first. | ||
280 | _todo | ||
281 | _ -> return "." | 281 | _ -> return "." |
282 | let client = ClientState { clientResource = maybe "fallback" id mtty | 282 | let client = ClientState { clientResource = maybe "fallback" id mtty |
283 | , clientUser = user | 283 | , clientUser = user |
@@ -361,7 +361,7 @@ rosterGetStuff what state k = forClient state k (return []) | |||
361 | PresenceState { server = sv } -> do | 361 | PresenceState { server = sv } -> do |
362 | let conns = manager state $ clientProfile client | 362 | let conns = manager state $ clientProfile client |
363 | -- Grok peers to associate with from the roster: | 363 | -- Grok peers to associate with from the roster: |
364 | let isTox = do (me , ".tox") <- Just $ Text.splitAt 43 (clientProfile client) | 364 | let isTox = do (me , ".tox") <- Just $ splitLast4 (clientProfile client) |
365 | return me | 365 | return me |
366 | noToxUsers (u,h,r) | 366 | noToxUsers (u,h,r) |
367 | | Text.isSuffixOf ".tox" h = unsplitJID (Nothing,h,r) | 367 | | Text.isSuffixOf ".tox" h = unsplitJID (Nothing,h,r) |
@@ -373,8 +373,8 @@ rosterGetStuff what state k = forClient state k (return []) | |||
373 | let policySetter = fromMaybe (Connection.setPolicy conns host) $ do | 373 | let policySetter = fromMaybe (Connection.setPolicy conns host) $ do |
374 | isTox | 374 | isTox |
375 | toxman <- toxManager state | 375 | toxman <- toxManager state |
376 | (them, ".tox") <- Just $ Text.splitAt 43 host | 376 | (them, ".tox") <- Just $ splitLast4 host |
377 | meid <- readMaybe $ Text.unpack $ Text.take 43 (clientProfile client) | 377 | meid <- readMaybe $ Text.unpack $ Text.dropEnd 4 (clientProfile client) |
378 | themid <- readMaybe $ Text.unpack them | 378 | themid <- readMaybe $ Text.unpack them |
379 | return $ Connection.setPolicy (toxConnections toxman) | 379 | return $ Connection.setPolicy (toxConnections toxman) |
380 | (ToxContact meid themid) | 380 | (ToxContact meid themid) |
@@ -547,7 +547,7 @@ eofConn state saddr cdta = do | |||
547 | Right (k,_) -> do | 547 | Right (k,_) -> do |
548 | forClient state k (return ()) $ \client -> do | 548 | forClient state k (return ()) $ \client -> do |
549 | forM_ (toxManager state) $ \toxman -> do | 549 | forM_ (toxManager state) $ \toxman -> do |
550 | case Text.splitAt 43 (clientProfile client) of | 550 | case splitLast4 (clientProfile client) of |
551 | (pub,".tox") -> deactivateAccount toxman k (clientProfile client) | 551 | (pub,".tox") -> deactivateAccount toxman k (clientProfile client) |
552 | _ -> return () | 552 | _ -> return () |
553 | stanza <- makePresenceStanza "jabber:server" Nothing Offline | 553 | stanza <- makePresenceStanza "jabber:server" Nothing Offline |
@@ -665,12 +665,12 @@ deliverMessage state fail msg = | |||
665 | -- In case the client sends us a lower-cased version of the base64 | 665 | -- In case the client sends us a lower-cased version of the base64 |
666 | -- tox key hostname, we resolve it by comparing it with roster entries. | 666 | -- tox key hostname, we resolve it by comparing it with roster entries. |
667 | xs <- getBuddiesAndSolicited state (clientProfile client) $ \case | 667 | xs <- getBuddiesAndSolicited state (clientProfile client) $ \case |
668 | rh | (_,".tox") <- Text.splitAt 43 rh | 668 | rh | (_,".tox") <- splitLast4 rh |
669 | , Text.toLower rh == Text.toLower th | 669 | , Text.toLower rh == Text.toLower th |
670 | -> return True | 670 | -> return True |
671 | _ -> return False | 671 | _ -> return False |
672 | fmap join $ forM (listToMaybe xs) $ \(_,rmu,_,h) -> do | 672 | fmap join $ forM (listToMaybe xs) $ \(_,rmu,_,h) -> do |
673 | let (them,_) = Text.splitAt 43 h | 673 | let (them,_) = splitLast4 h |
674 | maddr <- resolveToxPeer toxman me them | 674 | maddr <- resolveToxPeer toxman me them |
675 | let to' = unsplitJID (mu,h,rsc) | 675 | let to' = unsplitJID (mu,h,rsc) |
676 | return $ fmap (to',) maddr | 676 | return $ fmap (to',) maddr |
@@ -1168,17 +1168,21 @@ clientSubscriptionRequest state fail k stanza chan = do | |||
1168 | (connChan con) | 1168 | (connChan con) |
1169 | let policySetter = fromMaybe (Connection.setPolicy conns h) $ do | 1169 | let policySetter = fromMaybe (Connection.setPolicy conns h) $ do |
1170 | (toxman,_,_) <- weAreTox state client h | 1170 | (toxman,_,_) <- weAreTox state client h |
1171 | meid <- readMaybe $ Text.unpack $ Text.take 43 (clientProfile client) | 1171 | meid <- readMaybe $ Text.unpack $ case splitLast4 (clientProfile client) of |
1172 | (h,".tox") -> h | ||
1173 | _ -> clientProfile client | ||
1172 | themid <- readMaybe $ Text.unpack h | 1174 | themid <- readMaybe $ Text.unpack h |
1173 | Just $ Connection.setPolicy (toxConnections toxman) (ToxContact meid themid) | 1175 | Just $ Connection.setPolicy (toxConnections toxman) (ToxContact meid themid) |
1174 | -- Add peer if we are not already associated ... | 1176 | -- Add peer if we are not already associated ... |
1175 | policySetter Connection.TryingToConnect | 1177 | policySetter Connection.TryingToConnect |
1176 | 1178 | ||
1179 | splitLast4 h = Text.splitAt (Text.length h - 4) h | ||
1180 | |||
1177 | weAreTox :: PresenceState stat -> ClientState -> Text -> Maybe (ToxManager ClientAddress,Text{- me -},Text{- them -}) | 1181 | weAreTox :: PresenceState stat -> ClientState -> Text -> Maybe (ToxManager ClientAddress,Text{- me -},Text{- them -}) |
1178 | weAreTox state client h = do | 1182 | weAreTox state client h = do |
1179 | toxman <- toxManager state | 1183 | toxman <- toxManager state |
1180 | (me , ".tox") <- Just $ Text.splitAt 43 (clientProfile client) | 1184 | (me , ".tox") <- Just $ splitLast4 (clientProfile client) |
1181 | (them, ".tox") <- Just $ Text.splitAt 43 h | 1185 | (them, ".tox") <- Just $ splitLast4 h |
1182 | return (toxman,me,them) | 1186 | return (toxman,me,them) |
1183 | 1187 | ||
1184 | resolvedFromRoster | 1188 | resolvedFromRoster |
diff --git a/dht/ToxManager.hs b/dht/ToxManager.hs index dceb9210..51567b27 100644 --- a/dht/ToxManager.hs +++ b/dht/ToxManager.hs | |||
@@ -89,6 +89,13 @@ stringToKey_ s = let (xs,ys) = break (==':') s | |||
89 | them <- readMaybe (drop 1 ys) | 89 | them <- readMaybe (drop 1 ys) |
90 | return $ ToxContact me them | 90 | return $ ToxContact me them |
91 | 91 | ||
92 | dropExtension :: T.Text -> T.Text | ||
93 | dropExtension pubname = case T.dropWhileEnd (/='.') pubname of | ||
94 | x | T.null x -> pubname | ||
95 | | otherwise -> case T.dropEnd 1 pubname of | ||
96 | y | T.null y -> pubname -- Avoid changing "." to empty string. | ||
97 | | otherwise -> y | ||
98 | |||
92 | -- | | 99 | -- | |
93 | -- | 100 | -- |
94 | -- These hooks will be invoked in order to connect to *.tox hosts in a user's | 101 | -- These hooks will be invoked in order to connect to *.tox hosts in a user's |
@@ -139,7 +146,7 @@ toxman ssvar announcer toxbkts tox presence = ToxManager | |||
139 | , deactivateAccount = \k pubname -> do | 146 | , deactivateAccount = \k pubname -> do |
140 | dput XMan $ "toxman DECTIVATE (todo) 1 " ++ show pubname | 147 | dput XMan $ "toxman DECTIVATE (todo) 1 " ++ show pubname |
141 | let ContactInfo{ accounts } = Tox.toxContactInfo tox | 148 | let ContactInfo{ accounts } = Tox.toxContactInfo tox |
142 | mpubid = readMaybe $ T.unpack $ T.take 43 pubname | 149 | mpubid = readMaybe $ T.unpack $ dropExtension pubname |
143 | bStopped <- fmap (fromMaybe Nothing) $ atomically $ do | 150 | bStopped <- fmap (fromMaybe Nothing) $ atomically $ do |
144 | forM mpubid $ \pubid -> do | 151 | forM mpubid $ \pubid -> do |
145 | refs <- do | 152 | refs <- do |
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs index 5f0eead8..3e9f8ff5 100644 --- a/dht/examples/dhtd.hs +++ b/dht/examples/dhtd.hs | |||
@@ -1302,21 +1302,27 @@ onNewToxSession sv ssvar invc ContactInfo{accounts} addrTox netcrypto = do | |||
1302 | return () | 1302 | return () |
1303 | 1303 | ||
1304 | selectManager :: Maybe (t -> ToxManager clientAddress) -> Manager Tcp.TCPStatus T.Text -> T.Text -> Manager Pending T.Text | 1304 | selectManager :: Maybe (t -> ToxManager clientAddress) -> Manager Tcp.TCPStatus T.Text -> T.Text -> Manager Pending T.Text |
1305 | selectManager mtman tcp profile = case T.splitAt 43 profile of | 1305 | selectManager mtman tcp profile = case T.splitAt (T.length profile - 4) profile of |
1306 | (k,".tox") | Just tman <- mtman | 1306 | (k,".tox") | Just tman <- mtman |
1307 | -> let -- The following error call is safe because the toxConnections field | 1307 | -> let -- The following error call is safe because the toxConnections field |
1308 | -- does not make use of the PresenceState passed to tman. | 1308 | -- does not make use of the PresenceState passed to tman. |
1309 | tox = toxConnections $ tman $ error "PresenseState" | 1309 | tox = toxConnections $ tman $ error "PresenseState" |
1310 | tkey them = do | 1310 | tkey them = do |
1311 | me <- readMaybe (T.unpack k) | 1311 | me <- readMaybe (T.unpack k) |
1312 | them <- case T.splitAt 43 them of | 1312 | them <- case T.splitAt 52 them of |
1313 | (them0,".tox") -> readMaybe (T.unpack them0) | 1313 | (them0,".tox") -> readMaybe (T.unpack them0) |
1314 | _ -> Nothing | 1314 | _ -> case T.splitAt 43 them of |
1315 | (them0,".tox") -> readMaybe (T.unpack them0) | ||
1316 | _ -> Nothing | ||
1315 | return (Tox.ToxContact me them) | 1317 | return (Tox.ToxContact me them) |
1316 | in Manager | 1318 | in Manager |
1317 | { resolvePeer = \themhost -> do | 1319 | { resolvePeer = \themhost -> do |
1318 | r <- fromMaybe (return []) $ do | 1320 | r <- fromMaybe (return []) $ do |
1319 | (themT,".tox") <- Just $ T.splitAt 43 themhost | 1321 | themT <- case T.splitAt 52 themhost of |
1322 | (ts,".tox") -> Just ts | ||
1323 | _ -> case T.splitAt 43 themhost of | ||
1324 | (ts,".tox") -> Just ts | ||
1325 | _ -> Nothing | ||
1320 | them <- readMaybe $ T.unpack themT | 1326 | them <- readMaybe $ T.unpack themT |
1321 | me <- readMaybe $ T.unpack k | 1327 | me <- readMaybe $ T.unpack k |
1322 | let contact = Tox.ToxContact me them | 1328 | let contact = Tox.ToxContact me them |
diff --git a/dht/src/Data/Tox/Msg.hs b/dht/src/Data/Tox/Msg.hs index 8819faa7..2951193d 100644 --- a/dht/src/Data/Tox/Msg.hs +++ b/dht/src/Data/Tox/Msg.hs | |||
@@ -260,7 +260,7 @@ instance Read ChatID where | |||
260 | | otherwise = [] | 260 | | otherwise = [] |
261 | 261 | ||
262 | instance Show ChatID where | 262 | instance Show ChatID where |
263 | show (ChatID ed) = showToken32 ed | 263 | show (ChatID ed) = show64Token32 ed |
264 | 264 | ||
265 | data InviteType = GroupInvite { groupName :: Text } | 265 | data InviteType = GroupInvite { groupName :: Text } |
266 | | AcceptedInvite | 266 | | AcceptedInvite |
diff --git a/dht/src/Network/Tox/NodeId.hs b/dht/src/Network/Tox/NodeId.hs index e0169199..311095ec 100644 --- a/dht/src/Network/Tox/NodeId.hs +++ b/dht/src/Network/Tox/NodeId.hs | |||
@@ -38,7 +38,8 @@ module Network.Tox.NodeId | |||
38 | , ToxContact(..) | 38 | , ToxContact(..) |
39 | , ToxProgress(..) | 39 | , ToxProgress(..) |
40 | , parseToken32 | 40 | , parseToken32 |
41 | , showToken32 | 41 | , show64Token32 |
42 | , show32Token32 | ||
42 | , nodeInfoFromJSON | 43 | , nodeInfoFromJSON |
43 | ) where | 44 | ) where |
44 | 45 | ||
@@ -61,6 +62,7 @@ import qualified Data.ByteArray as BA | |||
61 | import qualified Data.ByteString as B | 62 | import qualified Data.ByteString as B |
62 | ;import Data.ByteString (ByteString) | 63 | ;import Data.ByteString (ByteString) |
63 | import qualified Data.ByteString.Base16 as Base16 | 64 | import qualified Data.ByteString.Base16 as Base16 |
65 | import qualified Data.ByteString.Base32.Z as Base32 | ||
64 | import qualified Data.ByteString.Base64 as Base64 | 66 | import qualified Data.ByteString.Base64 as Base64 |
65 | import qualified Data.ByteString.Char8 as C8 | 67 | import qualified Data.ByteString.Char8 as C8 |
66 | import Data.Char | 68 | import Data.Char |
@@ -173,22 +175,33 @@ nmtoken64 _ c = c | |||
173 | parseToken32 :: String -> Either String ByteString | 175 | parseToken32 :: String -> Either String ByteString |
174 | parseToken32 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) | 176 | parseToken32 str = fmap (BA.drop 1) $ Base64.decode $ C8.pack $ 'A':map (nmtoken64 False) (take 43 str) |
175 | 177 | ||
178 | -- | Parse 52-digit z-base32 token into 32-byte bytestring. | ||
179 | parse32Token32 :: String -> Either String ByteString | ||
180 | parse32Token32 str = fmap (BA.drop 1) $ Base32.decode $ C8.pack $ 'y':map (fixupDigit32 . toLower) (take 52 str) | ||
181 | |||
176 | -- | Encode 32-byte bytestring as 43-digit base64 token. | 182 | -- | Encode 32-byte bytestring as 43-digit base64 token. |
177 | showToken32 :: ByteArrayAccess bin => bin -> String | 183 | show64Token32 :: ByteArrayAccess bin => bin -> String |
178 | showToken32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs | 184 | show64Token32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base64.encode $ BA.cons 0 $ BA.convert bs |
185 | |||
186 | -- | Encode 32-byte bytestring as 52-digit z-base32 token. | ||
187 | show32Token32 :: ByteArrayAccess bin => bin -> String | ||
188 | show32Token32 bs = map (nmtoken64 True) $ C8.unpack $ BA.drop 1 $ Base32.encode $ BA.cons 0 $ BA.convert bs | ||
179 | 189 | ||
180 | instance Read NodeId where | 190 | instance Read NodeId where |
181 | readsPrec _ str | 191 | readsPrec _ str |
182 | | (bs,_) <- Base16.decode (C8.pack $ take 64 str) | 192 | | (bs,_) <- Base16.decode (C8.pack $ take 64 str) |
183 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | 193 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 |
184 | = [ (key2id pub, drop (2 * B.length bs) str) ] | 194 | = [ (key2id pub, drop (2 * B.length bs) str) ] |
195 | | Right bs <- parse32Token32 str | ||
196 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | ||
197 | = [ (key2id pub, drop 52 str) ] | ||
185 | | Right bs <- parseToken32 str | 198 | | Right bs <- parseToken32 str |
186 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 | 199 | , CryptoPassed pub <- publicKey bs -- B.length bs == 32 |
187 | = [ (key2id pub, drop 43 str) ] | 200 | = [ (key2id pub, drop 43 str) ] |
188 | | otherwise = [] | 201 | | otherwise = [] |
189 | 202 | ||
190 | instance Show NodeId where | 203 | instance Show NodeId where |
191 | show nid = showToken32 $ id2key nid | 204 | show nid = show32Token32 $ id2key nid |
192 | 205 | ||
193 | instance S.Serialize NodeId where | 206 | instance S.Serialize NodeId where |
194 | get = key2id <$> getPublicKey | 207 | get = key2id <$> getPublicKey |
@@ -266,8 +279,12 @@ nodeInfoFromJSON prefer4 (JSON.Object v) = do | |||
266 | <|> maybe empty (return . IPv6) (ip6str >>= readMaybe) | 279 | <|> maybe empty (return . IPv6) (ip6str >>= readMaybe) |
267 | else maybe empty (return . IPv6) (ip6str >>= readMaybe) | 280 | else maybe empty (return . IPv6) (ip6str >>= readMaybe) |
268 | <|> maybe empty (return . IPv4) (ip4str >>= readMaybe) | 281 | <|> maybe empty (return . IPv4) (ip4str >>= readMaybe) |
269 | let (bs,_) = Base16.decode (C8.pack nidstr) | 282 | let nidbs = C8.pack nidstr |
270 | enid = Base64.decode (C8.pack $ 'A' : map (nmtoken64 False) nidstr) | 283 | (bs,_) = Base16.decode nidbs |
284 | enid = case C8.length nidbs of | ||
285 | 43 -> Base64.decode (C8.pack $ 'A' : map (nmtoken64 False) nidstr) | ||
286 | 52 -> Base32.decode (C8.pack $ 'y' : map (fixupDigit32 . toLower) nidstr) | ||
287 | _ -> Left "Wrong size of node-id." | ||
271 | idbs <- (guard (B.length bs == 32) >> return bs) | 288 | idbs <- (guard (B.length bs == 32) >> return bs) |
272 | <|> either fail (return . B.drop 1) enid | 289 | <|> either fail (return . B.drop 1) enid |
273 | return $ NodeInfo (bs2id idbs) ip (fromIntegral (portnum :: Word16)) | 290 | return $ NodeInfo (bs2id idbs) ip (fromIntegral (portnum :: Word16)) |
@@ -313,6 +330,21 @@ b64digit '-' = True | |||
313 | b64digit '/' = True | 330 | b64digit '/' = True |
314 | b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z') | 331 | b64digit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'z') || ( 'A' <= c && c <= 'Z') |
315 | 332 | ||
333 | zb32digit :: Char -> Bool | ||
334 | zb32digit '1' = True | ||
335 | zb32digit c = or [ '3' <= c && c <= '9' | ||
336 | , 'a' <= c && c <= 'k' | ||
337 | , 'm' <= c && c <= 'u' | ||
338 | , 'w' <= c && c <= 'z' | ||
339 | ] | ||
340 | |||
341 | -- Apply substitutions for mistaken z-base32 digits. | ||
342 | fixupDigit32 :: Char -> Char | ||
343 | fixupDigit32 'l' = '1' | ||
344 | fixupDigit32 '2' = 'z' | ||
345 | fixupDigit32 'v' = 'u' | ||
346 | fixupDigit32 c = c | ||
347 | |||
316 | ip_w_port :: Int -> RP.ReadP (IP, PortNumber) | 348 | ip_w_port :: Int -> RP.ReadP (IP, PortNumber) |
317 | ip_w_port i = do | 349 | ip_w_port i = do |
318 | ip <- RP.between (RP.char '[') (RP.char ']') | 350 | ip <- RP.between (RP.char '[') (RP.char ']') |
@@ -326,19 +358,23 @@ ip_w_port i = do | |||
326 | instance Read NodeInfo where | 358 | instance Read NodeInfo where |
327 | readsPrec i = RP.readP_to_S $ do | 359 | readsPrec i = RP.readP_to_S $ do |
328 | RP.skipSpaces | 360 | RP.skipSpaces |
329 | let n = 43 -- characters in node id. | 361 | let parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')')) |
330 | parseAddr = RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')')) | ||
331 | RP.+++ RP.munch (\c -> not (isSpace c) && not (c `elem` ("{}()"::[Char]))) | 362 | RP.+++ RP.munch (\c -> not (isSpace c) && not (c `elem` ("{}()"::[Char]))) |
332 | nodeidAt = do (is64,hexhash) <- | 363 | nodeidAt = do (is64,hexhash) <- foldr1 (RP.+++) |
333 | fmap (True,) (sequence $ replicate n (RP.satisfy b64digit)) | 364 | [ fmap (32,) (sequence $ replicate 52 (RP.satisfy zb32digit)) |
334 | RP.+++ fmap (False,) (sequence $ replicate 64 (RP.satisfy isHexDigit)) | 365 | , fmap (64,) (sequence $ replicate 43 (RP.satisfy b64digit)) |
366 | , fmap (16,) (sequence $ replicate 64 (RP.satisfy isHexDigit)) | ||
367 | ] | ||
335 | RP.char '@' RP.+++ RP.satisfy isSpace | 368 | RP.char '@' RP.+++ RP.satisfy isSpace |
336 | addrstr <- parseAddr | 369 | addrstr <- parseAddr |
337 | nid <- if is64 | 370 | nid <- case is64 of |
338 | then case Base64.decode $ C8.pack $ 'A' : map (nmtoken64 False) hexhash of | 371 | 32 -> case Base32.decode $ C8.pack $ 'y' : map (fixupDigit32 . toLower) hexhash of |
372 | Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs) | ||
373 | _ -> fail "Bad node id." | ||
374 | 64 -> case Base64.decode $ C8.pack $ 'A' : map (nmtoken64 False) hexhash of | ||
339 | Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs) | 375 | Right bs | B.length bs - 1==32 -> return (bs2id $ BA.drop 1 bs) |
340 | _ -> fail "Bad node id." | 376 | _ -> fail "Bad node id." |
341 | else case Base16.decode $ C8.pack hexhash of | 377 | _ -> case Base16.decode $ C8.pack hexhash of |
342 | (bs,rem) | B.length bs == 32 && B.null rem -> return (bs2id bs) | 378 | (bs,rem) | B.length bs == 32 && B.null rem -> return (bs2id bs) |
343 | _ -> fail "Bad node id." | 379 | _ -> fail "Bad node id." |
344 | return (nid,addrstr) | 380 | return (nid,addrstr) |
@@ -617,10 +653,10 @@ parseNoSpamJID jid = do | |||
617 | (u,h) <- maybe (Left "Invalid JID.") Right | 653 | (u,h) <- maybe (Left "Invalid JID.") Right |
618 | $ let (mu,h,_) = splitJID jid | 654 | $ let (mu,h,_) = splitJID jid |
619 | in fmap (, h) mu | 655 | in fmap (, h) mu |
620 | base64 <- case splitAt 43 $ Text.unpack h of | 656 | based <- case splitAt 52 $ Text.unpack h of |
621 | (base64,".tox") -> Right base64 | 657 | (base32,".tox") -> Right base32 |
622 | _ -> Left "Hostname should be 43 base64 digits followed by .tox." | 658 | _ -> Left "Hostname should be 52 z-base32 digits followed by .tox." |
623 | pub <- id2key <$> readEither base64 | 659 | pub <- id2key <$> readEither based |
624 | let ustr = Text.unpack u | 660 | let ustr = Text.unpack u |
625 | case ustr of | 661 | case ustr of |
626 | '$' : b64digits -> solveBase64NoSpamID b64digits pub | 662 | '$' : b64digits -> solveBase64NoSpamID b64digits pub |
diff --git a/dht/vnet/screen-shell.sh b/dht/vnet/screen-shell.sh index fa420b9d..ab274f39 100755 --- a/dht/vnet/screen-shell.sh +++ b/dht/vnet/screen-shell.sh | |||
@@ -11,4 +11,4 @@ digit=$(printf '%X' $count) | |||
11 | cd ep$digit | 11 | cd ep$digit |
12 | port=$(( 33400 + $count )) | 12 | port=$(( 33400 + $count )) |
13 | pwd | 13 | pwd |
14 | ../dhtd tox=$(ifaddr ep$digit):$port,bt=,xmpp= | 14 | ../dhtd --noavahi tox=$(ifaddr ep$digit):$port,bt=,xmpp= -v TCP,Onion |