summaryrefslogtreecommitdiff
path: root/examples/dhtd.hs
diff options
context:
space:
mode:
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r--examples/dhtd.hs39
1 files changed, 26 insertions, 13 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 3df77190..19b45acb 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -18,6 +18,7 @@ import Data.Maybe
18import Data.String 18import Data.String
19import qualified Data.ByteString as B (ByteString,writeFile,readFile) 19import qualified Data.ByteString as B (ByteString,writeFile,readFile)
20 ; import Data.ByteString (ByteString) 20 ; import Data.ByteString (ByteString)
21import qualified Data.ByteString.Char8 as B8
21import System.IO 22import System.IO
22import System.IO.Error 23import System.IO.Error
23import Text.PrettyPrint.HughesPJClass 24import Text.PrettyPrint.HughesPJClass
@@ -114,15 +115,16 @@ clientSession st signalQuit sock n h = do
114 line <- map toLower . dropWhile isSpace <$> hGetLine h 115 line <- map toLower . dropWhile isSpace <$> hGetLine h
115 let cmd0 action = action >> clientSession st signalQuit sock n h 116 let cmd0 action = action >> clientSession st signalQuit sock n h
116 cmd action = cmd0 $ join $ runDHT st action 117 cmd action = cmd0 $ join $ runDHT st action
117 case line of 118 (c,args) = second (dropWhile isSpace) $ break isSpace line
119 case (c,args) of
118 120
119 "quit" -> hPutClient h "" >> hClose h 121 ("quit", _) -> hPutClient h "" >> hClose h
120 122
121 "stop" -> do hPutClient h "Terminating DHT Daemon." 123 ("stop", _) -> do hPutClient h "Terminating DHT Daemon."
122 hClose h 124 hClose h
123 putMVar signalQuit () 125 putMVar signalQuit ()
124 126
125 "ls" -> cmd $ do 127 ("ls", _) -> cmd $ do
126 tbl <- getTable 128 tbl <- getTable
127 t <- showTable 129 t <- showTable
128 me <- myNodeIdAccordingTo (read "8.8.8.8:6881") 130 me <- myNodeIdAccordingTo (read "8.8.8.8:6881")
@@ -135,13 +137,13 @@ clientSession st signalQuit sock n h = do
135 , ("internet address", show ip) 137 , ("internet address", show ip)
136 , ("buckets", show $ R.shape tbl)] 138 , ("buckets", show $ R.shape tbl)]
137 ] 139 ]
138 "external-ip" -> cmd $ do 140 ("external-ip", _) -> cmd $ do
139 ip <- routableAddress 141 ip <- routableAddress
140 return $ do 142 return $ do
141 hPutClient h $ maybe "" (takeWhile (/=':') . show) ip 143 hPutClient h $ maybe "" (takeWhile (/=':') . show) ip
142 144
143 s | s=="swarms" || "swarms " `isPrefixOf` s -> cmd $ do 145 ("swarms", s) -> cmd $ do
144 let fltr = case dropWhile isSpace (drop 7 s) of 146 let fltr = case s of
145 ('-':'v':cs) | all isSpace (take 1 cs) 147 ('-':'v':cs) | all isSpace (take 1 cs)
146 -> const True 148 -> const True
147 _ -> (\(h,c,n) -> c/=0 ) 149 _ -> (\(h,c,n) -> c/=0 )
@@ -151,8 +153,8 @@ clientSession st signalQuit sock n h = do
151 return $ do 153 return $ do
152 hPutClient h $ showReport r 154 hPutClient h $ showReport r
153 155
154 s | "peers " `isPrefixOf` s -> cmd $ do 156 ("peers ", s) -> cmd $ do
155 let ih = fromString (drop 6 s) 157 let ih = fromString s
156 ps <- allPeers ih 158 ps <- allPeers ih
157 return $ do 159 return $ do
158 hPutClient h $ showReport $ map (((,) "") . show . pPrint) ps 160 hPutClient h $ showReport $ map (((,) "") . show . pPrint) ps
@@ -168,6 +170,15 @@ main = do
168 (Lifted.ioError $ userError "unable to resolve bootstrap nodes") 170 (Lifted.ioError $ userError "unable to resolve bootstrap nodes")
169 saved_nodes <- resume 171 saved_nodes <- resume
170 172
173 peers'trial <- liftIO $ tryIOError $ B.readFile "bt-peers.dat"
174 saved_peers <-
175 either (const $ do liftIO $ putStrLn "Error reading bt-peers.dat"
176 return Nothing)
177 (return . Just)
178 peers'trial
179
180 maybe (return ()) mergeSavedPeers saved_peers
181
171 when (isJust saved_nodes) $ do 182 when (isJust saved_nodes) $ do
172 b <- isBootstrapped 183 b <- isBootstrapped
173 tbl <- getTable 184 tbl <- getTable
@@ -209,7 +220,9 @@ main = do
209 ,("buckets", show $ R.shape tbl) 220 ,("buckets", show $ R.shape tbl)
210 ,("optBucketCount", show bc) 221 ,("optBucketCount", show bc)
211 ] 222 ]
212 snapshot >>= liftIO . B.writeFile "dht-nodes.dat"
213 223
214 waitForSignal 224 waitForSignal -- Await unix socket to signal termination.
225
226 snapshot >>= liftIO . B.writeFile "dht-nodes.dat"
227 savePeerStore >>= liftIO . B.writeFile "bt-peers.dat"
215 228