New: DHT deamon and command-line interface.

1 files changed, 80 insertions, 0 deletions

diff --git a/examples/dht.hs b/examples/dht.hs
new file mode 100644
index 00000000..feeee9ff
--- /dev/null
+++ b/examples/dht.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE NondecreasingIndentation #-}
+import Control.Monad
+import Control.Monad.Fix
+import Control.Monad.IO.Class
+import Data.Char
+import Network.Socket as Socket
+import System.Console.Haskeline
+import System.Environment
+import System.Exit
+import System.IO
+import System.IO.Unsafe
+import qualified Data.ByteString as B
+
+-- | Reads one character.  If it is not a digit,
+-- then it is discarded and 'Nothing' is returned.
+hReadDigit :: Handle -> IO (Maybe Char)
+hReadDigit h = do c <- hGetChar h
+                  return $ guard (isDigit c) >> pure c
+
+-- | Expected input: "nnn:..."
+-- Here we read the digit sequence "nnn" and drop the colon
+-- as it is the first non-digit.
+hReadInt :: Handle -> IO Int
+hReadInt h = do
+        nstr <- fix $ \readDigits ->
+                        maybe (return []) -- dropped non-digit character
+                              (($ unsafeInterleaveIO readDigits) . fmap . (:))
+                             =<< hReadDigit h
+        readIO nstr :: IO Int
+
+
+-- | Read a length prefixed string from a handle.
+-- The format is "nnn:..." where /nnn/ is an ascii-encoded character count
+-- and /.../ is the sequence of characters
+--
+-- Note: The first byte after the count is ignored and discarded.
+readResponse :: Handle -> IO String
+readResponse h = do
+    n <- hReadInt h
+    sequence $ replicate n (hGetChar h)
+
+-- | Send a command to the dhtd daemon and then print the response.
+sendCommand :: Handle -> String -> InputT IO ()
+sendCommand h cmd = do resp <- liftIO $ do hPutStrLn h cmd
+                                           readResponse h
+                       outputStrLn resp
+
+-- | Get one line of input and send it to the daemon, then run the
+-- passed continuation if it wasn't "quit".
+interactiveMode :: Handle -> InputT IO () -> InputT IO ()
+interactiveMode h repl = do
+    minput <- getInputLine "dht> "
+    case minput of
+       Nothing     -> return ()
+       Just "quit" -> sendCommand h "quit" >> return ()
+       Just cmd    -> sendCommand h cmd >> repl
+
+main :: IO ()
+main = do
+    -- Open the control socket to the daemon.
+    h <- liftIO $ handle (\e -> do hPutStrLn stderr (show (e ::IOError))
+                                   exitFailure)
+                  $ do sock <- socket AF_UNIX Stream defaultProtocol
+                       connect sock (SockAddrUnix "dht.sock")
+                       socketToHandle sock ReadWriteMode
+
+    -- Haskeline's default looks only at our stdin and not our stdout.
+    -- That's a bad idea because we can take input from the command line.
+    behavior <- do
+        useTerminal <- and <$> mapM hIsTerminalDevice [stdin,stdout]
+        return $ if useTerminal then preferTerm else useFileHandle stdin
+
+    runInputTBehaviorWithPrefs behavior defaultPrefs defaultSettings $ do
+
+    -- A command may be specified on the command line
+    -- or else we enter an interactive shell.
+    args <- dropWhile isSpace . unwords <$> liftIO getArgs
+    case args of
+        (_:_) -> sendCommand h args >> sendCommand h "quit"
+        _     -> fix $ interactiveMode h