diff options
Diffstat (limited to 'examples/dhtd.hs')
-rw-r--r-- | examples/dhtd.hs | 39 |
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 | |||
18 | import Data.String | 18 | import Data.String |
19 | import qualified Data.ByteString as B (ByteString,writeFile,readFile) | 19 | import qualified Data.ByteString as B (ByteString,writeFile,readFile) |
20 | ; import Data.ByteString (ByteString) | 20 | ; import Data.ByteString (ByteString) |
21 | import qualified Data.ByteString.Char8 as B8 | ||
21 | import System.IO | 22 | import System.IO |
22 | import System.IO.Error | 23 | import System.IO.Error |
23 | import Text.PrettyPrint.HughesPJClass | 24 | import 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 | ||