1 files changed, 49 insertions, 10 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index f23f964c..477cfc51 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -19,6 +19,7 @@ import qualified Data.Conduit.List  as CL
 import Data.XML.Types               as XML
 import EventUtil
 import Network.Tox.Crypto.Transport as Tox
+import Util                         (unsplitJID)
 import XMPPServer                   as XMPP
 
 import Announcer
@@ -135,6 +136,9 @@ data ToxToXMPP = ToxToXMPP
     , txTox       :: Tox JabberClients
     }
 
+default_nospam :: Word32
+default_nospam = 0x6a7a27fc -- big-endian base64: anon/A==
+
 dispatch :: ToxToXMPP -> ContactEvent -> IO ()
 dispatch tx (SessionEstablished theirKey) = stopConnecting tx theirKey
 dispatch tx (SessionTerminated theirKey)  = startConnecting tx theirKey
@@ -155,8 +159,7 @@ dispatch tx (OnionRouted  theirkey (OnionFriendRequest fr) ) = do
     -- This isn't the right thing, but we don't know their user-id.  Perhaps
     -- there should be a way to parse it out of the friend request text.  Maybe
     -- after a zero-termination, or as visible text (nospam:...).
-    let default_nospam = 0x6a7a27fc -- big-endian base64: anon/A==
-        theirjid = key2jid default_nospam theirkey
+    let theirjid = key2jid default_nospam theirkey
     forM_ k2c $ \((PerClient{pcDeliveredFRs},conn),client) -> do
         alreadyDelivered <- atomically $ do
             frs <- readTVar pcDeliveredFRs
@@ -181,8 +184,27 @@ akeyConnect :: Announcer -> NodeId -> PublicKey -> IO AnnounceKey
 akeyConnect announcer me them = atomically $ do
     packAnnounceKey announcer $ "connect:" ++ (take 8 $ show me) ++ ":" ++ show (key2id them)
 
+-- | Returns a list of nospam values to use for friend requests to send to a
+-- remote peer.  This list is non-empty only when it is desirable to send
+-- friend requests.
+checkSoliciting :: PresenceState -> PublicKey -> PublicKey -> Contact -> IO [NoSpam]
+checkSoliciting presence me them contact = do
+    xs <- getBuddiesAndSolicited presence $ \h -> do
+        -- TODO: /h/ matches hostname?
+        return False
+    return $ do
+        (is_buddy,their_u,my_uid,xmpp_client_profile) <- xs
+        guard $ xmpp_client_profile == "tox"
+        let theirhost = T.pack $ show (key2id them) ++ ".tox"
+        NoSpamId nospam _ <- case fmap T.unpack $ their_u of
+            Just ('$':_)     -> maybeToList $ readMaybe $ T.unpack $ unsplitJID (their_u,theirhost,Nothing)
+            Just ('0':'x':_) -> maybeToList $ readMaybe $ T.unpack $ unsplitJID (their_u,theirhost,Nothing)
+            _                -> maybeToList $ readMaybe $ T.unpack $ key2jid default_nospam them
+        return nospam
+
 startConnecting0 :: ToxToXMPP -> PublicKey -> Contact -> IO ()
 startConnecting0 tx them contact = do
+        dput XMan $ "START CONNECTING " ++ show (key2id them)
         let ToxToXMPP { txTox       = tox
                       , txAnnouncer = announcer
                       , txAccount   = acnt     } = tx
@@ -193,10 +215,10 @@ startConnecting0 tx them contact = do
                               [bkts4,bkts6]
                 return $ foldr interweave [] nss
         wanted <- atomically $ (==Just TryingToConnect) <$> readTVar (contactPolicy contact)
-        soliciting <- return False -- TODO: read subscribers file to answer this question.
+        let mypub = toPublic $ userSecret acnt
+            me  = key2id mypub
+        soliciting <- checkSoliciting (txPresence tx) mypub them contact
         when wanted $ do
-            let pub = toPublic $ userSecret acnt
-                me  = key2id pub
             akey <- akeyDHTKeyShare announcer me them
                     -- We send this packet every 30 seconds if there is more
                     -- than one peer (in the 8) that says they our friend is
@@ -218,13 +240,30 @@ startConnecting0 tx them contact = do
                     dkey <- Tox.getContactInfo tox
                     let tr    = Tox.toxToRoute tox
                         route = Tox.AnnouncedRendezvous theirkey rendezvous
-                    sendMessage tr route (pub,Tox.OnionDHTPublicKey dkey)
-                    when soliciting $ do
+                    dput XMan $ unwords [ take 8 (show $ key2id mypub) ++ ":"
+                                        , "Sending my DHT-key"
+                                        , show (key2id $ Tox.dhtpk dkey)
+                                        , "to"
+                                        , show (key2id theirkey)
+                                        , "via"
+                                        , show (Tox.rendezvousNode rendezvous)
+                                        ]
+                    sendMessage tr route (mypub,Tox.OnionDHTPublicKey dkey)
+                    forM_ soliciting $ \cksum@(NoSpam nospam _)-> do
+                        dput XMan $ unwords [ take 8 (show $ key2id mypub) ++ ":"
+                                            , "Sending friend-request"
+                                            , "with nospam"
+                                            , "(" ++ nospam64 cksum ++ "," ++nospam16 cksum ++ ")"
+                                            , "to"
+                                            , show (key2id theirkey)
+                                            , "via"
+                                            , show (Tox.rendezvousNode rendezvous)
+                                            ]
                         let fr = FriendRequest
-                                    { friendNoSpam      = _todo
-                                    , friendRequestText = mempty
+                                    { friendNoSpam      = nospam
+                                    , friendRequestText = "XMPP friend request"
                                     }
-                        sendMessage tr route (pub,Tox.OnionFriendRequest fr)
+                        sendMessage tr route (mypub,Tox.OnionFriendRequest fr)
             scheduleSearch announcer akey meth them
 
 startConnecting :: ToxToXMPP -> PublicKey -> IO ()