From c4315849dbde49daa27434eb39f063aef8858012 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Tue, 3 Jun 2014 23:29:55 +0200 Subject: [PATCH] WIP --- src/Network/TeleHash/Ext/Seek.hs | 21 +++++++++++++++++++++ src/Network/TeleHash/Hn.hs | 23 ----------------------- src/Network/TeleHash/SwitchApi.hs | 2 +- tft.hs | 4 ++++ 4 files changed, 26 insertions(+), 24 deletions(-) diff --git a/src/Network/TeleHash/Ext/Seek.hs b/src/Network/TeleHash/Ext/Seek.hs index 2c2579a..62b76f8 100644 --- a/src/Network/TeleHash/Ext/Seek.hs +++ b/src/Network/TeleHash/Ext/Seek.hs @@ -4,6 +4,8 @@ module Network.TeleHash.Ext.Seek ext_seek , seek_auto , peer_send + + , manual_seek ) where import Control.Exception @@ -17,6 +19,7 @@ import System.Time import Network.TeleHash.Dht import Network.TeleHash.Ext.Path +import Network.TeleHash.Hn import Network.TeleHash.Packet import Network.TeleHash.Paths import Network.TeleHash.SwitchApi @@ -301,6 +304,24 @@ void seek_send(switch_t s, seek_t sk, hn_t to) } -} +-- --------------------------------------------------------------------- + +arbitrary_hashname :: TeleHash HashName +arbitrary_hashname = do + hn <- randomHEX 32 + return (HN hn) + +-- |Manually initiate a seek to each seed for itself, purely for experimentation from the UI +manual_seek :: TeleHash () +manual_seek = do + sw <- get + forM_ (Set.toList $ swSeeds sw) $ \seed -> do + rhn <- arbitrary_hashname + void $ hn_get rhn -- Make sure we have a record for it + sk <- seek_get rhn + seek_send sk seed + + -- --------------------------------------------------------------------- -- |Create a seek to this hn and initiate connect This is called as diff --git a/src/Network/TeleHash/Hn.hs b/src/Network/TeleHash/Hn.hs index 5a905b6..04e535d 100644 --- a/src/Network/TeleHash/Hn.hs +++ b/src/Network/TeleHash/Hn.hs @@ -19,7 +19,6 @@ import Network.TeleHash.Crypt import Network.TeleHash.Packet import Network.TeleHash.Path import Network.TeleHash.Paths --- import Network.TeleHash.SwitchApi import Network.TeleHash.Types import Network.TeleHash.Utils @@ -405,27 +404,5 @@ hn_get hn = do hc <- newHN hn return hc -{- -hn_t hn_get(xht_t index, unsigned char *bin) -{ - hn_t hn; - unsigned char hex[65]; - - if(!bin) return NULL; - util_hex(bin,32,hex); - hn = xht_get(index, (const char*)hex); - if(hn) return hn; - - // init new hashname container - if(!(hn = malloc(sizeof (struct hn_struct)))) return NULL; - memset(hn,0,sizeof (struct hn_struct)); - memcpy(hn->hashname, bin, 32); - memcpy(hn->hexname, hex, 65); - xht_set(index, (const char*)hn->hexname, (void*)hn); - if(!(hn->paths = malloc(sizeof (path_t)))) return hn_free(hn); - hn->paths[0] = NULL; - return hn; -} --} -- --------------------------------------------------------------------- diff --git a/src/Network/TeleHash/SwitchApi.hs b/src/Network/TeleHash/SwitchApi.hs index 57deb0a..b4db96c 100644 --- a/src/Network/TeleHash/SwitchApi.hs +++ b/src/Network/TeleHash/SwitchApi.hs @@ -115,12 +115,12 @@ switch_receive rxPacket path timeNow = do OpenPacket _b _bs -> do -- process open packet open <- crypt_deopenize rxPacket - logP $ "DEOPEN " ++ showJson (doJs open) case open of DeOpenizeVerifyFail -> do logT $ "DEOPEN fail for " ++ show rxPacket return () deOpenizeResult -> do + logP $ "DEOPEN " ++ showJson (doJs open) logT $ "receive.deopenize verified ok " -- ++ show open let minner = parseJsVal (doJs open) :: Maybe OpenizeInner case minner of diff --git a/tft.hs b/tft.hs index 8c160a2..3b55252 100644 --- a/tft.hs +++ b/tft.hs @@ -340,6 +340,10 @@ app = do chStr <- showAllDht logR chStr + | isPrefixOf "/seek" l -> do + logR $ "Seeking all seeds" + manual_seek + | otherwise -> do -- default send as message cid <- getChatCurrent